#!/usr/bin/env perl
# polipo-cycle - Polipo disk-cache maintenance tool.
# License:  BSD-style [for this file only]
# Revision: 081019

#---------------------------------------------------------------------
#                              overview
#---------------------------------------------------------------------

# 1. "polipo-cycle" is a Polipo disk-cache maintenance tool.

#---------------------------------------------------------------------

# 2. "polipo-cycle" requires Perl 5 and one  CPAN  add-on module named
# "Proc::ProcessTable".  For more information on  the  add-on  module,
# visit the following web site:
#
#     http://search.cpan.org/

#---------------------------------------------------------------------

# 3. "polipo-cycle" should be executed  periodically using "cron".  If
# you have a fast system,  the recommended  time interval is 30 to 240
# minutes.  If you have a  slow system,  you may wish to  increase the
# time interval to  one day or greater.  However, the precise interval
# used isn't critical.

#---------------------------------------------------------------------

# 4. When "polipo-cycle" is executed, it checks to see if another copy
# of "polipo-cycle" is already running.  If so, the new instance exits
# immediately.

#---------------------------------------------------------------------

# 5. Otherwise, "polipo-cycle" performs two primary operations:
#
#     (a) It executes "polipo -x",  which  truncates or removes cached
#         data based on "polipo" configuration-file settings. Note: If
#         "polipo -x" is  already running,  "polipo-cycle"  skips this
#         step.
#
#     (b) It executes  "polipo-trimcache"  [with  appropriate  parame-
#         ters]. This enforces a cache-size limit.  Note: The limit is
#         specified in the  "program parameters" section  included be-
#         low.  Note: If "polipo-trimcache" is already running, "poli-
#         po-cycle" skips this step".

#---------------------------------------------------------------------

# 6. If a "polipo" master process is  running  (as opposed to  "polipo
# -x"  or "polipo-trimcache"  maintenance  processes),  "polipo-cycle"
# also sends some signals to the master process. For an explanation of
# the signals used, see the official Polipo documentation.

#---------------------------------------------------------------------

# 7. Before attempting  to  use  "polipo-cycle",  check the parameters
# specified in the "program parameters" section. Modify the parameters
# appropriately for your distro.

#---------------------------------------------------------------------

# 8. Technical notes:
#
# 8a. This version of "polipo-cycle" uses the following rule to ident-
# ify the "polipo" master process:  If a process  is running an execu-
# table named "polipo",  and the process  has  a command-line argument
# that contains the string "/polipo.log", the process is assumed to be
# the "polipo" master process.

# 8b. Some distros may call the Polipo "trimcache" script by its orig-
# inal name (polipo_trimcache)  and others may  call it by a slightly-
# different name (polipo-trimcache). "polipo-cycle" should work either
# way.

#---------------------------------------------------------------------
#                            module setup
#---------------------------------------------------------------------

require 5.6.1;
use strict;
use Carp;
use warnings;
use POSIX qw (SIGUSR1 SIGUSR2);
use Proc::ProcessTable;
                                # Trap warnings
$SIG {__WARN__} = sub { die @_; };

#---------------------------------------------------------------------
#                           basic constants
#---------------------------------------------------------------------

use constant ZERO  => 0;        # Zero
use constant ONE   => 1;        # One

use constant FALSE => 0;        # Boolean FALSE
use constant TRUE  => 1;        # Boolean TRUE

#---------------------------------------------------------------------
#                          "signal" numbers
#---------------------------------------------------------------------

my $SIGUSR1 = &POSIX::SIGUSR1;
my $SIGUSR2 = &POSIX::SIGUSR2;

#---------------------------------------------------------------------
#                         program parameters
#---------------------------------------------------------------------

# Note:  The  first two parameters here are special.  These parameters
# are set at "build" time by the "build" system.

my $LOGCYCLE  = '__META_PREFIX__/log/cycle';
my $SBIN_DIR  = '__META_PREFIX__/sbin';
my $CACHE_DIR = '/var/cache/polipo';
my $MB_LIMIT  = 1024;

my $FLAGFILE_LIVEDISTRO = '/etc/sysconfig/ISLIVEDISTRO';
my $MAX_LOGCYCLE_SIZE   = 100000;
my $MasterProcess       = "Polipo master process";

#---------------------------------------------------------------------
#                          global variables
#---------------------------------------------------------------------

my $FlagLogOwnerSet = FALSE;    # Used by "LogMsg"
my $MyPID           = $$;       # Used by "GetPidUsingCmdLine"
                                # Ditto
my $TableObject = new Proc::ProcessTable;

#---------------------------------------------------------------------
#                          support routines
#---------------------------------------------------------------------

# "timestamp" returns a current "timestamp" string  (without  trailing
# white space).

#---------------------------------------------------------------------

sub timestamp
{
    my @months =
    (
        'Jan' , 'Feb' , 'Mar' , 'Apr' , 'May' , 'Jun' ,
        'Jul' , 'Aug' , 'Sep' , 'Oct' , 'Nov' , 'Dec'
    );

    my
    (
        $sec, $min, $hour, $mday, $month, $year, $wday, $yday, $isdst
    )
    = localtime (time);

    $year %= 100;
    sprintf ("%02u/%s/%02u %02u:%02u:%02u",
             $mday, $months [$month], $year, $hour, $min, $sec);
}

#---------------------------------------------------------------------

sub TruncLogCycleFile
{
    return unless -f $LOGCYCLE;
    my $xsize = (stat $LOGCYCLE) [7];

    if (defined ($xsize) &&
        ($xsize >= $MAX_LOGCYCLE_SIZE) &&
        open (OFD, ">$LOGCYCLE"))
    {
        close OFD;
    }

    undef;
}

#---------------------------------------------------------------------

sub LogMsg
{
    my ($msg) = @_;

#---------------------------------------------------------------------

                                # To be documented
    return if -f $FLAGFILE_LIVEDISTRO;
    &TruncLogCycleFile();

    if (open (LOGFD, ">>$LOGCYCLE"))
    {
        $msg =  "" if !defined $msg;
        $msg =~ s@^\s+@@s;
        $msg =~ s@\s+\z@@s;
        $msg =  '???' if !length ($msg);

        print LOGFD &timestamp(), " ", $msg, "\n";
        close LOGFD;

        if (!$FlagLogOwnerSet)
        {
            $FlagLogOwnerSet = TRUE;
            system ("chown nobody.nogroup $LOGCYCLE");
        }
    }

    undef;
}

#---------------------------------------------------------------------

sub GetPidUsingCmdLine
{
    my ($pattern) = @_;

    if (!defined ($pattern))
    {
        &LogMsg ("Internal error: missing pattern");
        exit ONE;
    }

    my $ProcessTable = $TableObject->table();

    for my $Process (@$ProcessTable)
    {
        my $cmd = $Process->cmndline;
        $cmd =~ s@^(/[A-Za-z0-9_\-/]+/)?(perl|python) +@@;
        next unless $cmd =~ m@$pattern@;
        my $PID = $Process->pid;
        next if $MyPID == $PID;
        return $PID;
    }

    undef;
}

#---------------------------------------------------------------------

sub GetPolipoPidMaster
{
    my $pattern = << 'END';
^(/[A-Za-z0-9_\-/]+/|\./)?polipo .*/polipo\.log
END
    $pattern =~ s@\s+\z@@s;
    &GetPidUsingCmdLine ($pattern);
}

#---------------------------------------------------------------------

sub GetPolipoPidCycle
{
    my $pattern = '^(/[A-Za-z0-9_\.\-/]+/)?polipo-cycle\b';
    &GetPidUsingCmdLine ($pattern);
}

#---------------------------------------------------------------------

sub GetPolipoPidDashX
{
    my $pattern = '\bpolipo -x\b';
    &GetPidUsingCmdLine ($pattern);
}

#---------------------------------------------------------------------

sub GetPolipoPidTrimCache
{
    my $pattern = '^(/[A-Za-z0-9_\.\-/]+/)?polipo[_\-]*trimcache';
    &GetPidUsingCmdLine ($pattern);
}

#---------------------------------------------------------------------

sub SignalPolipo
{
    my ($ref_pid, $signum, $sigdesc) = @_;
    my $msg;

    return unless defined ($$ref_pid);
    kill ($signum, $$ref_pid);
    sleep (2);
    my $xpid = &GetPolipoPidMaster();

    if (!defined ($xpid))
    {
        undef $$ref_pid;
        $msg = "$MasterProcess at PID $$ref_pid disappeared";
    }
    elsif ($$ref_pid != $xpid)
    {
        $msg = "Found another $MasterProcess at PID $xpid";
    }

    if (defined ($msg))
    {
        $msg .= " after $sigdesc";
        &LogMsg ($msg);
    }

    undef;
}

#---------------------------------------------------------------------
#                            main routine
#---------------------------------------------------------------------

sub Main
{
    my $cmd;
    my $msg;
    my $pid;
    my $xpid;

#---------------------------------------------------------------------
# Initial setup.

    $_ = $CACHE_DIR;
    exit (ONE) unless -d && -r && -w && -x;

    if (defined (&GetPolipoPidCycle()))
    {
        if ((-t STDIN) && (-t STDOUT) && (-t STDERR))
        {
            print "polipo-cycle is already running\n";
        }
 
        exit ZERO;
    }

    $pid = &GetPolipoPidMaster();
    $msg = defined $pid ?
        "Found $MasterProcess at PID $pid" :
        "$MasterProcess isn't running";
    &LogMsg ($msg);

#---------------------------------------------------------------------

    if (defined (&GetPolipoPidDashX()))
    {
        &LogMsg ("polipo -x is already running");
    }
    else
    {
        &SignalPolipo (\$pid, $SIGUSR1, "1st SIGUSR1");

        &LogMsg ("polipo -x output:");
        $cmd =  "/bin/nice --adjustment=10 ${SBIN_DIR}/polipo -x";
        $cmd .= " >> $LOGCYCLE 2>&1";

        system $cmd;
        &SignalPolipo (\$pid, $SIGUSR2, "1st SIGUSR2");
    }

#---------------------------------------------------------------------

                                # Is this a LiveDistro?
    if (-f $FLAGFILE_LIVEDISTRO)
    {                           # Yes - Don't start "trimcache"
    }
    elsif (defined (&GetPolipoPidTrimCache()))
    {
        &LogMsg ("polipo-trimcache is already running");
    }
    else
    {
        &SignalPolipo (\$pid, $SIGUSR1, "2nd SIGUSR1");

        &LogMsg ("polipo-trimcache output:");
        $cmd =  << "END";
/bin/nice --adjustment=10
${SBIN_DIR}/polipo-trimcache $CACHE_DIR ${MB_LIMIT}M
END
        $cmd =~ s@\s*\n\s*@ @gs;
        $cmd =~ s@\s+\z@@s;
        $cmd .= " >> $LOGCYCLE 2>&1";

        system $cmd;
        &SignalPolipo (\$pid, $SIGUSR2, "2nd SIGUSR2");
    }

    undef;
}

#---------------------------------------------------------------------
#                            main program
#---------------------------------------------------------------------

&Main();                        # Call the main routine
exit ZERO;                      # Normal exit