#!/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.
#
# $Id: nabou,v 1.5 2000/09/09 00:08:33 tom Exp tom $
#
# Copyright 2000 (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 Data::Dumper;
use Digest::MD5;
use Digest::SHA1;
use Digest::MD2;
use FileHandle;
use strict;
require "newgetopt.pl";

# you may edit this values
my $configfile = "/etc/nabourc";
my $separator  = "  ";
my $underline  = "  " . "-" x 36 . "";

my(
   %config, $conf,				# config obj and hash
   $FirstTime, $Help, $Reset,			# modi
   $md5,					# the MD5/SHA1/MD2 object.
   %userhash,					# contains actual userinfo
   %suidlist,					# file nfo (set u|gid)
   %ncsumlist,					# file list
   %cronlist,                                   # cronjob list
   %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,
   %suid_mask, $suid_msg, $dir_msg, $algo,
   $cipher,                                     # the Crypt::CBC object
  );

# define the version string from RCS
$version ="$Revision: 1.5 BETA1 $dummy";
$version =~ s/^: //;
$version =~ s/ $//;

# get commandline options and store them in scalar refs.
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
			 );

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 (c) Thomas Linden\n";
    exit 1;
}


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

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



# load the config file using the internal Conf module.
$conf = new Conf($configfile);
%config = $conf->getall();


# load crypt module, if required
if ($config{db}->{protected}) {
    eval { require Crypt::CBC; };
    if($@) {
	print STDERR "A required module could not be loaded:\n";
        die $@;
    }
    # 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)$/) {
  $algo = "$config{use_algo}";
}
elsif ($config{use_algo}) {
  print "Unknown checksum algorithm $config{use_algo}.\n";
  exit;
}
else {
  # the default
  $algo = "MD5";
}

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} || -e $config{db}->{basedir} . "/keydb") {
	&auth;
    }
    delete $config{db}->{readonly};
}


# use mail instead of STDOUT
if($config{usemail} && !$opt_r && !$opt_i) {
  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";
}


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 "$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
foreach my $dir (sort keys %{$config{directory}}) {
      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};
      }
      elsif ($str_switches eq "") {
	  # use the default checks
	  $config{directory}->{$dir} = {
					chk_md5   => 1,
					};
      }
}



# 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;
    }
    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);
    }
}


# init mode (if -r or -i used)
if($Reset || $FirstTime) {
  if (-e "keydb") {
    # authenticate if the keydb already exists!
    &auth;
  }
  if ($config{db}->{protected}) {
    if (-e "keydb") {
      # we will create a new one later on
      &alert("invoked with -r or -i flag.");
      unlink "keydb" or die "Could not remove keydb: $!\n";
    }
    print $separator, "\n";
    print "        Setting a new password for protected updates\n\n";
    &set_passwd;
  }
  else {
    if (-e "keydb") {
      # no more protection, but the keydb still exists, so remove it.
      &alert("database protection removed.");
      unlink "keydb" or die "Could not remove keydb: $!\n";
    }
  }

  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.
  unlink($config{db}->{pwdDB});
  unlink($config{db}->{csumDB});
  unlink($config{db}->{cronDB});
  unlink($config{db}->{sugidDB});
  unlink($config{db}->{miscDB});
  unlink($config{db}->{diskusageDB});

  unlink($config{db}->{pwdDB}   . ".dir");
  unlink($config{db}->{pwdDB}   . ".pag");

  unlink($config{db}->{csumDB}  . ".dir");
  unlink($config{db}->{csumDB}  . ".pag");

  unlink($config{db}->{cronDB}  . ".dir");
  unlink($config{db}->{cronDB}  . ".pag");

  unlink($config{db}->{sugidDB} . ".dir");
  unlink($config{db}->{sugidDB} . ".pag");

  unlink($config{db}->{miscDB}  . ".dir");
  unlink($config{db}->{miscDB}  . ".pag");

  unlink($config{db}->{diskusageDB} . ".dir");
  unlink($config{db}->{diskusageDB} . ".pag");
}



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

&compile_custom;

#print Dumper(\%config);
#exit;

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

&update_pwd_db       if($config{check_users});

&check_crontab       if($config{check_cron});
&update_cron_db      if($config{check_cron});

&check_suid          if($config{check_suid});
&update_suid_db      if($config{check_suid});

&check_directories   if($config{check_md5} || $config{check_files});
&update_dir_db       if($config{check_md5} || $config{check_files});

&check_diskusage     if($config{check_diskusage});

&check_proc          if($config{check_proc});


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

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

exit 0;

# the end of the script.














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



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
  dbmopen(%dbmisc, $config{db}->{miscDB}, 0600) || die "Can't open $config{db}->{miscDB}\: $!\n";

  $mailprog = new File($config{bin}->{sendmail});
  $trans->csv($dbmisc{$config{bin}->{sendmail}});
  if($mailprog->md5 ne $trans->md5 || $mailprog->mtime ne $trans->mtime) {
    if($FirstTime == 1) {
      print "Updating: $config{bin}->{sendmail}\n";
      $dbmisc{$config{bin}->{sendmail}} = $mailprog->csv;
    }
    else{
      $msg .= "$config{bin}->{sendmail}\'s file info has changed.  It's Possible this program\n"
	  ."has been tampered with.\n";
    }
  }
  $crontab = new File($config{bin}->{crontab});
  $trans->csv($dbmisc{$config{bin}->{crontab}});
  if($crontab->md5 ne $trans->md5 || $crontab->mtime ne $trans->mtime) {
    if($FirstTime == 1) {
      print "Updating: $config{bin}->{crontab}\n";
      $dbmisc{$config{bin}->{crontab}} = $crontab->csv;
    }
    else{
      $msg .= "$config{bin}->{crontab}\'s file info has changed.  It's Possible this program\n"
	  ."has been tampered with.";
    }
  }
  if ($config{db}->{protected}) {
    my $keyfile = $config{db}->{basedir} . "/keydb";
    my $keyobj   = new File($keyfile);
    $trans->csv($dbmisc{$keyfile});
    if ($keyobj->md5 ne $trans->md5 || $keyobj->mtime ne $trans->mtime) {
      if ($FirstTime == 1) {
	print "Updating: $keyfile\n";
	$dbmisc{$keyfile} = $keyobj->csv;
      }
      else {
	$msg .= "$keyfile\'s file info has changed.  It's Possible this program\n"
	  ."has been tampered with.";
      }
    }
  }
  if (($opt_q && $msg) || !$opt_q) {
    print $separator, "\n";
    print "    Verifying the stability of nabou\n";
    print $underline, "\n";
    print $msg . "\n";
  }
  dbmclose(%dbmisc);
}



sub get_root_info {
  # store all root user accounts
  my($login,$passwd,$uid,$gid,$comment,$home,$shell,@rest,$user);
  open(PASSWD, "<$config{passwd}") || die "Can't open $config{passwd}: $!\n";
  while(<PASSWD>) {
    chomp;
    ($login,$passwd,$uid,$gid,$comment,$home,$shell) = split(":", $_);
    if(($uid == 0 || $gid == 0) || ($uid == 131072 || $gid == 131072)) {
      if($config{shadow} == 1) {
	open(SHADOW, $config{shadow}) || die "Can't open $config{shadow}: $!\n";
	while(<SHADOW>) {
	  if(/^$login/) {
	    chomp;
	    ($user, $passwd, @rest) = split /:/;
	  }
	}
	close(SHADOW);
      }
      $userhash{$login} = join ":", ($login,$passwd,$uid,$gid,$comment,$home,$shell);
    }
  }
  close(PASSWD);
}




sub show_roots {
  # print out all about 0 userz
  my($login,$passwd,$uid,$gid,$comment,$home,$shell);
  print $separator, "\n";
  print "     Users with root UID's and GID's\n";
  print $underline, "\n";
  foreach(keys %userhash) {
    ($login,$passwd,$uid,$gid,$comment,$home,$shell) = split(":", $userhash{$_});
    print "User: $login UID=$uid\tGID=$gid\tHOME=$home\tSHELL=$shell\tPASSWD=$passwd\n";
  }
}




sub update_pwd_db {
  my(%dbpwd, $msg);
  dbmopen(%dbpwd, $config{db}->{pwdDB}, 0600) || die "Can't open $config{db}->{pwdDB}\: $!\n";
  foreach my $login (keys %userhash) {
    if(! $dbpwd{$login}) {
      $msg .= "$login:\tAccount was not in the DataBase.";
      if (!$config{db}->{readonly}) {
	  $msg .= " [Adding...]";
	  $dbpwd{$login} = $userhash{$login};
      }
      $msg .= "\n";
    }
    elsif($userhash{$login} ne $dbpwd{$login}) {
      $msg .= "$login:\tAccount information was changed.\n";
      my @olddata = split(":", $userhash{$login});
      my @dbdata  = split(":", $dbpwd{$login});
      $msg .= "[Old]\tUID=$dbdata[2]\tGID=$dbdata[3]\tHome Dir=$dbdata[5]\tShell=$dbdata[6]\n";
      $msg .= "[New]\tUID=$olddata[2]\tGID=$olddata[3]\tHome Dir=$olddata[5]\tShell=$olddata[6]\n";
      $dbpwd{$login} = $userhash{$login} if (!$config{db}->{readonly});
    }
  }
  foreach my $login(keys %dbpwd) {
    if(! $userhash{$login}) {
      $msg .= "$login\:\tAccount was not found.";
      if (!$config{db}->{readonly}) {
	  $msg .= " [Removing...]";
	  delete($dbpwd{$login});
      }
      $msg .= "\n";
    }
  }
  dbmclose(%dbpwd);
  if (($opt_q && $msg) || !$opt_q) {
    print $separator, "\n";
    print "    Changed user accounts\n";
    print $underline, "\n";
    print $msg . "\n";
  }
}




sub check_suid {
    &recurse_suid("/");
}


sub recurse_suid {
    my($dir) = @_;
    my($file);
    my $fh = new IO::Handle;
    opendir $fh, $dir or die "$!\n";
    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;
	}
	next if($file =~ /^\/proc/);
        if(-d $file && !-l $file) {
            &recurse_suid($file);
        }
        if(!-l $file && !-d $file && (-u $file || -g $file)) {
            my $obj = new File($file);
            $suidlist{$file} = $obj->csv;
        }
    }
}



sub update_suid_db {
  my(%dbsugid, $dbfile, $newfile, $msg);
  my $ch;
  dbmopen(%dbsugid, $config{db}->{sugidDB}, 0600) or
    die "Can't open $config{db}->{sugidDB}: $!\n";
  $dbfile  = new File; # empty File objects for checking, see below.
  $newfile = new File;
  foreach my $file (sort keys %suidlist) {
    $dbfile->csv($dbsugid{$file});
    $newfile->csv($suidlist{$file});
    $newfile->filename("$file");
    if(! $dbsugid{$file}) {
      $msg .= "$file:\tFile was not in the DataBase.";
      if (!$config{db}->{readonly}) {
	  $msg .= " [Adding...]";
	  $dbsugid{$file} = $suidlist{$file};
      }
      $msg .= "\n";
      $msg .= &ShellChecksum($file);
      if ($config{use_ls}) {
	  $msg .= $newfile->ls . "\n\n";
      }
    }
    elsif($dbsugid{$file} ne $suidlist{$file}) {
      foreach my $bit (sort keys %suid_mask) {
	  if($bit eq "md5" && $newfile->md5 ne $dbfile->md5) {
	      $ch = 1;
	      $msg .= "$file:\t ($algo checksum has changed)\n"
		   ."[Old] " . $dbfile->md5 . "\n[New] " . $newfile->md5. "\n";
	  }
	  elsif($bit eq "ino" && $newfile->ino ne $dbfile->ino) {
	      $ch = 1;
	      $msg .= "$file:\t (Inode has changed)\n"
		   ."[Old] " . $dbfile->ino . "\n[New] " . $newfile->ino . "\n";
	  }
	  elsif ($bit eq "dev" && $newfile->dev ne $dbfile->dev) {
	      $ch = 1;
	      $msg .= "$file:\t (Filesystem device number has changed)\n"
		   ."[Old] " . $dbfile->dev . "\n[New] " . $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:\t (File mode has changed)\n"
		   ."[Old] $oldmode\n[New] $newmode\n";
	  }
	  elsif ($bit eq "nlink" && $newfile->nlink ne $dbfile->nlink) {
	      $ch = 1;
	      $msg .= "$file:\t (Number of links to this file has changed)\n"
		   ."[Old] " . $dbfile->nlink . "\n[New] " . $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 .= "$file:\t (Owner has changed)\n"
		   ."[Old] $olduser\n[New] $newuser\n";
	  }
	  elsif ($bit eq "gid" && $newfile->gid ne $dbfile->gid ) {
	      $ch = 1;
	      my $olduser = getgrgid($dbfile->gid);
	      my $newuser = getgrgid($newfile->gid);
	      $msg .= "$file:\t (Group has changed)\n"
		   ."[Old] $olduser\n[New] $newuser\n";
	  }
	  elsif ($bit eq "size" && $newfile->size ne $dbfile->size) {
	      $ch = 1;
	      $msg .= "$file:\t (Size has changed)\n"
		   ."[Old] " . $dbfile->size . " bytes\n[New] " . $newfile->size . " bytes\n";
	  }
	  elsif ($bit eq "mtime" && $newfile->mtime ne $dbfile->mtime) {
	      $ch = 1;
	      $msg .= "$file:\t (Modification time has changed)\n"
		   ."[Old] \"" . scalar localtime($dbfile->mtime)
		   ."\"\n[New] \"" . scalar localtime($newfile->mtime) . "\"\n";
	  }
	  elsif ($bit eq "ctime" && $newfile->ctime ne $dbfile->ctime) {
	      $ch = 1;
	      $msg .= "$file:\t (Inode change time has changed)\n"
		   ."[Old] \"" . scalar localtime($dbfile->ctime)
		   ."\"\n[New] \"" . scalar localtime($newfile->ctime) . "\"\n";
	  }
	  elsif ($bit eq "blocks" && $newfile->blocks ne $dbfile->blocks) {
	      $ch = 1;
	      $msg .= "$file:\t (Number of allocated blocks has changed)\n"
	           ."[Old] " . $dbfile->blocks . " blocks\n[New] " . $newfile->blocks . " blocks\n";
	  }
	  if ($config{use_ls} && $ch) {
	      $msg .= $newfile->ls . "\n";
	  }
	  if ($ch) {
	      $msg .= "\n";
	  }
      }
      if (!$config{db}->{readonly}) {
	  # update db record
	  if ($config{db}->{protected}) {
	      if (!$dbfile->verify_cipher) {
		  &alert("Encrypted data for $file does not match database entry:\n"
			."    db-data: " . $dbfile->CSV . "\n"
			."secure-data: " . &ude($dbfile->{cipher}) . "\n"
			);
		  print STDERR "database entry for $file contains untrusted changes!\n";
		  exit;
	      }
	  }
	  $dbsugid{$file} = $suidlist{$file};
      }
    }
  }

  foreach my $file (sort keys %dbsugid) {
    if(! $suidlist{$file}) {
      $msg .= "$file:\tFile was not found.";
      if (!$config{db}->{readonly}) {
	  $msg .= " [Removing...]";
	  delete($dbsugid{$file});
      }
      $msg .= "\n";
    }
  }
  dbmclose(%dbsugid);
  undef %suidlist;

  if (($opt_q && $msg) || !$opt_q) {
    print $separator, "\n";
    print "    Changes in suid/sgid files\n";
    print $underline, "\n";
    print $msg . "\n";
  }
}



sub ShellChecksum {
  my($file) = @_;
  my(%scsum);
  open(CSUM, $config{shells}) or die "Can't open $config{shells}: $!";
  while(<CSUM>) {
    chomp;
    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);

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

  foreach my $csdir (sort keys %{$config{directory}}) {
    if (!-e $csdir || !-x $csdir) {
	$msg .= "  directory does not exist or permission denied:";
    }
    my $exclude = $config{directory}->{$csdir}->{exclude};
    if(ref($exclude) eq "ARRAY") {
	foreach (@{$exclude}) {
	    push @exclude, $csdir . "/" . $_;
	}
    }
    else {
	@exclude = ($csdir . "/" . $exclude) if ($exclude);
    }

    @exclude = &regex(@exclude);

    my $include = $config{directory}->{$csdir}->{include};
    if(ref($include) eq "ARRAY") {
	foreach (@{$include}) {
	    push @include, $csdir . "/" . $_;
	}
    }
    else {
	@include = ($csdir . "/" . $include) if ($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);
    }
    my $custom = $config{directory}->{$csdir}->{chk_custom};
    if ($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);
    }
    else {
	# go through all filez
	$config{directory}->{$csdir}->{du} =
	  &recurse_dirs($csdir, \%mask, \@exclude, $config{directory}->{$csdir}->{recursive});
    }
    $msg .= "\n  => $csdir\n" if(!$opt_q || ($opt_q && $dir_msg));
    $msg .= $dir_msg;
    $dir_msg = "";
  }
  if (!$opt_q || ($opt_q && $msg)) {
    print $separator . "\n";
    print "    Changed files in monitored dirs\n";
    print $underline . "\n";
    print $msg . "\n";
  }
  dbmclose(%dbcsumlist);
}

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

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 =~ /^\.\.$/);
	$file = $dir . "/" . $file;
	next if(grep { $file =~ /$_/ } @{$exclude});
	if($recursive) {
	    if(-d $file && !-l $file) {
		$size += &recurse_dirs($file, $mask, $exclude, $recursive);
	    }
	}
	if(!-l $file && !-d $file) {
	    my $obj = new File($file);
	    $ncsumlist{$file} = $obj->csv;
	    $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);

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

  if(! $dbcsumlist{$file}) {
      $dir_msg .= "$file:\tFile was not in the DataBase.";
      if (!$config{db}->{readonly}) {
	  $dir_msg .= " [Adding...]";
	  $dbcsumlist{$file} = $ncsumlist{$file};
      }
      $dir_msg .= "\n";
      if ($config{use_ls}) {
	  $dir_msg .= $newfile->ls . "\n\n";
      }
  }
  elsif($dbcsumlist{$file} ne $ncsumlist{$file}) {
      foreach my $bit (sort keys %{$mask}) {
	  if($bit eq "md5" && $newfile->md5 ne $dbfile->md5) {
	      $ch = 1;
	      $dir_msg .= "$file:\t ($algo checksum has changed)\n"
		         ."[Old] " . $dbfile->md5 . "\n[New] " . $newfile->md5. "\n";
	  }
	  elsif($bit eq "ino" && $newfile->ino ne $dbfile->ino) {
	      $ch = 1;
	      $dir_msg .= "$file:\t (Inode has changed)\n"
		         ."[Old] " . $dbfile->ino . "\n[New] " . $newfile->ino . "\n";
	  }
	  elsif ($bit eq "dev" && $newfile->dev ne $dbfile->dev) {
	      $ch = 1;
	      $dir_msg .= "$file:\t (Filesystem device number has changed)\n"
		         ."[Old] " . $dbfile->dev . "\n[New] " . $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);
	      $dir_msg .= "$file:\t (File mode has changed)\n"
		         ."[Old] $oldmode\n[New] $newmode\n";
	  }
	  elsif ($bit eq "nlink" && $newfile->nlink ne $dbfile->nlink) {
	      $ch = 1;
	      $dir_msg .= "$file:\t (Number of links to this file has changed)\n"
		         ."[Old] " . $dbfile->nlink . "\n[New] " . $newfile->nlink . "\n";
	  }
	  elsif ($bit eq "uid" && $newfile->uid ne $dbfile->uid) {
	      $ch = 1;
	      my $olduser = getpwnam($dbfile->uid);
	      my $newuser = getpwnam($newfile->uid);
	      $dir_msg .= "$file:\t (Owner has changed)\n"
		         ."[Old] $olduser\n[New] $newuser\n";
	  }
	  elsif ($bit eq "gid" && $newfile->gid ne $dbfile->gid ) {
	      $ch = 1;
	      my $olduser = getgrgid($dbfile->gid);
	      my $newuser = getgrgid($newfile->gid);
	      $dir_msg .= "$file:\t (Group has changed)\n"
		         ."[Old] $olduser\n[New] $newuser\n";
	  }
	  elsif ($bit eq "size" && $newfile->size ne $dbfile->size) {
	      $ch = 1;
	      $dir_msg .= "$file:\t (Size has changed)\n"
		         ."[Old] " . $dbfile->size . " bytes\n[New] " . $newfile->size . " bytes\n";
	  }
	  elsif ($bit eq "mtime" && $newfile->mtime ne $dbfile->mtime) {
	      $ch = 1;
	      $dir_msg .= "$file:\t (Modification time has changed)\n"
		         ."[Old] \"" . scalar localtime($dbfile->mtime)
		         ."\"\n[New] \"" . scalar localtime($newfile->mtime) . "\"\n";
	  }
	  elsif ($bit eq "ctime" && $newfile->ctime ne $dbfile->ctime) {
	      $ch = 1;
	      $dir_msg .= "$file:\t (Inode change time has changed)\n"
		         ."[Old] \"" . scalar localtime($dbfile->ctime)
		         ."\"\n[New] \"" . scalar localtime($newfile->ctime) . "\"\n";
	  }
	  elsif ($bit eq "blocks" && $newfile->blocks ne $dbfile->blocks) {
	      $ch = 1;
	      $dir_msg .= "$file:\t (Number of allocated blocks has changed)\n"
	                 ."[Old] " . $dbfile->blocks . " blocks\n[New] " . $newfile->blocks . " blocks\n";
	  }
	  else {
	    # yes there could be a custom bit
	    if ($bit =~ /^custom_(.*)$/) {
	      my $name = $1;
	      # call the closure.
	      $dir_msg .= &{$config{custom}->{$name}}($newfile, $dir) if($name);
	    }
	  }
	  if ($config{use_ls} && $ch) {
	      $dir_msg .= $newfile->ls . "\n";
	  }
	  if ($ch) {
	      $dir_msg .= "\n";
	  }
	  $ch = 0;
      }
      if (!$config{db}->{readonly}) {
	  # update db record
	  if ($config{db}->{protected}) {
	      if (!$dbfile->verify_cipher) {
		  &alert("Encrypted data for $file does not match database entry:\n"
			."    db-data: " . $dbfile->CSV . "\n"
			."secure-data: " . &ude($dbfile->{cipher}) . "\n"
			);
		  print STDERR "database entry for $file contains untrusted changes!\n";
		  exit;
	      }
	  }
	  $dbcsumlist{$file} = $ncsumlist{$file};
      }
  }
}




sub update_dir_db {
    my(%dbcsumlist);
    dbmopen(%dbcsumlist, $config{db}->{csumDB}, 0600) or
                      die "Can't open $config{db}->{csumDB}\: $!\n";
    foreach my $file (sort keys %dbcsumlist) {
	if(! $ncsumlist{$file}) {
	    print "$file: File was not found or no more being monitored.";
	    if (!$config{db}->{readonly}) {
		print " [Removing...]";
		delete($dbcsumlist{$file});
	    }
	    print "\n";
	}
    }
    dbmclose(%dbcsumlist);
}



sub check_crontab{
  foreach my $login(keys %userhash) {
    open(CRON, "$config{crontab} -u $login -l |");
    while(<CRON>) {
      next if(/^#/);
	$cronlist{$login} = $cronlist{$login} . $_;
    }
    close(CRON);
  }
  undef %userhash;
}

sub update_cron_db{
  my($msg);
  dbmopen(%dbcronlist, $config{db}->{cronDB}, 0600) ||
            die "Can't open $config{db}->{cronDB}\: $!\n";
  foreach my $login (sort keys %cronlist) {
    if(! $dbcronlist{$login}) {
      $msg .= "$login\:\tAccount was not in the DataBase.";
      if (!$config{db}->{readonly}) {
	  $msg .= " [Adding...]";
	  $dbcronlist{$login} = $cronlist{$login};
      }
      $msg .= "\n";
    }
    elsif($dbcronlist{$login} ne $cronlist{$login}) {
      $msg .= "$login\:\tCrontab has changed.\n"
            . "[Old Crontab]\n$dbcronlist{$login}"
            . "[New Crontab]\n$cronlist{$login}";
      if (!$config{db}->{readonly}) {
	  $dbcronlist{$login} = $cronlist{$login};
      }
    }
  }
  foreach my $login (sort keys %dbcronlist) {
    if(! $cronlist{$login}) {
      $msg .= "$login\:\tAccount was not found.";
      if (!$config{db}->{readonly}) {
	  $msg .= " [Removing...]";
	  delete($dbcronlist{$login});
      }
      $msg .= "\n";
    }
  }
  dbmclose(%dbcronlist);
  undef %dbcronlist;
  undef %cronlist;
  if (!$opt_q || ($opt_q && $msg)) {
    print $separator, "\n";
    print "    Changes in user crontabs\n";
    print $underline, "\n";
    print $msg . "\n";
  }
}


sub check_diskusage {
  my(%dudb, $msg);
  dbmopen(%dudb, $config{db}->{diskusageDB}, 0600) or
    die "Can't open $config{db}->{diskusageDB}: $!\n";

  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 usage has increased over $overflow%\n"
	     ."Old Usage: $dbsize bytes, New Usage: $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 usage has decreased under $underflow%\n"
	     ."Old Usage: $dbsize bytes, New Usage: $cursize bytes\n\n";
      }
    }
    if (!$config{db}->{readonly}) {
	$dudb{$dir} = $cursize;
    }
  }
  if (!$opt_q || ($opt_q && $msg)) {
    print $separator, "\n";
    print "    Changes in directory disk usage\n";
    print $underline, "\n";
    print $msg . "\n";
  }
}




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


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

    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;
    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}) {
	    next;
	  }
	  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;
	  }
	  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 == $$);
	########
	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) if($name);
	}
	########
	if ($match) {
	  # store for next daemon run.
	  $park{$prc->pid} = $prc->exe;
	  $msg .= "\n";
	  foreach (@bits) {
	    $msg .= "$_: " . $prc->{$_} . "\n";
	  }
	  $msg .= "problem: $match\n";
	  $match = 0;
	}
      }

    if ($msg) {
      $msg =~ s/\0/ /g;
      print "Weird processes:\n$msg\n";
      $msg = "";
      if($config{usemail}) {
	close MAIL;
	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";
      }
    }
    if ($opt_D) {
      sleep $config{proc}->{refresh} || 0;
      #if (time - $gotime >= ($config{proc}->{report_old} * 60)) {
      #	print "old: $gotime\n";
      #	$gotime = time;
      #	print "new: $gotime\n";
      #	%park = ();
      #}
    }
  } while ($opt_D);
}




sub dump {
  my($db, $raw) = @_;
  my %database;
  my $c = ",";
  my $trans = new File;
  if (!-e $db) {
      die "The database \"$db\" does not exit!\n";
  }
  dbmopen(%database, $db, 0600) or
    die "Can't open $db: $!\n";
  foreach my $file (sort keys %database) {
    print $file . $c;
    if ($raw) {
      my $line = $database{$file};
      $line =~ s/:/,/g;
      print $line . "\n";
    }
    else {
      $trans->csv($database{$file});
      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   <file>      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"
       ."-h --help               show this message\n"
       ."-v --version            show version number\n"
       ."$0 with no options is normal operation mode\n";
  exit;
}



sub set_passwd {
  my ($key, $key1, $key2, $crypted_key, %keydb);
  print STDERR "password: ";
  $key1 = &get_passwd;
  print STDERR "repeat:   ";
  $key2 = &get_passwd;

  if ($key1 ne $key2) {
    print STDERR "Passwords are not identical. Please try again!\n";
    exit 1;
  }
  else {
    $key = $key1;
    # encrypt the key
    my @range=('0'..'9','a'..'z','A'..'Z');
    my $salt=$range[rand(int($#range)+1)] . $range[rand(int($#range)+1)];
    $crypted_key = crypt($key, "$salt");
  }

  # store it into the key db:
  dbmopen(%keydb, $config{db}->{basedir} . "/keydb", 0600) or
    die "Can't open " . $config{db}->{basedir} . "/keydb: $!\n";
  $keydb{root} = $crypted_key;

  dbmclose(%keydb);
}




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(%keydb, $salt, $key);
    if (!exists $ENV{'NABOU_PASSWD'}) {
      print STDERR "password: ";
      $key = &get_passwd;
    }
    else {
      $key = $ENV{'NABOU_PASSWD'};
    }
    chomp $key;

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

    # compare them
    if ($keydb{root} =~ /^(..).*/ && exists $keydb{root}) {
      $salt = $1;
    }
    else {
      &alert($config{db}->{basedir} . "/keydb does not contain an encrypted key for root!\n");
      print STDERR "permission denied.\n";
      exit 1;
    }

    # encrypt the key and compare the result
    my $crypted_key = crypt($key, "$salt");

    if ($crypted_key ne $keydb{root}) {
      print STDERR "permission denied.\n";
      &alert("invalid credentials supplied.");
      exit 1;
    }
    dbmclose(%keydb);
    # create crypt obj here!
    my $method = $config{db}->{cipher} || "DES";
    $cipher = new Crypt::CBC($key, $method);
}



sub update_file {
  my (@files) = @_;
  my(%db);
  my $sp = " " if($algo =~ /^MD/);
  if ($config{db}->{protected} || -e $config{db}->{basedir} . "/keydb") {
    &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 "not in the DataBase. [Adding...]\n";
      }
      else {
	  if ($config{db}->{protected}) {
	      if (!$obj->verify_cipher) {
		  &alert("Encrypted data for $file does not match database entry!\n");
		  exit(-1);
	      }
	  }
	  print "exists in the DataBase. [Updating...]\n";
      }
      $db{$file} = $obj->csv;
      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!
  #
  foreach my $name (keys %{$config{script}}) {
    if ($config{script}->{$name}) {
      my $rawcode = $config{script}->{$name};
      my $code;
      if ($name eq "BEGIN" or $name eq "END") {
	  $config{custom}->{$name} = $rawcode;
      }
      else {
	  $code    = "\$config{custom}->{$name} = sub { $rawcode }";
      }
      eval $code;
    }
  }
  if (exists $config{custom}->{BEGIN}) {
      eval $config{custom}->{BEGIN};
  }
  #print Dumper(\%config);
  #exit;
}



sub alert {
    my($msg)     = @_;
    my $rcpt     = $config{mail}->{alert}   || "root";
    my $from     = $config{mail}->{from}    || "root";
    my $subject  = "ALERT! The stability of nabou has been compromised!";
    my $sendmail = $config{bin}->{sendmail} || "/usr/lib/sendmail";

    open(MAIL, "|$sendmail -t") or die $!;
    print MAIL "From: $from\n"
              ."To: $rcpt\n"
	      ."Subject: $subject\n\n\n"
	      ."    MESSAGE: $msg\n"
              ."       TIME: " . scalar localtime(time) . "\n"
	      ."     CONFIG: $configfile\n"
	      ."   UID/EUID: $</$>\n"
	      ."   GID/EGID: $(/$)\n"
	      ."       HOST: $ENV{HOSTNAME}\n"
	      ."       PATH: ";

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



sub uen
{
    my $text = shift;
    my($T);
    if($config{db}->{protected}) {
        eval {
            $T = pack("u", $cipher->encrypt($text));
        };
    }
    else {
        $T = pack("u", $text);
    }
    chomp $T;
    return $T;
}

sub ude
{
    my $crypted = shift;
    my($T);
    if($config{db}->{protected}) {
        eval {
            $T = $cipher->decrypt(unpack("u",$crypted));
        };
    }
    else {
        $T = unpack("u", $crypted);
    }
    return $T;
}










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


package Conf;

# Constants
sub TRUE {return 1};
sub FALSE{return 0};




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

  my(%config);
  %config = ();
  $self->{level} = 1;

  $self->{configfile} = $configfile;

  # open the file and read the contents in
  $self->_open($self->{configfile});

  return $self;
}



sub getall {
  #
  # just return the whole config hash
  # parse the contents of the file
  #
  my($this) = @_;

  # avoid twice parsing
  if (!$this->{parsed}) {
    $this->{parsed} = 1;
    $this->{config} = $this->_parse({}, $this->{content});
  }
  my %allhash = %{$this->{config}};
  return %allhash;
}



sub _open {
  #
  # open the config file
  # and store it's contents in @content
  #
  my($this, $configfile) = @_;
  my(@content, $c_comment, $longline, $hier, $hierend, @hierdoc);

  my $fh = new FileHandle;

  if (-e $configfile) {
    open $fh, "<$configfile" or die "Could not open $configfile!($!)\n";
    while (<$fh>) {
      chomp;
      next if (/^\s*$/ || /^\s*#/);               # ignore whitespace(s) and lines beginning with #
      if (/^([^#]+?)#/) {
	$_ = $1;                                  # remove trailing comment
      }
      if (/^\s*(.+?)(\s*=\s*|\s+)<<(.+?)$/) {     # we are @ the beginning of a here-doc
	$hier = $1;                               # $hier is the actual here-doc
	$hierend = $3;                            # the here-doc end string, i.e. "EOF"
      }
      elsif (/^(\s*)\Q$hierend\E$/) {             # the current here-doc ends here
	my $indent = $1;                          # preserve indentation
	$hier .= " " . chr(182) . "\n";           # append a "" to the here-doc-name, so _parse will also preserver indentation
	if ($indent) {
	  foreach (@hierdoc) {
	    $_ =~ s/^$indent//;                   # i.e. the end was: "    EOF" then we remove "    " from every here-doc line
	    $hier .= $_ . "\n";                   # and store it in $hier
	  }
	}
	else {
	  $hier .= join "\n", @hierdoc;           # there was no indentation of the end-string, so join it 1:1
	}
	push @{$this->{content}}, $hier;          # push it onto the content stack
	@hierdoc = ();
	undef $hier;
	undef $hierend;
      }
      elsif (/^\s*\/\*/) {                        # the beginning of a C-comment ("/*"), from now on ignore everything
	$c_comment = 1;                           # until a "*/" occurs.
      }
      elsif (/\*\//) {
	if (!$c_comment) {
	  warn "invalid syntax: found end of C-comment without previous start!\n";
	}
	$c_comment = 0;                           # the current C-comment ends here, go on 
      }
      elsif (/\\$/) {                             # a multiline option, indicated by a trailing backslash
	chop;
	$_ =~ s/^\s*//;
	$longline .= $_ if(!$c_comment);          # store in $longline
      }
      else {                                      # any "normal" config lines
	if ($longline) {                          # previous stuff was a longline and this is the last line of the longline
	  $_ =~ s/^\s*//;
	  $longline .= $_ if(!$c_comment);
	  push @{$this->{content}}, $longline;    # push it onto the content stack
	  undef $longline;
	}
	elsif ($hier) {                           # we are inside a here-doc
	  push @hierdoc, $_;                      # push onto here-dco stack
	}
	else {
	  if (/^<<include (.+?)>>$/) {            # include external config file
	    $this->_open($1) if(!$c_comment);     # call _open with the argument to include assuming it is a filename
	  }
	  else {                                  # standard config line, push it onto the content stack
	    push @{$this->{content}}, $_ if(!$c_comment);
	  }
	}
      }
    }
    close $fh;
  }
  else {
    die "The file \"$configfile\" does not exist!\n";
  }
  return TRUE;
}




sub _parse {
  #
  # parse the contents of the file
  #
  my($this, $config, $content) = @_;
  my(@newcontent, $block, $blockname, $grab, $chunk,$block_level);

  foreach (@{$content}) {                                  # loop over content stack
    chomp;
    $chunk++;
    $_ =~ s/^\s*//;                                        # strip spaces @ end and begin
    $_ =~ s/\s*$//;

    my ($option,$value) = split /\s*=\s*|\s+/, $_, 2;      # option/value assignment, = is optional
    my $indichar = chr(182);                               # , inserted by _open, our here-doc indicator
    $value =~ s/^$indichar//;                              # a here-doc begin, remove indicator
    $value =~ s/^"//;                                      # remove leading and trailing "
    $value =~ s/"$//;
    if (!$block) {                                         # not inside a block @ the moment
      if (/^<([^\/]+?.*?)>$/) {                            # look if it is a block
	$this->{level} += 1;
	$block = $1;                                       # store block name
	($grab, $blockname) = split /\s\s*/, $block, 2;    # is it a named block? if yes, store the name separately
	if ($blockname) {
	  $block = $grab;
	}
	undef @newcontent;
	next;
      }
      elsif (/^<\/(.+?)>$/) {                              # it is an end block, but we don't have a matching block!
	die "EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
      }
      else {                                               # insert key/value pair into actual node
	if ($this->{NoMultiOptions}) {                     # configurable via special method ::NoMultiOptions()
	  if (exists $config->{$option}) {
	    die "Option $config->{$option} occurs more than once (level: $this->{level}, chunk $chunk)!\n";
	  }
	  $config->{$option} = $value;
	}
	else {
	  if (exists $config->{$option}) {	           # value exists more than once, make it an array
	    if (ref($config->{$option}) ne "ARRAY") {      # convert scalar to array
	      my $savevalue = $config->{$option};
	      delete $config->{$option};
	      push @{$config->{$option}}, $savevalue;
	    }
	    push @{$config->{$option}}, $value;            # it's still an array, just push
	  }
	  else {
	    $config->{$option} = $value;                   # standard config option, insert key/value pair into node
	  }
	}
      }
    }
    elsif (/^<([^\/]+?.*?)>$/) {                           # found a start block inside a block, don't forget it
      $block_level++;                                      # $block_level indicates wether we are still inside a node
      push @newcontent, $_;                                # push onto new content stack for later recursive call of _parse()
    }
    elsif (/^<\/(.+?)>$/) {
      if ($block_level) {                                  # this endblock is not the one we are searching for, decrement and push
	$block_level--;                                    # if it is 0 the the endblock was the one we searched for, see below 
	push @newcontent, $_;                              # push onto new content stack
      }
      else {                                               # calling myself recursively, end of $block reached, $block_level is 0
	if ($blockname) {
	  $config->{$block}->{$blockname} =                # a named block, make it a hashref inside a hash within the current node
	    $this->_parse($config->{$block}->{$blockname}, \@newcontent);
	}
	else {                                             # standard block
	  $config->{$block} = $this->_parse($config->{$block}, \@newcontent);
	}
	undef $blockname;
	undef $block;
	$this->{level} -= 1;
	next;
      }
    }
    else {                                                 # inside $block, just push onto new content stack
      push @newcontent, $_;
    }
  }
  if ($block) {
    # $block is still defined, which means, that it had
    # no matching endblock!
    die "Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n";
  }
  return $config;
}


sub NoMultiOptions {
  #
  # turn NoMultiOptions off
  #
  my($this) = @_;
  $this->{NoMultiOptions} = 1;
}

# keep this one
1;








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;

  # 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 {
  # return colon separated list of all properties.
  # used for database storage
  my($this, $csv) = @_;
  if (!$csv) {
    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;

    my $cr_list;
    $cr_list = &main::uen($list);
    $this->{cipher} = $cr_list;
    $this->{csv}    = $list;
    return $list . ":" . $cr_list;
  }
  else {
    # initialize $this from given $csv
    my @ar = split /:/, $csv, 15;
    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->{cipher} = pop @ar;
    $this->{csv}    = join ":", @ar;
    $this->{stats}  = \%stats;
    return $csv;
  }
}


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



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


sub verify_cipher {
    #
    # decrypt cipher and compare result
    # with stored csv entry, return TRUE
    # if both are equal, otherwise FALSE.
    #
    my($this) = @_;
    my $de_csv = &main::ude($this->cipher);
    if ($de_csv eq $this->CSV) {
	return 1;
    }
    else {
	return 0;
    }
}


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;
	}
        eval {
            open FILE, $this->{file} or die "Can't open file $this->{file} for check: $!\n";
            binmode(FILE);
            $md5->addfile(*FILE);
        };
        if($@) {
            print $@;
        }
        $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  " . $this->filename;
}


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; }
    }
    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;
  }
  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;

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