Subversion Repositories DevTools

#! /usr/bin/perl
########################################################################
# Copyright (C) Vix Technology, All rights reserved
#
# Module name   : pkg_mon.pl
# Module type   :
# Compiler(s)   : Perl
# Environment(s):
#
# Description   : Dpkg_archive monitor tools
#                 Designed to be run periodically from cron
#
#                 Operations
#                   Maintans a list of files in the archive
#                       Allows quick greping for files
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

use Pod::Usage;
use Getopt::Long;
use File::Find;
use File::Path;
use POSIX qw(strftime);
use Data::Dumper;


#
#   Definitions
#
our $dpkg       = "$ENV{HOME}/dpkg_archive";    # Root of the archive
our $list       = 'dpkg_archive_list';          # Base name for lists
our $pkg        = 'dpkg_archive_pkg';           # Base name for package list
our $keepDays   = 100;                          # Keep for xxx days
our $metaDir    = '.dpkg_archive';              # Name of meta directory
our $logs       = 'pkg_lists';                  # Subdir to store history of archive
our $metadir    = "$dpkg/$metaDir/$logs";       # Store package lists

#
#   Globals
#
our $dirLen     = 0;
our $pkgList;
our $pkgListLast;
our $brokenLinks;


#-------------------------------------------------------------------------------
# Function        : Mainline Entry
#
# Description     : Designed to be used with CRON and CRON to email
#                   admin on errors
#
# Inputs          : None
#
# Returns         : None Zero on error
#

#
#   Must have an archive
#
if ( ! -d $dpkg  )
{
    die ("Home directory MUST have link to dpkg_archive");
}

#
#   Create the meta data directory
#   Ensure its writable by owner and readable by all
#
if ( ! -d $metadir )
{
    mkpath ($metadir, 0, 0755);
    die ("Can't create metadata directory") unless ( -d $metadir );
}
chmod 0755, $metadir;

#
#   Create new file
#
my $newfile = "$metadir/${list}.NEW";
our $fh;
unlink $newfile;
open ( $fh ,'>', $newfile) or die ("Cannot open file: $newfile. $!");

my $newpkg = "$metadir/${pkg}.NEW";
our $ph;
unlink $newpkg;
open ( $ph ,'>', $newpkg) or die ("Cannot open file: $newpkg $!");


#   CD to the package archive - the dpkg_archive in the user homedir may be a
#   symlink and find won't follow the first.
#
chdir $dpkg || die ("Cannot cd to $dpkg: $!");


#
#   Walk the package lists
#   Done so that we can collect package data and perform specific tests
#
opendir(DIR, $dpkg) || die "Can't opendir $dpkg: $!";
my @dlist = readdir(DIR);
closedir DIR;
$dirLen = length $dpkg;

scan:
foreach my $pname ( sort @dlist )
{
    next if ( $pname eq '.' );
    next if ( $pname eq '..' );
    next if ( $pname eq $metaDir);      # Skip Metadata directory
    
    my $dir = $dpkg . '/'. $pname;
    next unless ( -d $dir );

    opendir(DIR, $dir )|| die "Can't opendir $dir: $!";
    my @vlist = readdir(DIR);
    closedir DIR;

    foreach my $vname ( sort @vlist )
    {
        next if ( $vname eq '.' );
        next if ( $vname eq '..' );
        next if ( $vname =~ m~\.TMPDIR$~ );


        my $vdir = $dir . '/' . $vname;
        if ( -d $vdir  )
        {
            print $ph "$pname/$vname\n";
            $pkgList->{$pname}{$vname} = 2;
        }

        #
        #   Create a list of files in the archive
        #   Be careful of symlinks
        #
        find ( {wanted => \&process_file, follow_fast => 0, no_chdir => 1}, $vdir );

    }
}

#
#   Close files and rename them
#   Maintain a link to the 'current' one
#
close $fh;
nameFile ( $newfile, $list );

close $ph;
my $last_pkglist = nameFile ( $newpkg, $pkg );
#print "$last_pkglist\n";

#
#   Read in the last generated package list
#   Update the $pkgList structure
#       Data will be:
#           1 - Deleted package
#           2 - Added package
#           3 - Still in place
#
if ( $last_pkglist )
{
    open ($fh, '<', "$dpkg/$metaDir/$last_pkglist" ) || die ("Can't open $last_pkglist. $!");
    while ( <$fh> )
    {
        chomp;
        my ($pname,$pver) = split( '/', $_);
        $pkgList->{$pname}{$pver}++;
    }
}
close $fh;
#DebugDumpData('$pkgList', $pkgList );

#
#   Determine new package and deleted packages
#
my $added;
my $deleted;

while ( (my ($pname, $pvers)) = each %{$pkgList} ) {
    while ( (my ($pver, $pdata) ) = each %{$pvers} ) {
        next unless ( $pdata );
        next if ( $pdata == 3 );
        if ( $pdata == 1 ) {
            $deleted->{$pname}{$pver} = 1;
        }  else {
            $added->{$pname}{$pver} = 1;
        }
    }
}
#DebugDumpData('Added', $added );
#DebugDumpData('Deleted', $deleted );


#
#   Delete old instances of the package list
#   Only retain them them for so long - 100 days
#
opendir($fh, $metadir) || die "can't opendir $metadir: $!";
my @flist = readdir($fh);
closedir $fh;

foreach my $fname ( @flist )
{
    next if ( $fname eq '.' );
    next if ( $fname eq '..' );
    my $fname = "$metadir/$fname";
    next unless ( -M $fname > $keepDays );
    unlink $fname;
}

#-------------------------------------------------------------------------------
# Function        : process_file
#
# Description     : File::find callback function
#                   Process files
#
# Inputs          : None
#                   $File::Find::dir    is the current directory name,
#                   $_                  is the current filename within that directory
#                   $File::Find::name   is the complete pathname to the file.
#
# Returns         : Nothing
#
sub process_file
{
    my $name = $File::Find::name;
    $name = substr ($name, 1+ $dirLen);         # Remove Root
#    return unless ( $name =~ m~/.+/~ );         # Skip root level dirs
    my $ch = ( -d ) ? '/' : '';                 # Append / to dirs
    push @{$brokenLinks}, $name unless ( -e );
    print $fh "$name$ch\n";

#print "$name$ch\n";
}


#-------------------------------------------------------------------------------
# Function        : nameFile
#
# Description     : Rename a file and create a link to the current instance
#
# Inputs          : current_name            - Current name of the file
#                   base                    - Base of new name 
#
# Returns         : Name of the orginal link file
#
sub nameFile
{
    my ($newfile, $base) = @_;
    my $rv;

    my $timestr = strftime "%Y-%m-%d", localtime();
    my $final_name = "${base}.$timestr.txt";
    my $final_file = "$metadir/$final_name";
    my $link_filename = "${base}.txt";
    my $link_file = "$dpkg/$metaDir/$link_filename";

    $rv = readlink($link_file)
        if ( -l $link_file );


    rename $newfile, $final_file;
    unlink $link_file;
    symlink "$logs" . '/'. $final_name, $link_file;

    return $rv;
}

#-------------------------------------------------------------------------------
# Function        : DebugDumpData
#
# Description     : Dump a data structure
#
# Inputs          : $name           - A name to give the structure
#                   @refp           - An array of references
#
# Returns         :
#
sub DebugDumpData
{
    my ($name, @refp) = @_;

    my $ii = 0;
    foreach  ( @refp )
    {
        print Data::Dumper->Dump ( [$_], ["*[Arg:$ii] $name" ]);
        $ii++
    }
}