#!/usr/bin/perl
#
# This is NABOU, a local intrusion detection
# system for UNIX(tm) written in Perl.
#
# It is based on a script called "thor.pl",
# which seems no longer being maintained,
# so I decided to enhance it and to remove
# some bugs.
# The result is nabou. Read more about it
# in the supplied manpage.
#
# Copyright 2000-2002 (c) Thomas Linden.
# All rights reserved.
#
# This program is published under the terms
# of the GPL. You may redistribute or modify
# the program as you wish.
# The author of the program gives absolutely
# no warranty for damages caused by this
# program. Use it at your own risk.
#
# Of course, you can email me, if you encounter
# any problems or if you find another bug :-)
#
# Thomas Linden <tom@daemon.de>


use FileHandle;
use Config::General 1.32;
use Getopt::Long;
use strict;
use Data::Dumper;

# you may edit these values
my $configfile = "/etc/nabou/nabourc";
my $separator  = "  ";
my $underline  = "  " . "-" x 56 . "";
my $suidroot   = "/";

my(
   %config, $conf,				# config obj and hash
   $FirstTime, $Help, $Reset,			# modi
   $md5,					# the MD5/SHA1/MD2 object.
   @digest,                                     # available algorithms
   %suidlist,					# file nfo (set u|gid)
   %ncsumlist,					# file list db (temp)!
   %dbcronlist,                                 # -""-
   %dbcsumlist,                                 # file list db
   $version, $dummy, $Revision,
   $opt_c, $opt_i, $opt_r, $opt_h, $opt_v, $opt_d, $opt_raw,$opt_u,
   $opt_q, $opt_D, $opt_k,
   %suid_mask, $suid_msg, $dir_msg, $algo, $dir_len,
   $cipher,                                     # the Crypt::CBC object
   $LOG,                                        # the body of the message, if any
   $ERR,                                        # Global errors, if any
   %counter,                                    # statistics counter
   %DEF, @DEF,                                  # hold IFDEF definitions
   $rsa, %key,                                  # rsa object and key storage
   $syslog,                                     # if syslog module is available
   %my                                          # a place for scriptlet users to store stuff
  );

my @dbfiles = qw(pwdDB csumDB cronDB sugidDB miscDB diskusageDB portDB);

BEGIN {
  #
  # try to load a DBM module
  #
  eval {
    require GDBM_File;
  };
  if ($@) {
    eval {
      require DB_File;
    };
    if ($@) {
      eval {
	require ANY_File;
      };
      if ($@) {
	warn "Could not explicitly load any DBM module. Trying the perl buildin.\n";
      }
    }
  }

  #
  # try to load a Digest:: module
  #
  eval { require Digest::MD5; };
  if (!$@) {
    push @digest, "MD5";
  }
  eval { require Digest::MD2; };
  if (!$@) {
    push @digest, "MD2";
  }
  eval { require Digest::SHA1; };
  if (!$@) {
    push @digest, "SHA1";
  }
}


# define the version string from RCS
$version ="2.1";

# get commandline options and store them in scalar refs.
eval { Getopt::Long::Configure( qw(no_ignore_case)); }; # might not work with older perl versions
my $success = GetOptions (
			  "init|i!"    => \$opt_i,    # no arg
			  "reset|r!"   => \$opt_r,    # no arg
			  "config|c=s" => \$opt_c,    # string arg required
			  "help|h!"    => \$opt_h,    # no arg
			  "version|v!" => \$opt_v,    # no arg
			  "dump|d=s"   => \$opt_d,    # string arg required
			  "raw!"       => \$opt_raw,  # no arg, no shortcut
			  "update|u:s" => \$opt_u,    # string arg required
			  "quiet|q!"   => \$opt_q,    # no arg
			  "daemon|D!"  => \$opt_D,    # no arg
			  "def:s"      => \@DEF,      # multiple strings, arg required
			  "genkey|k!"  => \$opt_k,    # no arg
			 );

if (!$success) {
    exit(1);
}

if ($opt_c) {
    $configfile = $opt_c;
}

if ($opt_h or ($opt_r and $opt_i)) {
    &usage;
}

if ($opt_v) {
    print "This is nabou version $version Copyright 2000-2002 (c) Thomas Linden\n";
    exit 1;
}

if ($opt_k) {
  &gen_rsa_key;
  exit;
}


$Reset     = 1 if($opt_r);
$FirstTime = 1 if($opt_i);

if ($opt_d) {
    &dump($opt_d, $opt_raw);
    exit;
}



# load the config file using Config::General.
$conf = new Config::General($configfile);
%config = $conf->getall();


# be backward compatible
if ($config{useshadow}) {
  $config{use_shadow} = $config{useshadow};
}
if ($config{usemail}) {
  $config{use_mail} = $config{usemail};
}
if ($config{check_md5}) {
  $config{check_files} = $config{check_md5};
}



# "preprocessor"
if (@DEF) {
  %DEF = map { my($name, $val) = split /=/, $_, 2; $name => ($val ? $val : 1) } @DEF;
  if (exists $config{IFDEF}) {
    foreach my $def (keys %{$config{IFDEF}}) {
      # a <IFDEF ...> statement
      my($name, $val) = split /=/, $def, 2;
      $val = ($val ? $val : 1);
      if (exists $DEF{$name} && $DEF{$name} eq $val) {
	# yes, we got a true IFDEF, incorporate it into %config
	# the {IFEDF} key will be kept, but ignored, maybe in
	# later versions we could need it.
	my $Config = &incorporate(\%config, $config{IFDEF}->{$def}, $def);
	%config = %{$Config};
      }
    }
  }
}



# load crypto modules, if required
if ($config{db}->{protected}) {
    eval {
      require Crypt::CBC;
      require Crypt::OpenSSL::RSA;
      require MIME::Base64;
      if ($Crypt::OpenSSL::RSA::VERSION < 0.12) {
	die "Crypt::OpenSSL::RSA version 0.12 required--this is only version $Crypt::OpenSSL::RSA::VERSION";
      }
    };
    if($@) {
	print STDERR "A required module could not be loaded:\n";
        die $@;
    }
    else {
      # ok, seems to be ok, load the keys
      %key = ( PUBLIC => $config{keys}->{PUBLIC}, PRIVATE => $config{keys}->{PRIVATE} );
    }
    # imply the readonly option 'cause we cannot write anyway.
    $config{db}->{readonly} = 1;
}

# see, which algorithm we'll use
if ($config{use_algo} =~ /^(MD5|MD2|SHA1)$/ && grep { $1 } @digest) {
  $algo = "$config{use_algo}";
}
elsif ($config{use_algo} && !@digest) {
  print "Unknown or unsupported checksum algorithm $config{use_algo} defined!\n";
  exit;
}
elsif ($config{use_algo} && @digest) {
  warn "Unknown or unsupported checksum algorithm $config{use_algo} defined!\n";
  warn "Using default (available) algorithm $digest[0] instead.\n";
  $algo = $digest[0];
}
elsif (!$config{use_algo} && @digest) {
  # the default
  $algo = $digest[0];
}
else {
  # uh oh, that's bad.
  print "Unknown or unsupported checksum algorithm $config{use_algo} defined!\n";
  exit;
}

if ($config{check_nabou} ne "0" || ! exists $config{check_nabou}) {
  $config{check_nabou} = 1;
}

# look if there were more args after parsing options
# and pass them to the update function, IF there were some
if ($opt_u) {
  my @u_files;
  if (@ARGV) {
    @u_files = @ARGV;
  }
  push @u_files, $opt_u;
  &update_file(@u_files);
  exit;
}
elsif ($opt_u eq "" && defined $opt_u) {
    # no arguments supplied, consider as global update and authenticate
    # if protection is turned on, of course ;-)
    if ($config{db}->{protected}) {
	&auth;
    }
    delete $config{db}->{readonly};
}





if ($config{check_nabou}) {
  # check the base database dir, create it if neccessary
  if(!-x $config{db}->{basedir} && -e $config{db}->{basedir}) {
    die "permission denied: $config{db}->{basedir}\n";
  }
  elsif (!-d $config{db}->{basedir} && -e $config{db}->{basedir}) {
    die "$config{db}->{basedir} is not a directory!\n";
  }
  elsif (!-e $config{db}->{basedir}) {
    print STDERR "DB basedir \"$config{db}->{basedir}\" does not exist. I create it for you.\n";
    mkdir $config{db}->{basedir}, oct(700) or die "Could not create \"$config{db}->{basedir}\": $!\n";
  }
  chdir $config{db}->{basedir};
}


# check for per dir inheritance
# and set up default properties if nothing else specified (obsolete: no default properties any more!)
foreach my $dir (sort keys %{$config{directory}}) {
  if (ref($config{directory}->{$dir}) eq "ARRAY") {
    print STDERR "Directory \"$dir\" has been configured more than once!\n";
    exit -1;
  }
  else {
      if (exists $config{directory}->{$dir}->{inherit}) {
       if($config{directory}->{$dir}->{inherit}) {
	  if(!exists $config{directory}->{ $config{directory}->{$dir}->{inherit} }) {
	      print "directory settings for $dir cannot be inherited!\n"
	      	   ."$config{directory}->{$dir}->{inherit} is not defined!\n"
		   ."Using default check: MD5 Checksum\n";
	      $config{directory}->{$dir} = {};
	      $config{directory}->{$dir}->{md5} = 1;
	  }
	  else {
	      my $inhdir = $config{directory}->{$dir}->{inherit};
	      %{$config{directory}->{$dir}} = %{$config{directory}->{$inhdir}};
	  }
	}
      }
      my $str_switches;
      foreach my $switch (sort keys %{$config{directory}->{$dir}}) {
	  next if($switch !~ /^chk_/);
	  next if($switch =~ /^chk_custom$/);
	  if (exists $config{directory}->{$dir}->{$switch} and
               $config{directory}->{$dir}->{$switch} !~ /^(1|on)$/) {
	      delete $config{directory}->{$dir}->{$switch};
	  }
	  else {
	    $str_switches .=  $switch;
	  }
      }
      if ($str_switches eq "chk_all") {
	  # use all senceful checks
	  my $origswitches = $config{directory}->{$dir};
	  $config{directory}->{$dir} = {
					chk_md5   => 1,
					chk_size  => 1,
					chk_mtime => 1,
					chk_uid   => 1,
					chk_nlink => 1,
					chk_gid   => 1,
					chk_ino   => 1,
					chk_mode  => 1,
					};
	  # restore orig options
	  %{$config{directory}->{$dir}} = (%{$config{directory}->{$dir}}, %{$origswitches});
	  delete $config{directory}->{$dir}->{chk_all};
      }
    }
}

# map custom check defines to internal directory->{dir} structure
foreach my $template (keys %{$config{define}}) {
  foreach my $dir ( keys %{$config{check}->{$template}} ) {
    if (exists $config{directory}->{$dir}) {
      print STDERR "Directory \"$dir\" has been configured in a <check> block, but it was already configured!\n";
      exit -1;
    }
    # set params to check
    %{$config{directory}->{$dir}} = %{$config{define}->{$template}};
    if (exists $config{define}->{$template}->{exclude}) {
      delete $config{directory}->{$dir}->{exclude};
      $config{directory}->{$dir}->{exclude} = $config{define}->{$template}->{exclude};
    }
    if (exists $config{define}->{$template}->{include}) {
      delete $config{directory}->{$dir}->{include};
      $config{directory}->{$dir}->{include} = $config{define}->{$template}->{include};
    }
  }
}

# calculate the max length of directory names
# and convert exclude hashes to exclude arrays
foreach my $csdir (keys %{$config{directory}}) {
  my $cslen = length($csdir);
  $dir_len = ( $cslen > $dir_len ? $cslen : $dir_len );
  if (exists $config{directory}->{$csdir}->{exclude} && ref $config{directory}->{$csdir}->{exclude} eq "HASH") {
    my @new_exclude = keys %{$config{directory}->{$csdir}->{exclude}};
    delete $config{directory}->{$csdir}->{exclude};
    @{$config{directory}->{$csdir}->{exclude}} = @new_exclude;
  }
}

# install suid_mask, used by suid_update()
if ($config{check_suid}) {
    if (!exists $config{suid}) {
	# this is the default for suid checks
	$config{suid}->{chk_md5}  = 1;
	$config{suid}->{chk_mode} = 1;
	$config{suid}->{chk_uid}  = 1;
	$config{suid}->{chk_gid}  = 1;
    }
    foreach my $bit (sort keys %{$config{suid}}) {
	next if($bit !~ /^chk_/);
	my $msk     = $config{suid}->{$bit};
	$bit        =~ s/^chk_//;
	$suid_mask{$bit} = $msk if($msk);
    }
}



if (!$config{db}->{protected}) {
  # check if a possibly existing database is
  # already filled and encrypted!
  dbmopen(%dbcsumlist, $config{db}->{csumDB}, 0600);
  foreach my $file (keys %dbcsumlist) {
    if ($dbcsumlist{$file} !~ /^[a-zA-z0-9]*:[\d:]+?$/) {
      # oh, oh, oh ... worst case, go outa here!
      &alert("DB protection is turned off, but the database is RSA encrypted!");
      print STDERR "permission denied! Database is encrypted!\n";
      exit 1;
    }
    last;
  }
  dbmclose(%dbcsumlist);
}

#
# (re)create the file list if required
for my $dbfile (@dbfiles) {
  if (!exists $config{db}->{$dbfile}) {
    $config{db}->{$dbfile} = $dbfile; # not defined, use the default name
  }
}

# init mode (if -r or -i used)
if($Reset || $FirstTime) {
  if ($config{db}->{protected}) {
    print $separator. "\n";
    print "        Enter passphrase for public key:\n\n";
    &auth;
  }

  if (exists $config{db}->{readonly}) {
      # we are in init or reset mode and must write the db's!
      delete $config{db}->{readonly};
  }
  print $separator. "\n";

  print "        Resetting nabou's Databases\n" if($Reset);
  print "        Initializing nabou's Databases\n" if($FirstTime);

  print $underline. "\n";

  $FirstTime = 1;

  # remove the databases and swap files.
  # do not check for errors, 'cause the exact filenames
  # depends on the DB_File implementation!
  for my $dbfile ( @dbfiles ) {
    unlink $config{db}->{$dbfile};
    unlink $config{db}->{pwdDB}   . ".dir";
  }

}
else {
  if ($config{db}->{protected}) {
    # ok, regular check, but using encrypted db
    # so load the private key and create RSA object
    # for later regular checks
    if (!exists $config{keys}->{PRIVATE} || $config{keys}->{PRIVATE} =~ /^\s*$/) {
      print STDERR "No private key found! Generate one with \"nabou -k\".\n";
      &alert("PROTECTED mode check run without PRIVATE KEY in config file!");
      exit 1;
    }
    eval {
      # create RSA object
      $rsa = new Crypt::OpenSSL::RSA;

      # inject the private key into the rsa object too
      $rsa->load_private_key($key{PRIVATE});
    };
  }
}


############################################
###              main                    ###
############################################
eval {
  &verify_programs     if($config{check_nabou});

  &compile_custom;

  &show_roots          if($config{check_root} && !$opt_q);

  &check_users         if($config{check_user});

  &check_crontab       if($config{check_cron});

  &check_ports         if($config{check_ports});

  &check_suid          if($config{check_suid});

  &check_directories   if($config{check_files});

  # remove temp db
  unlink(".ncsumlist");
  unlink(".ncsumlist.pag");
  unlink(".ncsumlist.dir");

  &check_diskusage     if($config{check_diskusage});

  &check_proc          if($config{check_proc});
};
if ($@) {
  $LOG .= $separator. "\n";
  $LOG .= "     FATAL ERRORS\n";
  $LOG .= $underline. "\n";
  $LOG .= $@ . "\n";
}

if ($ERR) {
  $LOG .= $separator. "\n";
  $LOG .= "     ERRORS\n";
  $LOG .= $underline. "\n";
  $LOG .= $ERR . "\n";
}

if($FirstTime == 1) {
  print "\nYou are ready to install nabou as a daily cronjob.\n";
}

if (exists $config{custom}->{END}) {
    eval $config{custom}->{END};
}

if ($FirstTime) {
  print STDERR $LOG;
  exit 0;
}


# use mail instead of STDOUT
if (($opt_q && $LOG) || !$opt_q) {
  my $savelog = $LOG;
  my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  my $time = sprintf("%.2d.%.2d.%.4d %.2d:%.2d:%.2d", $mday, ++$mon, $year + 1900, $hour, $min, $sec);
  $LOG = "$underline\n    NABOU MONITOR REPORT FROM $time\n$underline\n\n";
  if (exists $counter{suid}) {
    $LOG .= " Total SUID/SGID files scanned: " . $counter{suid}->{all} . "\n";
    $LOG .= "       SUID/SGID files changed: " . $counter{suid}->{changed} . "\n";
    $LOG .= "       SUID/SGID files   added: " . $counter{suid}->{new} . "\n";
    $LOG .= "       SUID/SGID files removed: " . $counter{suid}->{del} . "\n\n";
  }
  if (exists $counter{files}) {
    $LOG .= "           Total Files scanned: " . $counter{files}->{all} . "\n";
    $LOG .= "                 Files changed: " . $counter{files}->{changed} . "\n";
    $LOG .= "                 Files   added: " . $counter{files}->{new} . "\n";
    $LOG .= "                 Files removed: " . $counter{files}->{del} . "\n\n";
  }
  $LOG .= $savelog;
  $LOG .= "\n\n$underline\n";
  $LOG .= "     This report was  created using  nabou version $version.\n";
  $LOG .= "     NABOU is free software under the terms of the GPL.\n";
  $LOG .= "     Copyright 2000-2001 Thomas Linden <tom\@daemon.de>.\n";
  $LOG .= "     See http://www.nabou.org  for  more  informations.\n";
  $LOG .= "$underline\n";
  if($config{usemail} && !$opt_r && !$opt_i) {
    open(MAIL, "|$config{bin}->{sendmail} -oi -t") or die $!;
    select MAIL;
    print "From: $config{mail}->{from}\n";
    print "To: $config{mail}->{rcpt}\n";
    print "Cc: $config{mail}->{cc}\n" if($config{mail}->{cc});
    print "Subject: $config{mail}->{subject}\n\n\n";
    print $LOG;
    close MAIL;
  }
  else {
    print $LOG;
  }
}
exit 0;

# the end of the script.














###############################################################
###                        subs                             ###
###############################################################

sub incorporate {
  #
  # recursively incorporate a sub hash under an IFDEF block
  # into the main config hash
  #
  my($config, $ref, $def) = @_;
  if (ref $ref eq "HASH") {
    foreach my $key (keys %{$ref}) {
      # $key = "directory"
      if (ref $ref->{$key} eq "HASH") {
	$config->{$key} = &incorporate($config->{$key}, $ref->{$key}, $key);
      }
      elsif (ref $ref->{$key} eq "ARRAY") {
	push @{$config->{$key}}, @{$ref->{$key}};
      }
      else {
	$config->{$key} = $ref->{$key};
      }
    }
  }
  else {
    # ignore arrays for the moment!
    $config->{$def} = $ref;
  }
  $config;
}

sub verify_programs {
  my(@dbcsumsize, %dbmisc, $mailprog, $crontab, $trans, $msg);
  $trans = new File;
  if((-l ($config{db}->{miscDB} . ".dir")) || (-l ($config{db}->{miscDB} . ".pag"))) {
    $msg .= "$config{db}->{miscDB} files exist as a link, and could be harmful if written to.\n";
  }
  if((-l ($config{db}->{pwdDB} . ".dir")) || (-l ($config{db}->{pwdDB} . ".pag"))) {
    $msg .= "$config{db}->{pwdDB} files exist as a link, and could be harmful if written to.\n";
  }
  if((-l ($config{db}->{sugidDB} . ".dir")) || (-l ($config{db}->{sugidDB} . ".pag"))) {
    $msg .= "$config{db}->{sugidDB} files exist as a link, and could be harmful if written to.\n";
  }
  if((-l ($config{db}->{csumDB} . ".dir")) || (-l ($config{db}->{csumDB} . ".pag"))) {
    $msg .= "$config{db}->{csumDB} files exist as a link, and could be harmful if written to.\n";
  }
  if((-l ($config{db}->{cronDB} . ".dir")) || (-l ($config{db}->{cronDB} . ".pag"))) {
    $msg .= "$config{db}->{cronDB} files exist as a link, and could be harmful if written to.\n";
  }


  # now check the files in miscDB
  eval {
    dbmopen(%dbmisc, $config{db}->{miscDB}, 0600) or die "Can't open $config{db}->{miscDB}\: $!\n";
  };
  if ($@) {
    $ERR .= "\n" .  $@;
  }
  else {
    for my $filename ("sendmail", "crontab", "who", "lsof", $0) {
      my $file;
      if ($filename eq $0) {
	$file = $0;
      }
      else {
	if (!exists $config{bin}->{$filename}) {
	  $ERR .= "Path to \"$filename\" not configured!\n";
	  next;
	}
	else {
	  $file = $config{bin}->{$filename};
	}
      }
      my $prog = new File($file);
      $trans->csv($dbmisc{$file});
      $trans->filename($file);
      if ($prog->csv(0,1) ne &ude($dbmisc{$file})) {
	if ($FirstTime) {
	  $msg .= " [Updating...] $file\n";
	  if ($config{use_ls}) {
	    $msg .= " " . $prog->ls . "\n";
	  }
	  $msg .= "\n";
	  $dbmisc{$file} = &uen($prog->csv(0,1));
	}
	else {
	  $msg .= &do_bit_checks( {md5 => 1, mtime => 1}, $file, $trans, $prog );
	}
      }
    }
    if (($opt_q && $msg) || !$opt_q) {
      $LOG .= $separator. "\n";
      $LOG .= "    Verifying the stability of nabou\n";
      $LOG .= $underline. "\n";
      $LOG .= $msg . "\n";
      if ($FirstTime) {
	print $LOG;
	$LOG = "";
      }
    }
    dbmclose(%dbmisc);
  }
}


sub get_users {
  my(%user, %shadow);

  if ($config{use_shadow}) {
    eval {
      open(SHADOW, "<$config{shadow}") || die "Can't open $config{shadow}: $!\n";
    };
    if ($@) {
      $ERR .= "\n" .  $@;
    }
    else {
      while (<SHADOW>) {
	chomp;
	my ($login, $en, @rest) = split /:/;
	my $md5 = new Digest::MD5;
	$md5->add($en);
	$en = undef;
	$shadow{$login} = $md5->hexdigest;
      }
      close SHADOW;
    }
  }

  eval {
    open(PASSWD, "<$config{passwd}") || die "Can't open $config{passwd}: $!\n";
  };
  if ($@) {
    $ERR .= "\n" .  $@;
  }
  else {
    while (<PASSWD>) {
      chomp;
      my  ($login,$passwd,$uid,$gid,$comment,$home,$shell) = split /:/;
      $user{$login} = {
			   login   => $login,
			   passwd  => $shadow{$login},
			   uid     => $uid,
			   gid     => $gid,
			   comment => $comment,
			   home    => $home,
			   shell   => $shell,
			   entry   => "$shadow{$login}:$uid:$gid:$comment:$home:$shell",
			  };
    }
    close PASSWD;
  }
  return %user;
}



sub show_roots {
  #
  # print out all about 0 userz
  #
  my ($msg);
  my %user = &get_users;
  foreach my $login (keys %user) {
    next if ($user{$login}->{uid} != 0 && $user{$login}->{uid} != 131072
	     && $user{$login}->{gid} != 0 && $user{$login}->{gid} != 131072);
    $msg .= &p_login($user{$login}) . "\n";
  }
  if (!$opt_q) {
    $LOG .= $separator. "\n";
    $LOG .= "     Users with root UID or root GID\n";
    $LOG .= $underline. "\n";
    $LOG .= $msg . "\n";
    if ($FirstTime) {
      print $LOG;
      $LOG = "";
    }
  }
}



sub p_login {
  my $user = shift;
  return sprintf " %12s: %s\n %12s: %s\n %12s: %s\n %12s: %s\n %12s: %s\n %12s: %s\n %12s: %s\n",
                    "USER" ,       $user->{login},
		    "UID",         $user->{uid},
		    "GID",         $user->{gid},
		    "HOME",        $user->{home},
		    "SHELL",       $user->{shell},
		    "COMMENT",     $user->{comment},
		    "PASSWD(MD5)", $user->{passwd};
}



sub check_users {
  my(%dbpwd, $msg);
  eval {
    dbmopen(%dbpwd, $config{db}->{pwdDB}, 0600) || die "Can't open $config{db}->{pwdDB}\: $!\n";
  };
  if ($@) {
    $ERR .= "\n" .  $@;
  }
  else {
    my %user = &get_users;
    foreach my $login (keys %user) {
      if(! $dbpwd{$login}) {
	$msg .= "Account \"$login\" was not in the DataBase.";
	if (!$config{db}->{readonly}) {
	  $msg .= " [Adding...]\n";
	  $dbpwd{$login} = $user{$login}->{entry};
	}
	$msg .=  &p_login($user{$login}) . "\n";
      }
      elsif($user{$login}->{entry} ne $dbpwd{$login}) {
	my @dbdata  = split /:/, $dbpwd{$login};
	$msg .= "Account information for user \"$login\" has changed.\n";
	$msg .= " [Expected]\n" . &p_login( {
					     login   => $login,
					     uid     => $dbdata[1],
					     gid     => $dbdata[2],
					     home    => $dbdata[4],
					     shell   => $dbdata[5],
					     comment => $dbdata[3],
					     passwd  => $dbdata[0]
					      } ) . "\n";
	$msg .= " [Observed]\n" . &p_login($user{$login}) . "\n";
	$dbpwd{$login} = $user{$login}->{entry} if (!$config{db}->{readonly});
      }
    }
    foreach my $login(keys %dbpwd) {
      if(! $user{$login}) {
	$msg .= "Account \"$login\" was not found.";
	if (!$config{db}->{readonly}) {
	  $msg .= " [Removing...]";
	  delete($dbpwd{$login});
	}
	my @dbdata  = split /:/, $dbpwd{$login};
	$msg .= " [Expected]\n" .&p_login({
					   login   => $login,
					   uid     => $dbdata[1],
					   gid     => $dbdata[2],
					   home    => $dbdata[4],
					   shell   => $dbdata[5],
					   comment => $dbdata[3],
					   passwd  => $dbdata[0]
					  } ) . "\n";
      }
    }
    dbmclose(%dbpwd);
    if (($opt_q && $msg) || !$opt_q) {
      $LOG .= $separator. "\n";
      $LOG .= "     User Accounts\n";
      $LOG .= $underline. "\n";
      $LOG .= $msg . "\n";
      if ($FirstTime) {
	print $LOG;
	$LOG = "";
      }
    }
  }
}




sub check_suid {
  if (exists $config{suid}) {
    # suid configured
    if (exists $config{suid}->{exclude}) {
      my @exclude;
      if (ref($config{suid}->{exclude}) eq "HASH") {
	@exclude = keys %{$config{suid}->{exclude}};
      }
      elsif (ref($config{suid}->{exclude}) eq "ARRAY") {
	@exclude = @{ $config{suid}->{exclude} };
      }
      else {
	@exclude = ( $config{suid}->{exclude} );
      }
      push @exclude, "/proc"; # always ignore /proc
      delete $config{suid}->{exclude};
      @{$config{suid}->{exclude}} = &regex(@exclude);

      &recurse_suid($suidroot);
    }
    elsif (exists $config{suid}->{include}) {
      my @includes;
      if (ref($config{suid}->{include}) eq "HASH") {
	@includes = keys %{$config{suid}->{include}};
      }
      elsif (ref($config{suid}->{include}) eq "ARRAY") {
	@includes = @{$config{suid}->{include}};
      }
      else {
	@includes = ( $config{suid}->{include} );
      }
      @includes = &regex(@includes);

      foreach my $dir (@includes) {
	&recurse_suid($dir);
      }
    }
  }
  else {
    # using default
    $config{suid}->{exclude} = [ "/proc" ];
    &recurse_suid($suidroot);
  }
  &update_suid_db;
}


sub recurse_suid {
    my($dir) = @_;
    my($file);
    my $fh = new IO::Handle;
    eval {
      opendir $fh, $dir or die "Could not open $dir: $!\n";
    };
    if ($@) {
      $ERR .= "\n" .  $@;
    }
    else {
      my @allfiles = readdir($fh);
      closedir $fh;
      undef $fh;
      foreach my $file (sort @allfiles) {
        next if($file =~ /^\.$/ || $file =~ /^\.\.$/);
	if($dir ne "/") {
	  $file = $dir . "/" . $file;
        }
	else {
	  $file = $dir . $file;
	}
	if (exists $config{suid}->{exclude}) {
	  next if(grep { $file =~ /^$_/ } @{$config{suid}->{exclude}});
	}
        if(-d $file && !-l $file) {
	  &recurse_suid($file);
        }
        if(!-l $file && !-d $file && (-u $file || -g $file)) {
	  $counter{suid}->{all}++;
	  my $obj = new File($file);
	  $suidlist{$file} = $obj->csv(0,1);
        }
      }
    }
}



sub update_suid_db {
  my(%dbsugid, $dbfile, $newfile, $msg);
  eval {
    dbmopen(%dbsugid, $config{db}->{sugidDB}, 0600) or
      die "Can't open $config{db}->{sugidDB}: $!\n";
  };
  if ($@) {
    $ERR .= "\n" .  $@;
  }
  else {
    $dbfile  = new File; # empty File objects for checking, see below.
    $newfile = new File;
    foreach my $file (sort keys %suidlist) {
      $dbfile->csv($dbsugid{$file});
      $dbfile->filename("$file");
      $newfile->csv($suidlist{$file}, 1);
      $newfile->filename("$file");
      if(! $dbsugid{$file}) {
	$msg .= "File was not in the Database:\n";
	if (!$config{db}->{readonly}) {
	  $counter{suid}->{new}++;
	  $msg .= " [Adding...]";
	  $dbsugid{$file} = &uen($suidlist{$file});
	}
	$msg .= " $file\n";
	$msg .= &ShellChecksum($file);
	if ($config{use_ls}) {
	  $msg .= " " . $newfile->ls . "\n";
	}
	$msg .= "\n";
      }
      elsif($dbsugid{$file} ne $suidlist{$file}) {
	# check configured bits
	$msg .= &do_bit_checks(\%suid_mask, $file, $dbfile, $newfile, "/");
	if (!$config{db}->{readonly}) {
	  # update db record
	  $dbsugid{$file} = &uen($suidlist{$file});
	}
      }
    }

    foreach my $file (sort keys %dbsugid) {
      if(! $suidlist{$file}) {
	$newfile->csv($suidlist{$file}, 1);
	$newfile->filename("$file");
	$msg .= "File was not found or is no more being monitored:";
	if (!$config{db}->{readonly}) {
	  $msg .= " [Removing...]";
	  $counter{suid}->{del}++;
	  delete($dbsugid{$file});
	}
	$msg .= " $file\n";
	if ($config{use_ls}) {
	  $msg .= " " . $newfile->ls . "\n";
	}
	$msg .= "\n";
      }
    }
    dbmclose(%dbsugid);
    undef %suidlist;

    if (($opt_q && $msg) || !$opt_q) {
      $LOG .= $separator. "\n";
      $LOG .= "     SUID or SGID Files\n";
      $LOG .= $underline. "\n";
      $LOG .= $msg . "\n";
      if ($FirstTime) {
	print $LOG;
	$LOG = "";
      }
    }
  }
}



sub check_ports {
  #
  # check for listening internet ports
  # and report changes or all listeners
  #
  my(%port, $process, %dbport, $msg);
  my %map = (
	     L  => "login",
	     n  => "port",
	     p  => "pid",
	     P  => "protocol",
	     T  => "state",
	     c  => "command",
	    );

  # lsof options:
  # -P: do not convert port numbers to names
  # -F only fields Internet User Port Protocol Tcp-state
  open PORTS, "$config{bin}->{lsof} -P -F LnPTc -i|" or die "Could not execute $config{bin}->{lsof}: $!\n";
  while (<PORTS>) {
    chomp;
    if (/^p(\d*)$/) {
      $process = $1;
    }
    else {
      next if /^TQ/;
      if (/^(.)(.*)$/) {
	$port{$process}->{ $map{$1} } = $2;
      }
    }
  }
  close PORTS;
  foreach my $p (keys %port) {
    if ($port{$p}->{state} !~ /LISTEN/) {
      delete $port{$p}
    }
    else {
      $port{$p}->{state} =~ s/ST=//;
      my $entry;
      foreach my $flag (sort keys %{$port{$p}}) {
	# looks: "login=root,port=*:22,protocol=TCP,state=LISTEN,"
	$entry .= $flag . "=" . $port{$p}->{$flag} . ",";
      }
      $port{$p} = $entry;
    }
  }

  if ($config{check_ports} eq "all") {
    foreach my $process (keys %port) {
      $msg .= &port_print($port{$process}) . "\n";
    }
  }
  else {
    eval {
      dbmopen(%dbport, $config{db}->{portDB}, 0600) or
	die "Can't open $config{db}->{portDB}: $!\n";
    };
    if ($@) {
      $ERR .= "\n" .  $@;
    }
    else {
      foreach my $process (keys %port) {
	if (! $dbport{$process}) {
	  # does not exist, add if not readonly
	  $msg .= " Unknown listening port observed: ";
	  if (!$config{db}->{readonly}) {
	    $msg .= " [Adding...] ";
	    $dbport{$process} = &uen($port{$process});
	  }
	  $msg .= "\n " . &port_print($port{$process}) . "\n\n";
	}
      }
      foreach my $process (keys %dbport) {
	if (! $port{$process}) {
	  $msg .= " Listening port closed: ";
	  my $p = &port_print(&ude($dbport{$process}));
	  if (!$config{db}->{readonly}) {
	    $msg .= " [Removing...] ";
	    delete $dbport{$process};
	  }
	  $msg .= "\n " . $p . "\n\n";
	}
      }
    }
  }
  if (($opt_q && $msg) || !$opt_q) {
    $LOG .= $separator. "\n";
    $LOG .= "     Listening ports\n";
    $LOG .= $underline. "\n";
    $LOG .= $msg . "\n";
    if ($FirstTime) {
      print $LOG;
      $LOG = "";
    }
  }
}


sub port_print {
  #
  # print the listing out similar to lsof -i
  #
  my($port) = @_;
  my %Port = map { /^(.*)=(.*)$/; $1 => $2 } split /,/, $port, 5;
  return sprintf "%8s %4s %7s %8s %27s", map { $Port{$_} } reverse sort keys %Port;
}



sub ShellChecksum {
  my($file) = @_;
  my(%scsum);
  eval {
    open(CSUM, $config{shells}) or die "Can't open shells file $config{shells}: $!";
  };
  if ($@) {
    $ERR .= "\n" .  $@;
  }
  else {
    while(<CSUM>) {
      chomp;
      next if /^\s*#/;
      if(! -l $_) {
	my $obj = new File($_);
	$scsum{$_}  = $obj->md5;
      }
    }
    close(CSUM);
    my $setobj = new File($file);
    foreach my $shell (sort keys %scsum) {
      if($setobj->md5 eq $scsum{$shell}) {
	return "Warning:\t$file has the same checksum as $shell\!\n";
      }
    }
  }
}




sub check_directories {
  my(@exclude, @include, @custom, %mask, $msg, $slash);

  eval {
    dbmopen(%dbcsumlist, $config{db}->{csumDB}, 0600) or
      die "Can't open $config{db}->{csumDB}\: $!\n";

    if (exists $config{use_temp_sum} && $config{use_temp_sum}) {
      dbmopen(%ncsumlist, ".ncsumlist", 0600) or
	die "Can't open temp db \".ncsumlist\": $!\n";
    }
  };
  if ($@) {
    $ERR .= "\n" .  $@;
  }
  else {
    if ($FirstTime) {
      print $separator. "\n";
      print "     Changed files in monitored dirs\n";
      print $underline. "\n";
    }

    foreach my $csdir (sort { $b cmp $a } keys %{$config{directory}}) {
      if (!-d $csdir) {
	# consider $csdir as a single file and check this and do not
	# try to traverse into it as it would be done if it were a directory
	$config{directory}->{$csdir}->{include} = $csdir;
      }
      elsif (!-e $csdir || !-x $csdir) {
	$msg .= "  directory does not exist or permission denied: $csdir";
      }

      #
      # process excludes
      my $exclude;
      if (exists $config{directory}->{$csdir}->{exclude}) {
	$exclude = $config{directory}->{$csdir}->{exclude};
	if(ref($exclude) eq "ARRAY") {
	  foreach my $exclude_file (@{$exclude}) {
	    push @exclude, &relative_path($csdir, $exclude_file);
	  }
	}
	elsif (ref($exclude) eq "HASH") {
	  foreach my $exclude_file (keys %{$exclude}) {
	    push @exclude, &relative_path($csdir, $exclude_file);
	  }
	}
	else {
	  if ($exclude) {
	    push @exclude, &relative_path($csdir, $exclude);
	  }
	}
	@exclude = &regex(@exclude);
      }

      #
      # process includes
      my $include;
      if (exists $config{directory}->{$csdir}->{include}) {
	$include = $config{directory}->{$csdir}->{include};
	if(ref($include) eq "ARRAY") {
	  foreach my $include_file (@{$include}) {
	    push @include, &relative_path($csdir, $include_file);
	  }
	}
	elsif (ref($include) eq "HASH") {
	  foreach my $include_file (keys %{$include}) {
	    push @include, &relative_path($csdir, $include_file);
	  }
	}
	else {
	  if ($include) {
	    push @include, &relative_path($csdir, $include);
	  }
	}
	@include = &regex(@include);
      }

      %mask = ();
      foreach my $bit (sort keys %{$config{directory}->{$csdir}}) {
	next if($bit !~ /^chk_/);
	next if($bit =~ /^chk_custom$/);
	my $msk = $config{directory}->{$csdir}->{$bit};
	$bit =~ s/^chk_//;
	$mask{$bit} = $msk if($msk);
      }
      if (exists $config{directory}->{$csdir}->{chk_custom}) {
	my $custom = $config{directory}->{$csdir}->{chk_custom};
	if (ref($custom) eq "ARRAY") {
	  foreach (@{$custom}) {
	    push @custom, $_;
	  }
	}
	else {
	  @custom = ($custom) if($custom);
	}
	# add the custom script names as bits to %mask
	foreach my $name (@custom) {
	  $mask{"custom_$name"} = 1;
	}
      }

      if (@include) {
	# process only the specified filez
	$config{directory}->{$csdir}->{du} =
	  &process_includes(\%mask, \@include, $csdir);
	@include = ();
      }
      else {
	# go through all filez
	$config{directory}->{$csdir}->{du} =
	  &recurse_dirs($csdir, \%mask, \@exclude, $config{directory}->{$csdir}->{recursive});
      }
      if ( -d $csdir && $csdir ne "/") {
	$slash = "/";
      }
      else {
	$slash = " ";
      }
      $slash .= " " x ($dir_len - length($csdir));
      my $dir_head = "\n  ----[  $csdir" . $slash . " ]----\n";
      if ($FirstTime) {
	print $dir_head . $dir_msg;
      }
      else {
	$msg .= $dir_head if(!$opt_q || ($opt_q && $dir_msg));
	$msg .= $dir_msg;
      }
      $dir_msg = "";
    }
    if (!$opt_q || ($opt_q && $msg)) {
      if (!$FirstTime) {
	$LOG .= $separator. "\n";
	$LOG .= "     Monitored Files and Directories\n";
	$LOG .= $underline. "\n";
	$LOG .= $msg . "\n";
      }
    }

    # this part was in &update_dir_db earlier
    my $msg;
    foreach my $file (sort keys %dbcsumlist) {
      if(! $ncsumlist{$file}) {
	my $dbfile  = new File;
	$dbfile->csv($dbcsumlist{$file});
	$dbfile->filename("$file");
	$msg .= "File was not found or is no more being monitored:\n";
	if (!$config{db}->{readonly}) {
	  $counter{files}->{del}++;
	  $msg .= " [Removing...]";
	  delete($dbcsumlist{$file});
	}
	$msg .= " $file\n";
	if ($config{use_ls}) {
	  $msg .= " " . $dbfile->ls . "\n";
	}
	$msg .= "\n";
      }
    }
    if (!$opt_q || ($opt_q && $msg)) {
      $LOG .= "     Removed or deleted files\n" . $underline . "\n";
      $LOG .= "\n" . $msg . "\n";
    }

    dbmclose(%dbcsumlist);
    dbmclose(%ncsumlist);
  }
}


sub process_includes {
    my($mask, $include, $dir) = @_;
    my $size;
    foreach my $file (@{$include}) {
	if (!-l $file && -e $file) {
	    my $obj = new File($file);
	    $ncsumlist{$file} = $obj->csv(0,1);
	    $size += $obj->size;
    	    &CheckChange($file, $mask, $dir);
	}
    }
    return $size;
}


sub relative_path {
  #
  # if a filename is absolute, just return it
  # if not, add the given directory to it
  #
  my($dir, $file) = @_;
  if ($file =~ /^\//) {
    # absolue
    return $file;
  }
  else {
    # relative
    return "$dir/$file";
  }
}


sub recurse_dirs {
    my($dir, $mask, $exclude, $recursive) = @_;
    my($file,$infile, $size);
    my $fh = new FileHandle;
    opendir $fh, $dir;
    my @allfiles = readdir($fh);
    closedir $fh;
    undef $fh;
    foreach my $infile (sort @allfiles) {
	$file = $infile;
	next if($file =~ /^\.$/ || $file =~ /^\.\.$/);
	if ($dir eq "/") {
	  $file = $dir . $file;
	}
	else {
	  $file = $dir . "/" . $file;
	}
	next if(grep { $file =~ /^$_$/ } @{$exclude});
	if($recursive) {
	    if(-d $file && !-l $file) {
	      # now check it recursively
	      $size += &recurse_dirs($file, $mask, $exclude, $recursive);
	    }
	}
	if (! $config{check_symlinks}) {
	  # we ignore symlinks
	  next if(-l $file)
	}
	my $obj = new File($file);
	$ncsumlist{$file} = $obj->csv(0,1);
	$size += $obj->size;
	&CheckChange($file, $mask, $dir);
    }
    return $size;
}


sub regex {
    foreach (@_) {
	$_ =~ s/\*/\.\*/g;
	$_ =~ s/\?/./g;
    }
    return @_;
}



sub CheckChange {
  my($file, $mask, $dir) = @_;
  my($dbfile, $newfile, $ch, $ls);

  $dbfile  = new File; # empty File objects for checking, see below.
  $newfile = new File;
  $dbfile->csv($dbcsumlist{$file});
  $dbfile->filename("$file");
  $newfile->csv($ncsumlist{$file}, 1);
  $newfile->filename("$file");

  $counter{files}->{all}++;

  if(! $dbcsumlist{$file}) {
      $dir_msg .= "File was not in the Database:\n";
      if (!$config{db}->{readonly}) {
	$counter{files}->{new}++;
	$dir_msg .= " [Adding...]";
	$dbcsumlist{$file} = &uen($ncsumlist{$file});
      }
      $dir_msg .= " $file\n";
      if ($config{use_ls}) {
	  $dir_msg .= " " . $newfile->ls . "\n";
      }
      $dir_msg .= "\n";
  }
  elsif($dbcsumlist{$file} ne $ncsumlist{$file}) {
    # check configured bits
    $dir_msg .= &do_bit_checks($mask, $file, $dbfile, $newfile, $dir);
    if (!$config{db}->{readonly}) {
      # update db record
      $dbcsumlist{$file} = &uen($ncsumlist{$file});
    }
  }
}




sub do_bit_checks {
  my($mask, $file, $dbfile, $newfile, $dir) = @_;
  my($ch, $ls, $msg);

  ### print Dumper($mask);

  foreach my $bit (sort keys %{$mask}) {
    if($bit eq "md5" && $newfile->md5 ne $dbfile->md5) {
      $ch = 1;
      $msg .= "   ($algo checksum has changed)\n"
	." [Expected] " . $dbfile->md5 . "\n [Observed] " . $newfile->md5. "\n";
    }
    elsif($bit eq "ino" && $newfile->ino ne $dbfile->ino) {
      $ch = 1;
      $msg .= "   (Inode has changed)\n"
	." [Expected] " . $dbfile->ino . "\n [Observed] " . $newfile->ino . "\n";
    }
    elsif ($bit eq "dev" && $newfile->dev ne $dbfile->dev) {
      $ch = 1;
      $msg .= "   (Filesystem device number has changed)\n"
	." [Expected] " . $dbfile->dev . "\n [Observed] " . $newfile->dev . "\n";
    }
    elsif ($bit eq "mode" &&  $newfile->mode ne $dbfile->mode) {
      $ch = 1;
      my $oldmode = sprintf("%04o", $dbfile->mode & 07777);
      my $newmode = sprintf("%04o", $newfile->mode & 07777);
      $msg .= "   (File mode has changed)\n"
	." [Expected] $oldmode\n [Observed] $newmode\n";
    }
    elsif ($bit eq "nlink" && $newfile->nlink ne $dbfile->nlink) {
      $ch = 1;
      $msg .= "   (Number of links to this file has changed)\n"
	." [Expected] " . $dbfile->nlink . "\n [Observed] " . $newfile->nlink . "\n";
    }
    elsif ($bit eq "uid" && $newfile->uid ne $dbfile->uid) {
      $ch = 1;
      my $olduser = getpwnam($dbfile->uid);
      my $newuser = getpwnam($newfile->uid);
      $msg .= "   (Owner has changed)\n"
	." [Expected] $olduser\n [Observed] $newuser\n";
    }
    elsif ($bit eq "gid" && $newfile->gid ne $dbfile->gid ) {
      $ch = 1;
      my $olduser = getgrgid($dbfile->gid);
      my $newuser = getgrgid($newfile->gid);
      $msg .= "   (Group has changed)\n"
	." [Expected] $olduser\n [Observed] $newuser\n";
    }
    elsif ($bit eq "shrink" && $newfile->size < $dbfile->size && $mask->{$bit}) {
      $ch = 1;
      $msg .= "   (File size is shrinked)\n"
	." [Expected] " . $dbfile->size . " bytes\n [Observed] " . $newfile->size . " bytes\n";
    }
    elsif ($bit eq "grow" && $newfile->size > $dbfile->size && $mask->{$bit}) {
      $ch = 1;
      $msg .= "   (File size is growed)\n"
	." [Expected] " . $dbfile->size . " bytes\n [Observed] " . $newfile->size . " bytes\n";
    }
    elsif ($bit eq "size" && $newfile->size ne $dbfile->size) {
      $ch = 1;
      $msg .= "   (Size has changed)\n"
	." [Expected] " . $dbfile->size . " bytes\n [Observed] " . $newfile->size . " bytes\n";
    }
    elsif ($bit eq "mtime" && $newfile->mtime ne $dbfile->mtime) {
      $ch = 1;
      $msg .= "   (Modification time has changed)\n"
	." [Expected] \"" . scalar localtime($dbfile->mtime)
	  ."\"\n [Observed] \"" . scalar localtime($newfile->mtime) . "\"\n";
    }
    elsif ($bit eq "ctime" && $newfile->ctime ne $dbfile->ctime) {
      $ch = 1;
      $msg .= "   (Inode change time has changed)\n"
	." [Expected] \"" . scalar localtime($dbfile->ctime)
	  ."\"\n [Observed] \"" . scalar localtime($newfile->ctime) . "\"\n";
    }
    elsif ($bit eq "blocks" && $newfile->blocks ne $dbfile->blocks) {
      $ch = 1;
      $msg .= "   (Number of allocated blocks has changed)\n"
	." [Expected] " . $dbfile->blocks . " blocks\n [Observed] " . $newfile->blocks . " blocks\n";
    }
    else {
      # yes there could be a custom bit
      if ($bit =~ /^custom_(.*)$/) {
	my $name = $1;
	# call the closure.
	$msg .= &{$config{custom}->{$name}}($newfile, $dir, $msg) if($name);
      }
    }
  } # foreach end.
  if ($ch) {
    $ls = 1;
    my @called = caller(1);
    # yes, this could be done better...
    if ($called[3] eq "main::update_suid_db") {
      $counter{suid}->{changed}++;
    }
    else {
      $counter{files}->{changed}++;
    }
  }
  if ($config{use_ls} && $ch) {
    $ls = 0;
    $msg .= "   (file attributes)\n";
    $msg .= " [E] " . $dbfile->ls  . "\n";
    $msg .= " [O] " . $newfile->ls . "\n\n";
  }
  if ($msg) {
    $msg = "\n$file:\n" . $msg;
  }
  $msg;
}




sub wait_child {
  #
  # wait for child, avoid zombies
  #
  my $waitedpid = wait;
  $SIG{CHLD} = \&wait_child;
  $waitedpid = 0;
}

sub check_crontab{
  #
  # check crontab entries for every user
  # and report if it changed
  #
  my(%cronlist, $msg);
  $SIG{CHLD} = \&wait_child;
  my %user = &get_users;
  foreach my $login(keys %user) {
    open(CRON, "$config{bin}->{crontab} -u $login -l 2>&1 |")
      or die "Could not open pipe to $config{bin}->{crontab}: $!\n";
    while(<CRON>) {
      next if(/^#/);
      next if /no crontab for/;
      $cronlist{$login} = $cronlist{$login} . $_;
    }
    close(CRON);
  }

  eval {
    dbmopen(%dbcronlist, $config{db}->{cronDB}, 0600) ||
      die "Can't open $config{db}->{cronDB}\: $!\n";
  };
  if ($@) {
    $ERR .= "\n" .  $@;
  }
  else {
    foreach my $login (sort keys %cronlist) {
      if(! $dbcronlist{$login}) {
	$msg .= "Crontab entry for \"$login\" was not in the DataBase.";
	if (!$config{db}->{readonly}) {
	  $msg .= " [Adding...]";
	  $dbcronlist{$login} = $cronlist{$login};
	}
	$msg .= "\n" . &p_cron($cronlist{$login}) . "\n";
      }
      elsif($dbcronlist{$login} ne $cronlist{$login}) {
	$msg .= "Crontab entry for \"$login\"has changed.";
	$msg .= "\n [Expected]\n" . &p_cron($dbcronlist{$login})
	     .  "\n [Observed]\n" . &p_cron($cronlist{$login}) . "\n";

	if (!$config{db}->{readonly}) {
	  $dbcronlist{$login} = $cronlist{$login};
	}
      }
    }
    foreach my $login (sort keys %dbcronlist) {
      if(! $cronlist{$login}) {
	$msg .= "Crontab entry for \"$login\" not found.";
	if (!$config{db}->{readonly}) {
	  $msg .= " [Removing...]";
	  delete($dbcronlist{$login});
	}
	$msg .= "\n [Expected]\n" . &p_cron($dbcronlist{$login}) . "\n";
      }
    }
    dbmclose(%dbcronlist);
    undef %dbcronlist;
    undef %cronlist;
    if (!$opt_q || ($opt_q && $msg)) {
      $LOG .= $separator. "\n";
      $LOG .= "     User Crontab entries\n";
      $LOG .= $underline. "\n";
      $LOG .= $msg ."\n";
      if ($FirstTime) {
	print $LOG;
	$LOG = "";
      }
    }
  }
}



sub p_cron {
  #
  # print nice formatted crontab entry
  #
  my $entry = shift;
  $entry =~ s/^/ /gm;
  return $entry;
}


sub check_diskusage {
  my(%dudb, $msg);
  eval {
    dbmopen(%dudb, $config{db}->{diskusageDB}, 0600) or
      die "Can't open $config{db}->{diskusageDB}: $!\n";
  };
  if ($@) {
    $ERR .= "\n" .  $@;
  }
  else {
    foreach my $dir (sort keys %{$config{directory}}) {
      my $cursize   = $config{directory}->{$dir}->{du};
      my $dbsize    = $dudb{$dir};
      my $overflow  = $config{directory}->{$dir}->{du_increase} || 10;
      my $underflow = $config{directory}->{$dir}->{du_decrease} || 10;
      if ($cursize > $dbsize) {
	my $diff = $cursize - $dbsize;
	my $eins = $dbsize / 100;
	my $prozent = int($diff / $eins) if ($eins != 0);
	if ($prozent >= $overflow) {
	  $msg .= "+ $dir: disk occupancy has increased over $overflow%\n"
	    ."Old storage occupancy: $dbsize bytes\nNew storage occupancy: $cursize bytes\n\n";
	}
      }
      elsif ($cursize < $dbsize) {
	my $diff = $dbsize - $cursize;
	my $eins = $dbsize / 100;
	my $prozent = int($diff / $eins) if ($eins != 0);
	if ($prozent >= $underflow) {
	  $msg .= "- $dir: disk occupancy has decreased under $underflow%\n"
	    ."Old storage occupancy: $dbsize bytes\nNew storage occupancy: $cursize bytes\n\n";
	}
      }
      if (!$config{db}->{readonly}) {
	$dudb{$dir} = $cursize;
      }
    }
    if (!$opt_q || ($opt_q && $msg)) {
      $LOG .= $separator. "\n";
      $LOG .= "     Changes in disk usage\n";
      $LOG .= $underline. "\n";
      $LOG .= $msg ."\n";
      if ($FirstTime) {
	print $LOG;
	$LOG = "";
      }
    }
  }
}


sub gen_rsa_key {
  my $default_keysize = 1600;
  eval {
    require Crypt::OpenSSL::RSA;
    require Crypt::Primes;
    require Crypt::CBC;
    require MIME::Base64;
    if ($Crypt::OpenSSL::RSA::VERSION < 0.12) {
      die "Crypt::OpenSSL::RSA version 0.12 required--this is only version $Crypt::OpenSSL::RSA::VERSION";
    }
  };
  if ($@) {
    print "A required module could not be loaded: $@\n";
    exit 1;
  }
  else {
    # generate a new key

    print "Enter the keysize (smaller than $default_keysize will not work!) [$default_keysize]: ";
    my $size = <>;
    chomp $size;
    $size = $size || $default_keysize;

    my $rsa = new Crypt::OpenSSL::RSA;

    print "Generating prime\n";
    my $prime = Crypt::Primes::maurer (Size => $size, Verbosity => 1);

    print "\nGenerating keys\n";
    $rsa->generate_key($size, $prime);

    print "\nNew keysize: " . $rsa->size . " bytes\n";
    my $private = $rsa->get_private_key_string();
    my $public  = $rsa->get_public_key_string();

    #print "ORIGINAL: \n $public \n";
    $private =~ s/^.*(-----BEGIN.*KEY-----).*$/$1\n/s;
    $public  =~ s/^.*(-----BEGIN RSA PUBLIC KEY-----)\n(.*)\n(-----END RSA PUBLIC KEY-----).*$/$2/s;

    print "\nEnter passphrase for public key: ";
    my $phrase = &get_passwd;

    print "              repeat passphrase: ";
    my $twophrase = &get_passwd;

    if ($phrase ne $twophrase) {
      print STDERR "\n2nd passphrase is not identical to the 1st one!\n";
      exit -1;
    }

    print "Enter crypto algorithm to be used for key encryption[Blowfish]: ";
    my $algo = <>;
    chomp $algo;
    $algo = $algo || 'Blowfish';

    my $cypher = new Crypt::CBC($phrase, $algo);
    my $public_cypher = MIME::Base64::encode_base64($cypher->encrypt($public));

    # format it equivalent to the private key
    $public_cypher =~ s/\n//gs;
    $public_cypher =~ s/(.{64}?)/$1\n/g;

    $public = "-----BEGIN ENCRYPTED RSA PUBLIC KEY-----\n"
            . $public_cypher
            . "\n-----END ENCRYPTED RSA PUBLIC KEY-----\n";

    print "Please copy the following <keys> block into your nabourc:\n\n";
    print "<keys>\n";
    print "   PUBLIC <<EOF\n";
    foreach (split /\n/, $public) {
      print "      $_\n";
    }
    print "      EOF\n\n";
    print "   PRIVATE <<EOF\n";
    foreach (split /\n/, $private) {
      print "      $_\n";
    }
    print "      EOF\n</keys>\n\n";
    print "Additional, add the following parameter in the <db> block into your nabourc:\n\n";
    print "<db>\n";
    print "   # keep existing parameters!\n";
    print "   cipher  $algo\n</db>\n\n";
  }
}

################################################################################################################
sub check_proc {
  my @custom;
  my $custom = $config{proc}->{chk_custom};
  if ($custom) {
      if (ref($custom) eq "ARRAY") {
	  foreach (@{$custom}) {
	      push @custom, $_;
	  }
      }
      else {
	  @custom = ($custom) if($custom);
      }
  }

  if ($opt_D) {
    # daemonize!
    my $pidfile = $config{pidfile} || "/var/run/nabou.pid";
    my $go_int = sub {
      my $sig = shift;
      print STDERR "\n$$: received SIGINT. exiting.\n";
      print STDERR "cwd: " . `pwd`;
      unlink $pidfile or die "Could not remove \"$pidfile\": $!\n";
      exit;
    };
    my $go_term = sub {
      my $sig = shift;
      print "\n$$: received SIGTERM. exiting.\n";
      print "cwd: " . `pwd`;
      unlink $pidfile or die "Could not remove \"$pidfile\": $!\n";
      exit;
    };
    $SIG{INT}  = \&$go_int;
    $SIG{TERM} = \&$go_term;


    my $OldPid = $$;
    if (fork()) {
      exit(0);
    }

    setpgrp;

    if ($config{proc}->{argv}) {
      $0 = $config{proc}->{argv} . "\0";
    }

    if (-e $pidfile) {
      open RUN, "<$pidfile" or die $!;
      local $/ = undef;
      my $prevpid = <RUN>;
      close RUN;
      chomp $prevpid;
      print STDERR "nabou is already running. [PID: $prevpid]\n";
      exit;
    }
    else {
      open RUN, ">$pidfile" or die "Could not write PID to $pidfile! $!\n";
      print RUN $$;
      close RUN;
    }
  }

  local $config{use_algo} = "MD5";
  my $gotime = time;
  my @bits = split /\s*,\s*/, $config{proc}->{report};
  my (%park,$rest);

  # run. do it once or endless if in daemon mode
  do {
    my $ps = new PS;
    if ($config{proc}->{dump_proc}) {
      my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst) = localtime(time);
      $year += 1900;
      my $now  = "$year." . ++$mon . ".$day.$hour:$min:$sec";
      open DUMP, "> $config{proc}->{dump_proc}/proc.$now" or
	die "Could not create $config{proc}->{dump_proc}/proc.$now: $!\n";
      $Data::Dumper::Indent = 0; # don't waste space and time!
      print DUMP Data::Dumper->Dump([$ps], [qw(PS)]);
      close DUMP;
    }
    my($msg);
    if ($opt_D) {
      # reset $gotime.
      if (time - $gotime >= ($config{proc}->{report_old} * 60)) {
	$gotime = time;
	%park = ();
      }
    }
    PS:  foreach my $prc ($ps->get) {
	my $exe = new File($prc->exe);
	my $match;
	foreach my $prog (keys %{$config{proc}->{exclude}}) {
	  if ($config{proc}->{exclude}->{$prog}->{cmdline}) {
	      # && $prc->cmdline ne $config{proc}->{exclude}->{$prog}->{cmdline}) {
	      my @cmds;
	      my $cmdline = $config{proc}->{exclude}->{$prog}->{cmdline};
	      if (ref($cmdline) eq "ARRAY") {
		  foreach (@{$cmdline}) {
		      push @cmds, $_;
		  }
	      }
	      else {
		  @cmds = ($cmdline);
	      }
	      my $got = 1;
	      foreach (@cmds) {
		  if ($prc->cmdline =~ /$_/) {
		      $got = 0;
		      last;
		  }
	      }
	      next if ($got); # don't ignore it, if $got is still true!
	  }
	  if ($config{proc}->{exclude}->{$prog}->{md5} && $exe->md5 ne $config{proc}->{exclude}->{$prog}->{md5}) {
	    next;
	  }
	  if ($config{proc}->{exclude}->{$prog}->{uid} && $prc->uid ne $config{proc}->{exclude}->{$prog}->{uid}) {
	    next;
	  }
	  $prog =~ s/^""$//g;             # kernel procs, no exe!
	  next PS if($prc->exe eq $prog); # only if in an exclude block!
	}
	if (exists $park{$prc->pid} && $park{$prc->pid} eq $prc->exe &&
	    (time - $gotime < ($config{proc}->{report_old} * 60))) {
	  # we still got it but the wait time isn't over, so ignore it
	  # print "skip " . $prc->exe . " => " . $prc->pid . "\n";
	  next PS;
	}
	next if($prc->pid == $$); # ourself, $$ is the PID of current process in perl
	########
	if ($config{proc}->{chk_uid}) {
	  if ($prc->uid != $prc->euid) {
	    $match .= "real uid does not match effective uid. " ;
	  }
	}
	if ($config{proc}->{chk_argv}) {
	  my $exe = $prc->exe;
	  $exe =~ s(^.*/)(); # remove leading PATH
	  my $cmd = $prc->cmdline;
	  $cmd =~ s/^(.+?)\s+?.*$/$1/; # remove commandline args
	  if ($exe ne $cmd && $prc->exe ne $cmd) {
	    $match .= "cmdline (as seen by \"ps\") does not match executable. ";
	  }
	}
	if ($config{proc}->{chk_gid}) {
	  if ($prc->gid != $prc->egid) {
	    $match .= "real gid does not match effective gid. ";
	  }
	}
	if ($config{proc}->{chk_rundet}) {
	  if ($prc->tty eq "0" && $prc->state =~ /^R/) {
	    $match .= "running detached process without controlling tty. ";
	  }
	}
	foreach my $name (@custom) {
	  # call the closure.
	  $match .= &{$config{custom}->{$name}}($prc, $match) if($name);
	}
	########
	if ($match) {
	  # store for next daemon run.
	  $park{$prc->pid} = $prc->exe;
	  if ($config{proc}->{report} eq "ps") {
	      $msg .= sprintf(
			      "%-5d %-5d %-5d %3d %5d %-20s %-30s\n",
			      $prc->pid,
			      $prc->uid,
			      $prc->euid,
			      $prc->fdnum,
			      $prc->tty,
			      $prc->exe,
			      $prc->cmdline
			      );
	  }
	  else {
	      $msg .= "\n";
	      foreach (@bits) {
		  $msg .= "$_: ";
		  if ($_ eq "fd") {
		      $msg .= join ", ", values %{$prc->{fd}};
		  }
		  else {
		      $msg .= $prc->{$_};
		  }
		  $msg .= "\n";
	      }
	  }
	  if (!$config{proc}->{noreason}) {
	      $msg .= "problem: $match\n";
	      if ($config{proc}->{report} eq "ps") {
		  $msg .= "\n";
	      }
	  }
	  $match = 0;
	}
      }

    if ($msg) {
      if ($config{usemail}) {
	open(MAIL, "|$config{bin}->{sendmail} -t") or die $!;
	select MAIL;
	print "From: $config{mail}->{from}\n";
	print "To: $config{mail}->{rcpt}\n";
	print "Cc: $config{mail}->{cc}\n" if($config{mail}->{cc});
	print "Subject: $config{mail}->{subject}\n\n\n";
      }
      $msg =~ s/\0/ /g;
      print "Weird processes:\n";
      if ($config{proc}->{report} eq "ps") {
	  print "PID   RUID  EUID    FH  TTY EXE                  CMDLINE\n";
      }
      print "$msg\n";
      $msg = "";
      if($config{usemail}) {
	close MAIL;
      }
    }
    if ($opt_D) {
      sleep $config{proc}->{refresh} || 0;
    }
  } while ($opt_D);
}




sub dump {
  my($db, $raw) = @_;
  my %database;
  if (!-e $db) {
      die "The database \"$db\" does not exit!\n";
  }
  if ($config{db}->{protected}) {
    &auth;
  }
  dbmopen(%database, $db, 0600) or
    die "Can't open $db: $!\n";

  if (@ARGV) {
    foreach my $file (sort @ARGV) {
      &dump_data($file, &ude($database{$file}), $raw);
    }
  }
  else {
    foreach my $file (sort keys %database) {
      &dump_data($file, &ude($database{$file}), $raw);
    }
  }
}


sub dump_data {
  my($file, $csv, $raw) = @_;
  my $trans = new File;
  my $c = ",";
  print $file . $c;
  if ($raw) {
    my $line = $csv;
    $line =~ s/:/,/g;
    print $line . "\n";
  }
  else {
    $trans->csv($csv, 1);
    print $trans->md5 . $c . $trans->dev . $c . $trans->ino . $c;
    print sprintf("%04o", $trans->mode & 07777);
    print $c . $trans->nlink . $c;
    print getpwuid($trans->uid) . $c;
    print getgrgid($trans->gid) . $c;
    print $trans->rdev . $c . $trans->size . $c;
    print scalar localtime($trans->atime);
    print $c;
    print scalar localtime($trans->mtime);
    print $c;
    print scalar localtime($trans->ctime);
    print $c . $trans->blksize . $c . $trans->blocks;
    print "\n";
  }
}


sub usage {
  print "usage: $0 [-c | --config <configfile>] [options]\n"
    ."-i --init                initialize $0\n"
    ."-r --reset               reset $0 database\n"
    ."-d --dump <db> [file(s)] dump the contents of a nabou db\n"
    ."   --raw                 causes an unformatted dump\n"
    ."-u --update [<file(s)>]  update database entry of <file> or all\n"
    ."                         entries if no file specified.\n"
    ."-D --daemon              run as daemon, only used by proc monitoring.\n"
    ."-q --quiet               show only changes, otherwise be quiet\n"
    ."   --def NAME[=value]    set variable NAME to true or <value>. multiple\n"
    ."                         variables are allowed. see manpage for details.\n"
    ."-k --genkey              generate a public/private RSA key pair for\n"
    ."                         database protection. The public key will be\n"
    ."                         encrypted.\n"
    ."-h --help                show this message\n"
    ."-v --version             show version number\n"
    ."$0 with no options is normal operation mode\n";
  exit;
}




sub get_passwd {
  #
  # get a password without echo
  #
  my $key;
  eval {
    local($|) = 1;
    local(*TTY);
    open(TTY,"/dev/tty") or die $!;
    system ("stty -echo </dev/tty") and die $!;
    chomp($key = <TTY>);
    print STDERR "\r\n";
    system ("stty echo </dev/tty") and die $!;
    close(TTY) or die $!;
  };
  if ($@) {
    $key = <>;
  }
  chomp $key;
  return $key;
}


sub auth {
  my($key);
  if (!exists $ENV{'NABOU_PASSWD'}) {
    print STDERR "password: ";
    $key = &get_passwd;
  }
  else {
    $key = $ENV{'NABOU_PASSWD'};
  }
  chomp $key;

  if (!exists $config{keys}->{PUBLIC} || $config{keys}->{PUBLIC} =~ /^\s*$/) {
    print STDERR "No public key found! Generate one with \"nabou -k\".\n";
    &alert("PROTECTED mode without PUBLIC KEY in config file!");
    exit 1;
  }

  # put this stuff inside an eval block, so it compiles even
  # if protected == 0 and/or the modules cannot be found!
  eval {
    my $method = $config{db}->{cipher} || "Blowfish";
    $cipher = new Crypt::CBC($key, $method);
    # decrypt the encrypted public key in the config

    my $public_b64 = $key{PUBLIC};
    $public_b64 =~ s/^.*-----BEGIN ENCRYPTED RSA PUBLIC KEY-----\n(.*)\n-----END ENCRYPTED RSA PUBLIC KEY-----.*$/$1/s;

    my $cl_public = $cipher->decrypt(MIME::Base64::decode_base64($public_b64));

    # reformat the public key
    $key{PUBLIC} = "-----BEGIN RSA PUBLIC KEY-----\n" . $cl_public . "\n-----END RSA PUBLIC KEY-----\n";

    # create RSA object
    $rsa =  new Crypt::OpenSSL::RSA;

    # inject the public key into the rsa object
    $rsa->load_public_key($key{PUBLIC});

    # inject the private key into the rsa object too
    $rsa->load_private_key($key{PRIVATE});

    # verify the identity, if the decrypted is NOT BASE64 encoded
    # then Decoding failed. Mostly because the wron passphrase was
    # supplied
    if ($cl_public !~ /^[a-zA-Z0-9\+\/=\n]*$/) {
      print STDERR "permission denied.\n";
      &alert("invalid credentials supplied or private and public keys do not match");
      exit 1;
    }
  };
  die if $@;
}



sub update_file {
  my (@files) = @_;
  my(%db);
  my $sp = " " if($algo =~ /^MD/);
  if ($config{db}->{protected}) {
    &auth;
  }

  my $curdir = `pwd`;
  my $db = $config{db}->{basedir} . "/" . $config{db}->{csumDB};
  dbmopen(%db, $db, 0600) or
    die "Can't open $db: $!\n";

  foreach my $file (@files) {
    # prepend curdir if not absolute filename
    chomp $file;
    chomp $curdir;
    if ($file !~ /^\//) {
      $file = $curdir . "/" . $file;
    }
    print "          Filename: " . $file . "\n";
    if (-e $file) {
      print "            Status: ";
      my $obj = new File($file);
      if (!exists $db{$file}) {
	print "File is not in the DataBase: [Adding...]\n";
      }
      else {
	print "File exists in the DataBase: [Updating...]\n";
      }
      $db{$file} = &uen($obj->csv(0,1));
      print " $sp    $algo checksum: " . $obj->md5 . "\n";
      print "              Mode: " . sprintf("%04o", $obj->mode & 07777) . "\n";
      print "             Owner: " . getpwuid($obj->uid) . "\n";
      print "             Group: " . getgrgid($obj->gid) . "\n";
      print "              Size: " . $obj->size . " bytes\n";
      print "       Access Time: " . scalar localtime($obj->atime) . "\n";
      print " Modification Time: " . scalar localtime($obj->mtime) . "\n";
      print " Inode Change Time: " . scalar localtime($obj->ctime). "\n" ;
      print "\n";
    }
    else {
      print "           Status: was not found or no more being monitored. [Removing...]\n";
      delete $db{$file};
    }
  }
  dbmclose(%db)
}




sub compile_custom {
  #
  # yo - guys, now we create an anonymous sub
  # save a closure to this in $config{code}->{scriptname}
  # using perls magic eval.
  # hell, I love perl!
  #
  if (exists $config{script}->{BEGIN}) {
    # do this as the first job
    eval $config{script}->{BEGIN};
    delete $config{script}->{BEGIN};
    if ($@) {
      die "Scriptlet \"BEGIN\" contains errors:\n $@\n";
    }
  }
  foreach my $name (keys %{$config{script}}) {
    if ($config{script}->{$name}) {
      my $rawcode = $config{script}->{$name};
      my $code;
      if ($name eq "END") {
	  $config{custom}->{$name} = $rawcode;
      }
      else {
	$code    = "\$config{custom}->{$name} = sub { $rawcode };";
      }
      eval $code;
      if ($@) {
	die "Scriptlet \"$name\" contains errors:\n $@\n";
      }
    }
  }
}



sub alert {
    my($msg)     = @_;
    my $rcpt     = $config{mail}->{alert}   || "root";
    my $from     = $config{mail}->{from}    || "root";
    my $subject  = "ALERT! Suspicious Activity observed: $msg";
    my $sendmail = $config{bin}->{sendmail} || "/usr/lib/sendmail";
    my $who      = $config{bin}->{who}      || "/usr/bin/who";

    my $w = `$who am i`;
    chomp $w;
    my($tty, $begin, $remote) = $w =~ /\s\s*([a-zA-Z0-9\/]*)\s\s*([a-zA-Z:0-9\s]*)\s*\(?(.*)\)?/;

    $remote =~ s/\)$//;
    $remote = $remote || "localhost";

    my $proc;
    my $ps = new PS;
    foreach my $process ($ps->get) {
      if ($process->uid == $<) {
	my $exe = $process->exe || $process->cmdline || "<" . $process->comm . " " . $process->state . ">";
	$proc .= $process->pid . " " x (10 - length($process->pid)) . $exe . "\n                  ";
      }
    }

    open(MAIL, "|$sendmail -t") or return; # FIXME: should do a fallback to syslog!
    print MAIL "From: $from\n"
              ."To: $rcpt\n"
	      ."Subject: $subject\n\n\n"
	      ."         MESSAGE: $msg\n"
              ."            TIME: " . scalar localtime(time) . "\n"
	      ."          CONFIG: $configfile\n"
	      ."            USER: " . getpwuid($<) . "\n"
	      ."        UID/EUID: $</$>\n"
	      ."        GID/EGID: $(/$)\n"
	      ."     COMING FROM: $remote\n"
	      ." LOGGED IN SINCE: $begin\n"
	      ."             TTY: $tty\n"
	      ."            HOST: $ENV{HOSTNAME}\n"
	      ."           SHELL: $ENV{SHELL}\n"
	      ."            PATH: ";

    print MAIL join "\n                  ", split /:/, $ENV{PATH};

    if ($proc) {
      print  MAIL  "\n       PROCESSES: " . $proc;
    }
    close MAIL;
}



sub uen {
  my $text = shift;
  return if($text =~ /^:*$/);
  my($T);
  if($config{db}->{protected}) {
    eval {
      # FIXME: try to encrypt block-wise, which allows smaller keysizes!
      my $x = $rsa->encrypt($text) or
	die "Could not encrypt, key maybe too small(textsize: "
	  . length($text) . "bytes, keysize: " . $rsa->size . "bytes)!\n$text\n";
      $T = MIME::Base64::encode_base64($x);
      $T =~ s/\n//sg;
    };
    die if $@;
  }
  else {
    $T = $text;
  }
  chomp $T;
  return $T;
}

sub ude {
  my $text = shift;
  return if($text =~ /^:*$/);
  my($T);
  if($config{db}->{protected}) {
    eval {
      $T = $rsa->decrypt(MIME::Base64::decode_base64($text));
      if ($T !~ /^[a-zA-z0-9]*:[\d:]+?$/ && $T !~ /command=.*login=.*port=.*protocol=.*/) {
	# oh, no!
	&alert("A database entry could not be decrypted!\n$T");
	exit 1;
      }
    };
  }
  else {
    $T = $text;
  }
  return $T;
}










#########################################################################################
# packages
#########################################################################################

package File;

sub new {
  #
  # create new File object
  #
  my($this, $file ) = @_;
  my $class = ref($this) || $this;
  my $self = {};
  bless($self,$class);

  my(%stats);
  %stats = ();

  $self->{file} = $file;
  $self->{cipher} = "";

  # open the file and get stats
  if ($file) {
    $self->_stats;
    $self->_md5;
  }
  # else empty file object.
  return $self;
}


sub _stats {
  my($this) = @_;
  my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
         $atime,$mtime,$ctime,$blksize,$blocks);
  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
   $atime,$mtime,$ctime,$blksize,$blocks) = stat($this->{file});
  my %stats = (
	       dev	=> $dev,
	       ino	=> $ino,
	       mode	=> $mode,
	       nlink	=> $nlink,
	       uid	=> $uid,
	       gid	=> $gid,
	       rdev	=> $rdev,
	       size	=> $size,
	       atime	=> $atime,
	       mtime	=> $mtime,
	       ctime	=> $ctime,
	       blksize	=> $blksize,
	       blocks	=> $blocks,
	      );
  $this->{stats} = \%stats;
}

sub csv {
  #
  # 4 scenarios:
  #
  # 1. if $protected == 1 and $csv then $csv is expected to be encrypted
  #    decrypt $csv, initialize $this from this, throw an error, if result
  #    is _not_ a plain csv entry
  #
  # 2. if $protected == 1 and !$csv, then encrypt $this->{csv} and return
  #    the result of this operation for being stored in a database
  #
  # 3. if !$protected and $csv, then simply initialize $this from $csv
  #
  # 4. if !$protected and !$csv, then simply return $this->{csv} for
  #    database storage

  my($this, $csv, $ram) = @_;
  if (!$csv) {
    # return csv entry for database storage
    my $list =       $this->md5     . ":"
		   . $this->dev     . ":"
		   . $this->ino     . ":"
		   . $this->mode    . ":"
		   . $this->nlink   . ":"
		   . $this->uid     . ":"
		   . $this->gid     . ":"
		   . $this->rdev    . ":"
		   . $this->size    . ":"
		   . $this->atime   . ":"
		   . $this->mtime   . ":"
		   . $this->ctime   . ":"
		   . $this->blksize . ":"
		   . $this->blocks;

    $this->{csv}    = $list;
    $list = &main::uen($list) if(!$ram); # &main::uen mades the decision wether to encrypt or not!
    $list;
  }
  else {
    # initialize $this from given $csv
    # $csv may be encrypted if $protected!
    $csv = &main::ude($csv) if(!$ram);

    my @ar = split /:/, $csv, 14;
    my %stats = (
		 md5     => $ar[0],
		 dev	 => $ar[1],
		 ino	 => $ar[2],
		 mode	 => $ar[3],
		 nlink	 => $ar[4],
		 uid	 => $ar[5],
		 gid	 => $ar[6],
		 rdev	 => $ar[7],
		 size	 => $ar[8],
		 atime	 => $ar[9],
		 mtime	 => $ar[10],
		 ctime	 => $ar[11],
		 blksize => $ar[12],
		 blocks	 => $ar[13],
		);
    $this->{csv}    = join ":", @ar;
    $this->{stats}  = \%stats;
    return $csv;
  }
}


sub CSV {
    my($this) = @_;
    return $this->{csv};
}



sub _md5 {
  my($this) = @_;
  if ($algo eq "MD2") {
    $md5 = new Digest::MD2;
  }
  elsif ($algo eq "SHA1") {
    $md5 = new Digest::SHA1;
  }
  else {
    $md5 = new Digest::MD5;
  }
  if (-l $this->{file} && !-e $this->{file}) {
    $ERR .= "\n" . "symlink \"$this->{file}\" points to non existent destination:\n  => \"" . readlink($this->{file}) . "\"";
  }
  elsif (-p $this->{file} || -c $this->{file} || -b $this->{file}) {
    # fifo/character/block file
    $this->{stats}->{md5} = "";
  }
  else {
    open FILE, $this->{file} or $ERR.= "Can't open file $this->{file} for $algo checksum: $!\n";
    binmode(FILE);
    $md5->addfile(*FILE);
    $this->{stats}->{md5} = $md5->hexdigest;
    close FILE;
  }
  undef $md5;
}


sub filename {
  my($this, $filename) = @_;
  if ($filename) {
      $this->{file} = $filename;
  }
  return $this->{file};
}



sub ls {
    my($this) = @_;
    my $mode  = $this->bitify(sprintf("%04o", $this->mode & 07777));

    my $owner = getpwuid($this->uid);
    my $group = getgrgid($this->gid);
    my $time  = scalar localtime($this->mtime);

    $owner    = " " x (8 - length($owner)) . $owner;
    $group    = " " x (8 - length($group)) . $group;
    $time     = " " x (12 - length($time)) . $time;
    my $size  = " " x (8  - length($this->size)) . $this->size;


    return "$mode " . $this->nlink . " $owner $group  $size  $time  ";
}


sub bitify {
    my ($this, $bit) = @_;
    my @types = split//, $bit;
    my $suid = shift @types;
    my $hmode;
    foreach (@types) {
        my $bit = $_;
        my @mask = qw(- - -);
        while($bit) {
            if($bit >= 4)  {  $mask[0] = "r"; $bit -= 4; next; }
            if($bit >= 2)  {  $mask[1] = "w"; $bit -= 2; next; }
            if($bit >= 1)  {  $mask[2] = "x"; $bit -= 1; next; }
        }
        $hmode .= join "", @mask;
    }
    my @modes = split //, $hmode;
    while($suid) {
	if($suid >= 4)  { $modes[2] = ($modes[2] eq "-") ? "S" : "s"; $suid -= 4; next; }
	if($suid >= 2)  { $modes[5] = ($modes[5] eq "-") ? "S" : "s"; $suid -= 2; next; }
	if($suid >= 1)  { $modes[8] = ($modes[8] eq "-") ? "T" : "t"; $suid -= 1; next; }
    }
    if (-d $this->filename) {
      return "d" . join "", @modes;
    }
    else {
      return "-" . join "", @modes;
    }
}



sub AUTOLOAD {
   # return a %stats value
   my($this) = shift;
   my $SUB = $File::AUTOLOAD;  # get to know how we were called
   $SUB =~ s/.*:://; # remove package name!
   return (exists $this->{stats}->{$SUB}) ? $this->{stats}->{$SUB} : "";
}

1;





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

package Process;

sub new {
  my($this) = shift;
  my %properties = @_;
  my $class = ref($this) || $this;
  my $self = \%properties;
  bless($self,$class);
  return $self;
}

sub fd {
  my($this) = shift;
  return %{$this->{fd}};# if($this->{fdnum} > 0);
}


sub AUTOLOAD {
   my($this) = shift;
   my $SUB = $Process::AUTOLOAD;  # get to know how we were called
   $SUB =~ s/.*:://;              # remove package name!
   return (exists $this->{$SUB}) ? $this->{$SUB} : "";
}

1;




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

package PS;

use Data::Dumper;

sub new {
  my($this) = @_;
  my $class = ref($this) || $this;
  my $self = {};
  bless($self,$class);
  $self->gather();
  return $self;
}



sub gather {
  my($this) = @_;
  my @stat = qw(pid comm state ppid pgrp session tty tpgid flags minflt cminflt majflt
		cmajflt utime stime cutime cstime counter priority timeout itrealvalue
		starttime vsize rss rlim startcode endcode startstack kstkesp kstkeip
		signal blocked sigignore sigcatch wchan nswap cnswap exit_signal unknown);
  #                                                       does anybody know?     ^^^^^^^ !
  opendir PROC, "/proc" or die "proc filesystem not supported!\n";
  PS: while (my $pid = readdir(PROC)) {
    next if($pid !~ /^\d\d*$/); # must be a number!
    chdir "/proc/$pid";
    $this->{cwd} = "/proc/$pid";
    my(%prop, @stats);
    eval {
      @stats = split/ /, $this->read("stat");
    };
    if ($@ =~ /^No such file or directory/) {
      next PS;
    }

    my $pos = 0;
    %prop = map { $stat[$pos++] => $_; } @stats;
    $prop{cmdline} = $this->read("cmdline");
    $prop{cmdline} =~ s/\0/ /g;  # remove NULL bytes
    $prop{cmdline} =~ s/\s*$//g; # remove trailing spaces.
    $prop{exe}     = readlink("exe");
    $prop{cwd}     = readlink("cwd");
    open STATUS, "< status" or die $!;
    while (<STATUS>) {
      chomp;
      if (/^Uid:\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)/) {
	$prop{uid}  = $1; # real      uid
	$prop{euid} = $2; # effective uid
	$prop{suid} = $3; # saved     uid
	$prop{fuid} = $4; # file      uid
      }
      if (/^Gid:\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)\s+?(\d+?)/) {
	$prop{gid}  = $1;
	$prop{egid} = $2;
	$prop{sgid} = $3;
	$prop{fgid} = $4;
      }
    }
    close STATUS;
    opendir FD, "fd";
    while (my $fh = readdir(FD)) {
      next if($fh =~ /^\.+?$/);
      $prop{fdnum}++;
      $prop{fd}->{$fh} = readlink("fd/$fh");
    }
    closedir FD;
    my $prc = new Process(%prop);
    push @{$this->{processes}}, $prc;
    %prop = ();
  }
  closedir PROC;
}


sub read {
  my($this, $file) = @_;
  open FILE, "< $this->{cwd}/$file" or die "$!: $this->{cwd}/$file";
  local $/ = undef;
  my $inhalt = <FILE>;
  close FILE;
  chomp $inhalt;
  return $inhalt;
}


sub get {
  my($this) = @_;
  return @{$this->{processes}};
}

1;

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