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++

    }

}