#!/usr/athena/bin/perl

# $Header: /afs/sipb/service/rtfm-new/src/mail-server/RCS/check-locks.plin,v 1.2 1998/04/26 16:10:04 mhpower Exp arolfe $

push(@INC, '/rtfm/mserv');

require 'mservlib.pl';

$pid = do "$lib'queuedir/$lib'lockfile";

$ENV{'PATH'} .= ":/usr/ucb" if ($ENV{'PATH'} !~ m,(^|:)/usr/ucb($|:),);

if ($pid) {
    if (! kill(0, $pid)) {
	$newpid = do "$lib'queuedir/$lib'lockfile";
	&error("stale lock file", $lib'queuedir) if ($pid == $newpid);
    }
}

chdir("$lib'queuedir/old") || 
    (&error("couldn't chdir to $lib'queuedir/old: $!", "$lib'queuedir/old"),
     die);

@files = &readdir(".");
if (! @files) {
    &error("empty directory $lib'queuedir/old", "$lib'queuedir/old");
}

foreach $file (@files) {
    unlink($file) if ((-M $file) > 60);
}

chdir($lib'queuedir) ||
    (&error("couldn't chdir to $lib'queuedir: $!", $lib'queuedir), die);

@files = &readdir(".");
if (! @files) {
    &error("empty directory $lib'queuedir", $lib'queuedir);
}

foreach $file (@files) {
    if (((-M $file) > 1) && (! -d $file) && ($file !~ /^request_db/)) {
	&error("old file", $lib'queuedir);
	last;
    }
}

($sec, $min, $hour, $mday, $mon, $year) = localtime(time);

$outfile = sprintf("%s/old/%4d.%02d.%02d.%02d.%02d.%02d.old-data", $lib'queuedir, 1900 + $year, $mon + 1, $mday, $hour, $min, $sec);
$inpat = &lib'make_file_regexp("data");

chdir("$lib'queuedir/old") ||
      &error("couldn't chdir to $lib'queuedir/old: $!", "$lib'queuedir/old");

@files = &readdir(".");
@files = grep(/$inpat/o, @files);
if (! @files) {
    &error("no data files in $lib'queuedir/old", "$lib'queuedir/old");
}

open(OUTFILE, ">$outfile") || die "Opening $outfile: $!";

foreach $file (@files) {
    print OUTFILE "File: $file\n" || die "Writing to $outfile: $!.\n";
    open(INFILE, $file) || die "Opening $file: $!";
    (print OUTFILE $_ || die "Writing to $outfile: $!.\n") while (<INFILE>);
    close(INFILE);
    unlink($file);
}

close(OUTFILE);
system("compress $outfile");

sub error {
    local($_);

    open(MAILER, "|$lib'mailer") || die;
    print MAILER "From: $lib'bounce_adr
To: $lib'administrator
Subject: $_[0] problem with $lib'archiver

";
    open(LS, "/bin/ls -ltr $_[1]|");
    while (<LS>) {
	print MAILER $_ || die;
    }
    close(LS);
    close(MAILER);
}

sub readdir {
    local(@files);

    opendir(READDIR, $_[0]) || return undef;
    @files = readdir(READDIR);
    close(READDIR);
    sort @files;
}