Filewatcher File Search
FTP Search
  
Directory 
  
Content Search 
   
pkg://chklogs-2.0-3.tar.gz:163018/chklogs-2.0-3/bin/Chklogs.pm  downloads

# RCS: $Id: Chklogs.pm,v 1.1.1 1997/09/28 19:22:23 grimaldo Exp $
#------------------------------------------------------------------------
#       Chklogs.pm (c)1996,1997 D. Emilio Grimaldo Tunon
#------------------------------------------------------------------------
# AUTHOR: D. Emilio Grimaldo T.		grimaldo@panama.iaehv.nl
# DESCRIPTION:
#          The ChkLogs Perl Module. This is used by both chklogs and
#	   chklogsadm scripts in the ChkLogs distribution.
#

require 5.003;
package Chklogs;
    use Exporter;
    use Interpret;
    @ISA = qw(Exporter);
    # ********* GLOBAL SYMBOLS *********
    @EXPORT = qw(BeginChklogs IdentifySyslog IsSyslogMember StopProcess ContProcess
                 GetLibVersion GetCurrentDate DisableTimed DayCount
                 ReadTimeLog TimeLogStamp ModifyTimeLog WriteTimeLog
                 DisableGroups ReadGroupConfiguration ReadOptions BadThing
                 basename dirname ValidateRepository xdevRename
    		 $ConfFile  $ResrcFile  $RelativePath $admin $useMiniMail
		 $mailhost $personalResource $globalResource 
		 GetInterpretVersion);
    # ********* GLOBAL VARIABLES *********
    use vars qw($ConfFile  $ResrcFile  $RelativePath
                $SyslogConf $VarRun $RelativePath 
		$admin $useMiniMail $mailhost
		$personalResource $globalResource);
    # ************************************
    use strict;

# ********* CONFIGURATION SECTION *********
$ConfFile     = '/etc/chklogs.conf';		# Configuration File
$ResrcFile    = '/var/log/.chklogdb';		# Status database file
$RelativePath = 'OldLogs';			# for :option local
$SyslogConf   = '/etc/syslog.conf';		# For syslogd control
$VarRun       = '/var/run';			# Location of .pid files
$admin	      = 'root';				# The admin gets email
$useMiniMail  = 'yes';				# Use SMTP own module
$mailhost     = 'localhost';               	# The SMTP server hostname
# ********* ********************* *********

# ********** LOCAL DATA SECTION **********
					# Features enabled by default
my $FeatureGroups = 1;			# Log Groups
my $FeatureTimed  = 1;			# Timed logs
my (@syslogs, $TimeLogCnt, $GuessInx, @nLog, @Last);

my @MonthNames = ( 'Jan','Feb','Mar','Apr','May','Jun',
		   'Jul','Aug','Sep','Oct','Nov','Dec');
# varMap: *never* put a reference to another package/module. First
#	  it is nasty and second Perl can't resolve the address at
#	  'use' time.
my %varMap = (#  RC-variable    -  local-variable
                'ChklogsConf'   => \$ConfFile,
                'ChklogsDb'     => \$ResrcFile,
                'Admin'         => \$admin,
                'RelativePath'  => \$RelativePath,
                'SyslogConf'    => \$SyslogConf,
                'VarRun'        => \$VarRun,
		'MiniMail'	=> \$useMiniMail,
		'MailHost'	=> \$mailhost
             );
my $VERSION;
my $userMode;
# ********* ********************* *********


BEGIN {
    $VERSION = '$Revision: 1.1.1 $';
    $VERSION =~ m/Revision: (\d+\.\d+\.*\d*\.*\d*)/;
    $VERSION = $1;

    @syslogs = ();
    $TimeLogCnt = 0;
    $GuessInx = 0;
    @nLog = ();
    @Last = ();
    # getlogin() would return the non-privileged user if su -login root
    $userMode = (getpwuid($<))[0] || getlogin || 'You-Look-Suspicious';
}

#-----------------------------------------
# FUNCTION: BeginChklogs()
#
sub BeginChklogs {
    # Now interpret the Personal Resource File. Do it here so that
    # we don't have to duplicate the same thing in chklogs & chklogsadm.
    #
    #		Highest precedence: Command-line options
    #		Midway precedence : Personal resource file
    #		Lower  precedence : Global resource file
    #		Lowest precedence : In-script configuration
    $globalResource = &dirname($INC{'Interpret.pm'}) . 'chklogsrc';
    $personalResource = $ENV{'HOME'} . '/.chklogsrc';
    my $iresult;
    my @no_yes = ('no', 'yes');

    $iresult = &interpretRc($globalResource, \%varMap);
    $globalResource = "($no_yes[$iresult]) $globalResource";
    $iresult = &interpretRc($personalResource, \%varMap);
    $personalResource = "($no_yes[$iresult]) $personalResource";

    #
    # Create a PID lock file or abort if conflicting. 
    #
    if ( -e "$Chklogs::VarRun/chklogs.pid") {
        print "$Chklogs::VarRun/chklogs.pid: Sorry there is a copy of ",
	      "chklogs/chklogsadm running.\n";
        exit 1;
    }
    open(LOCKF,"> $VarRun/chklogs.pid") or die "$VarRun/chklogs.pid: $!\n";
    print LOCKF "$$\n";
    close(LOCKF);
}

#-----------------------------------------
# FUNCTION: GetVersion()
#
sub GetLibVersion {
    return $VERSION;
}

sub GetInterpretVersion {
    return &Interpret::GetVersion;
}

#-----------------------------------------
# FUNCTION: BadThing(msg,exit_code)
#
sub BadThing {
    my ($msg, $ecode) = @_;
    my @caller_data;

    $ecode = 100 if ($ecode eq "");
    @caller_data = caller(1);
    print "$caller_data[1]($caller_data[2]) at $caller_data[3]: $msg\n";
    exit($ecode);
}

#-----------------------------------------
# StopProcess(pid_file)
#	If the pid_file parameter begins with `/' 
#	we assume a full path name for backward
#	compatible.
sub StopProcess {
    my $pid_file = shift;
    my $itsPID;

    # We need this so that we don't attempt to stop a process
    # which we do not own, otherwise we get a fatal error.

    return if ($userMode ne 'root');

    if (!($pid_file =~ m/^\//)) {
    	# Just a filename without path, assume our path
	$pid_file = $VarRun . '/' . $pid_file;
    }
    open(PID,$pid_file) || die "$pid_file: $!\n";
    read(PID,$itsPID,10);
    kill 'STOP', $itsPID;
    close(PID);
    return $itsPID;
}

#-----------------------------------------
# ContProcess(pid)
sub ContProcess {
    my $itsPID = shift;

    return if ($userMode ne 'root');
    kill 'CONT', $itsPID;
}

#-----------------------------------------
# FUNCTION: IdentifySyslog()
# 	Read syslog.conf and see which logs are under its control.
#	Ignore '*', '/dev/*', comments and empty line entries
#	See IsSyslogMember()
sub IdentifySyslog {
    my $ListMode = shift;
    my ($CurrentLog, @in);

    open(SYSCONF,$SyslogConf) || die "Can't open $SyslogConf\n";
    while (<SYSCONF>) {
        chop;
	next if (/^\s*#/);
	next if (/^\s*$/);
	@in = split(/\s+/);
	$CurrentLog = $in[$#in];
	next if ($CurrentLog =~ m/^\/dev/);  	# ignore /dev/* entries
	next if ($CurrentLog =~ m/\*/);	 	# ignore `all' (*) entries
	push(@syslogs, $CurrentLog);
	printf "[%s]\n", $CurrentLog if ($ListMode == 0);
    }
    close(SYSCONF);
}

#-----------------------------------------
# FUNCTION: IsSyslogMember()
# PRECOND.: IdentifySyslog() has to be called
# Checks if the parameter is a log
# registered under syslogd (syslog.conf), if 
# so the .rc file needs a `builtin syslog.pid'
# entry for this log. This enables chklogs to
# do SIGHUP/SIGCONT on syslogd.
#
sub IsSyslogMember {
    my($which) = @_;
    my($i,$found);

    $found = 0;
    foreach $i (@syslogs) {
	if ($i eq $which) { 
	    return 1;
	}
    }
    return 0;
}

#-----------------------------------------
# FUNCTION: GetCurrentDate()
# OUT: DD Mon YY
# 	Gets date in Day 3LetterMonthname Year format
#
sub GetCurrentDate {
    my @tmp;

    # Sun Apr 27 15:26:10 1997
    @tmp = split(' ',localtime);
    return pack("C A3 I", $tmp[2], $tmp[1], $tmp[4]);
}


# ***** FEATURE: Timed *****
# DisableTimed(void)
#    Invoked when we want to disable the Timed log feature. Actually
#    we still do the processing but the age registration is *not*
#    written to disk even if we ask.
sub DisableTimed {
    $FeatureTimed = 0;
}

sub DayCount {
    my($date) = @_;
    my($day,$mname,$year,$mon,$age);

    if ($date eq "") {
	return 0;
    }

    ($day,$mname,$year) = split(' ',$date,3);
    $year -= 96;		# Reference is Jan. 1, 1996
    $age = $year * 12 * 30;	# My month is 30 days ;-)
    for ($[ .. $#MonthNames) {
	$mon = $_, last if ($MonthNames[$_] eq $mname);
    }
    $age += ($mon) * 30 + $day;
    return $age;
}

#-----------------------------------------
# FUNCTION: ReadTimeLog()
# IN:	none
#	Reads the status database. If it is an old version (pre 2.0)
#	it converts the year field to 4 digits instead of 2.
#
sub ReadTimeLog {				# PROTO()
    my($day,$monthname,$year,$log,$ac);

    $GuessInx = 0;	# Assume .conf is in sync with .log
    open(RC,$ResrcFile) || die "Can't open Status file $ResrcFile\n";
    $TimeLogCnt = 0;
    while (<RC>) {
	chop;
	($day,$monthname,$year,$ac,$log) = split(' ',$_,5);
	$nLog[$TimeLogCnt] = $log;
	$year += 1900 if ($year < 100);
	$Last[$TimeLogCnt] = "$day $monthname $year $ac";
	$TimeLogCnt += 1;
    }
    close(RC);
}
    
sub TimeLogStamp {
    my($logname,$acReq) = @_;
    my($day,$monthname,$year,$log,$when,$ac,$cnt);

    if ($TimeLogCnt == 0) {
	print "Chklogs.pm: Didn't load $ResrcFile with ReadTimeLog()\n";
	return;
    }

    # Just in case we were passed the long name
    $acReq = "A" if ($acReq eq "archive");
    $acReq = "T" if ($acReq eq "truncate");
    $acReq = "E" if ($acReq eq "execute");

    $cnt = 0;
    $when = "";
    while ($cnt < $TimeLogCnt) {
	($day,$monthname,$year,$ac) = split(' ',$Last[$cnt],4);
	if ($nLog[$cnt] eq $logname && 
	    (($acReq eq $ac) || $acReq eq "")) {
	    $when = "$day $monthname $year";
	    last;
 	}
	$cnt += 1;
    }
    return $when;
}


#-----------------------------------------
# FUNCTION: ModifyTimeLog(pLog,pDate,pAc)
# IN:	pLog	 whose time stamp is to be modified to current
#	pDate    date to put on the stamp
#	pAc	 Action letter (ATE)
#
sub ModifyTimeLog {
    my($pLog,$pDate,$pAc) = @_;

    # Just in case we were passed the long name
    $pAc = 'A' if (index($pAc,'archive') == 0);
    $pAc = 'T' if (index($pAc,'truncate') == 0);
    $pAc = 'E' if (index($pAc,'execute') == 0);

    if (($nLog[$GuessInx] eq $pLog) && (substr($Last[$GuessInx],-1,1) eq $pAc)) 
    {
	$Last[$GuessInx] =  "$pDate  $pAc";
    }
    else {
	# Hum, our guess was wrong...
	foreach $GuessInx (0 .. $#nLog) {
	    if (($nLog[$GuessInx] eq $pLog) && 
		(substr($Last[$GuessInx],-1,1) eq $pAc)) {
		$Last[$GuessInx] =  "$pDate  $pAc";
	    	return;
	    }
	}
	# Hummmm, this must be a new one. Need to
	# apply chklogsadm --sync
	# For now just append it to the list, WriteTimeLog()
	# will do the rest.
	$nLog[$TimeLogCnt] = $pLog;
	$Last[$TimeLogCnt] = "$pDate  $pAc";
	$TimeLogCnt += 1;
    }
}
    
sub WriteTimeLog {
    my($day,$monthname,$year,$ac,$cnt);

    return if ($FeatureTimed == 0);

    $cnt = 0;
    open(RC,"> $ResrcFile") || die "Can't create time log $ResrcFile\n";
    while ($cnt < $TimeLogCnt) {
	($day,$monthname,$year,$ac) = split(' ',$Last[$cnt],4);
	printf RC "%02d %s %2d  %s  ",$day,$monthname,$year,$ac;
        print RC "$nLog[$cnt]\n";
	$cnt += 1;
    }
    close(RC);
}

# ***** FEATURE: Groups *****
# DisableGroups(void)
#    Invoked when we want to disable the LOG GROUP feature
#    at runtime, for example when running chklogs with the
#    -c (check), -w (warn) or -t (test) options.
sub DisableGroups {
    $FeatureGroups = 0;
}

#-----------------------------------------
# ReadGroupConfiguration(fileHdl, groupcfg_aPtr)
#    Invoked when a log group definition is found, this means a line
#    beginning with #:group <GROUP>
#    It is expected that the next two lines are (in that order)
#    #:pre  [<PROGRAM + PARAMS>]
#    #:post [<PROGRAM + PARAMS>]
sub ReadGroupConfiguration {			# PROTO(\*,\%)
    my ($cf, $groupCfg) = @_;
    my($keyword);

    &BadThing('#1 not a GLOB',1) if (ref($cf) ne 'GLOB');
    &BadThing('#2 not a HASH',1) if (ref($groupCfg) ne 'HASH');

    $$groupCfg{'name'} = '*' if $$groupCfg{'name'} eq "";  # To detect EOG if no name

    $_ = <$cf>;
    (/^#:pre\s+/i || /^-pre\s+/i) && (chop($$groupCfg{'pre'} = $'));
    $_ = <$cf>;
    (/^#:post\s+/i || /^-post\s+/i) && (chop($$groupCfg{'post'} = $'));

    if ($FeatureGroups == 0) {
	$$groupCfg{'pre'} = ''; 
	$$groupCfg{'post'} = ''; 
    }
}

#-----------------------------------------
# ReadOptions(AllOptionsInOneParameter, config_aRef)
#	splits it and creates an associative array for each option.
#	The option 'global' overrides option 'local' which deal
#	with the repository where archives will be kept.

sub ReadOptions {				# PROTO($,\%)
    my $allPars = shift;
    my $cfgRef  = shift;
    my (@opts,$opt,$global_found);

    &BadThing('#2 not a hash', 1) if (ref($cfgRef) ne 'HASH');

    $global_found = 0;
    @opts = split(/\s+/,$allPars);
    foreach $opt (@opts) {
	$opt = lc $opt;				# Case insensitive
	$global_found = 1 if ($opt eq 'global');
	if ($opt eq 'global' || $opt eq 'local') {
	    $$cfgRef{'reptype'} = $opt;
	}
	else {
	    warn "ReadOptions: $opt ignored\n";
	}
    }

    # See if we want to override Local
    $$cfgRef{'reptype'} = 'global' if $global_found;
}

#-----------------------------------------
# Basename
#       extracts the base name from path
sub basename {
    my($fpath) = @_;
    $fpath =~ s/[a-zA-Z0-9_.\/-]*\///;
    return $fpath;
}

#-----------------------------------------
# Dirname
#       extracts the directory name from path
sub dirname {
    my($fpath) = @_;
    $fpath =~ s/[*a-zA-Z0-9._-]*$//;
    return $fpath;
}

#-----------------------------------------
# ValidateRepository(RepositoryPtr, cfg_aPtr, group_aPtr, CurrentLocalDirName)
#	Validates the location/existance of the repository where we
#	archive based on options and the parameters. If it fails we
#	return 1. ChklogsAdm uses this to warn and initialize the
#	repositories.
#	  At this point EITHER local OR global is set.
#	If Group is "" then the "common" is used.
# RETURNS:
#	The repository to use in Repository
#	0	ok
#	1	fatal, neither local nor global specified!
#	2	fatal, global is not an absolute path
#	3	repository doesn't exist, must create (chklogsadm)

sub ValidateRepository {		# PROTO(\$,\%,\%,$)
    my ($repositoryRef, $cfgRef, $groupRef, $CurrentDir) = @_;

    if ( $$cfgRef{'reptype'} eq 'local' ) {
        $$repositoryRef = $CurrentDir . $$cfgRef{'local'};
    }
    elsif ( $$cfgRef{'reptype'} eq 'global' ) {
	$$repositoryRef = $$cfgRef{'global'};
	if ($$groupRef{'name'} ne "") {
	    $$repositoryRef .= '/' . $$groupRef{'name'};
	} else {
	    $$repositoryRef .= "/common";
	}
	return 2 if (substr($$cfgRef{'global'},0,1) ne "/");
    }
    else {
	$$repositoryRef = $CurrentDir;
	return 1;
    }

    if ( !( -e $$repositoryRef && -d $$repositoryRef ) ) {
	return 3;
    }
    return 0;
}

#-----------------------------------------
# xdevRename(originalName,newName)
#	Attempts to do a renaming of a file. It works
#	across devices.
# RETURNS:
#	0 on success, non-zero on error
sub xdevRename {
    my ($old, $new) = @_;
    my ($res);
    
    $res = system("cp $old $new 2> /dev/null");
    unlink($old) if ($res == 0);
    return $res;
}

# Use as &dispSymbols(\%PackageName::);
sub dispSymbols {
    my($hashRef) = shift;
    my(%symbols,@symbols);

    %symbols = %{$hashRef};
    @symbols = sort(keys(%symbols));
    foreach (@symbols) {
        printf("%-10.10s| %s\n", $_, $symbols{$_});
    }
}

END {
    unlink("$VarRun/chklogs.pid");
}
1;
Results 1 - 1
Help - FTP Sites List - Software Dir.
Searching half a billion files worldwide
© 1997-2009 MARUHN Internet Solutions