#!/usr/bin/perl
#<mfindex: generate an index for modified files.

use Modern::Perl;
use CGI::Carp qw(fatalsToBrowser);
use Cwd;
use Date::Parse;
use File::Basename;
use POSIX qw(strftime);

my %meta;
my $myname = basename($0);
$myname =~ s/\.\w*$//;    # strip any extension

# Current time and sensible working directory.

my $now    = expires('now');
my $top    = $ENV{'DOCUMENT_ROOT'} . $ENV{'REQUEST_URI'};
my $dir    = $ENV{'REQUEST_URI'};
my $status = 'OK';
my $ok     = 1;
my $dot    = 0;
my $exten  = '';
my $str    = '';

# Icon stuff - ftpl is "file template" image; replace XXX
# with whatever matches in the %icons hash, or generic text
# if there are no matches.

my %icons;
my $dimg = '<img src="/ficons/folder.png" alt="[DIR]" />';
my $ftpl = '<img src="/ficons/XXX" alt="[TXT]" />';
my $fimg;

if (-d "$top") {
    unless (chdir($top)) {
        $status = "$top: cannot cd: $!";
        $ok     = 0;
    }
}
else {
    $ok     = 0;
    $status = "$top not a directory";
}

# Print HTTP cache stuff and HTML header.
# This is where we exit if there's a problem with the directory.

print <<"EndHeader";
Expires: $now
Date: $now
Pragma: no-cache
Cache-Control: no-cache, max-age=0, must-revalidate
Content-type: text/html; charset=iso-8859-1

<!DOCTYPE html>
<html>
<head>
  <title>$dir</title>
  <title>Syslog listing</title>
  <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
  <meta name="description" content="Syslog files for a given day">
  <meta name="keywords" content="Syslog directory">
  <meta name="robots" content="index, follow">

  <meta http-equiv="Revision" content="$meta{'version'}" />
  <meta http-equiv="Modified" content="$meta{'date'}" />
  <meta http-equiv="Host" content="$meta{'host'}" />
  <meta http-equiv="Source" content="$meta{'source'}" />
  <meta http-equiv="UUID" content="$meta{'uuid'}" />

  <link rel="stylesheet" href="/style/2col.css" type="text/css" media="screen">
  <style>
    table { table-layout: fixed; }
    td { padding-left: 1em; padding-top: 1em; }
    th { padding-left: 2em; padding-top: 0; margin-top: 0; }
    pre { display: block; }
    pre.calendar { padding: 0; margin: 0; }
  </style>
</head>

<body>
EndHeader

unless ($ok) {
    print "Sorry, $status\n";
    print "</body></html>\n";
    exit(0);
}

# What's in the directory?

opendir(my $dh, ".") || die "opendir .: $!\n";
my @files = sort(readdir($dh));
my @dirs  = grep(-d,  @files);
my @other = grep(!-d, @files);
closedir($dh);

seticons();

# Print basic page setup.

my $info;

print <<"EndBC";
  <div class="colmask doublepage">
    <div class="colleft">
      <div class="col1">
        <!-- Column 1 start -->
EndBC

# Show the current date.

my $today = getcwd;
my $when;
$_ = substr($today, -9);    # should give "YYYY/MMDD".

if (m!(\d\d\d\d)/(\d\d)(\d\d)!) {
    my $d = sprintf("%d/%d/%d", $2, $3, $1);
    my $t = str2time($d);
    $when = strftime("%a, %d %b %Y", localtime($t));
    print "<h3>$when</h3>\n";
}
print "<p><pre>\n";

# Show the files for the current date, if one has been selected.
#
foreach (@other) {
    next if /^\./;
    $info = pathinfo($_);

    if ($dot = rindex($_, ".")) {
        $exten = substr($_, $dot);
        $str   = defined($icons{$exten}) ? $icons{$exten} : $icons{'.txt'};
    }
    else {
        $str = $icons{'.unk'};
    }

    $fimg = $ftpl;
    $fimg =~ s/XXX/$str/;
    print "  $fimg $info <a href=\"$_\">$_</a>\n";
}

# Right side: print a calendar for this year if one's available.
# Look in cwd and parent directory for a file called .calendar.

print <<"EndLeft";
</pre>
<!-- Column 1 end -->
     </div>
     <div class="col2">
<!-- Column 2 start -->
EndLeft

my $cwd = getcwd;
my $calendar;
my $fh;

$calendar = '.calendar';
if (-f $calendar && open($fh, '<', $calendar)) {
    print while <$fh>;
    close($fh);
}
else {
    $calendar = '../.calendar';
    if (-f $calendar && open($fh, '<', $calendar)) {
        print while <$fh>;
        close($fh);
    }
}

# Finish calendar.

print <<"EndRight";
        <!-- Column 2 end -->
      </div>
    </div> 
  </div>       
</body></html>
EndRight

exit(0);

#---------------------------------------------------------------------
# Handle the UUID, current version, or source location.
# Store version info, etc. so we can use it in more than one place.
# In the examples below, replace underscores with dollar signs.
# Put [-5..-1] in date if you use Mercurial:
#    (qw_Date: Sat, 1 Jan 2000 00:00:00 -0500 _)[-5 .. -1]),

BEGIN {
    ## no critic (Variables::ProhibitConditionalDeclarations)

    %meta = (
        'date' => join(" ", (qw$Date: 2025-08-13 03:48:39-04 $)[-2 .. -1]),
        'host' => (qw$Host: furbag.home.arpa $)[-1],
        'source' =>
          (qw$Source: /doc/html/htdocs/syslogs/RCS/slindex,v $)[-1],
        'uuid'    => (qw$UUID: 64a713ce-9818-5925-b57e-b776c17aba43 $)[-1],
        'version' => (qw$Revision: 1.4 $)[-1]
        );
}

sub myuuid  { print "$meta{'uuid'}\n";                           exit(0); }
sub version { print "$myname $meta{'version'} $meta{'date'}\n";  exit(0); }
sub where   { print "file://$meta{'host'}", "$meta{'source'}\n"; exit(0); }

# -------------------------------------------------------------------------
# Size and modification date.

sub pathinfo {
    my $file = shift;
    my ($size, $mtime) = (stat("$file"))[7, 9];

    if (defined($size)) {
        return
          sprintf("%9d", $size) . "  "
          . strftime("%Y-%m-%d %T", localtime($mtime));
    }
    else {
        return '?   ?';
    }
}

# -------------------------------------------------------------------------
# Icon list.

sub seticons {
    %icons = (
        '.1'     => 'file-man.png',
        '.2'     => 'file-man.png',
        '.3'     => 'file-man.png',
        '.4'     => 'file-man.png',
        '.5'     => 'file-man.png',
        '.6'     => 'file-man.png',
        '.7'     => 'file-man.png',
        '.8'     => 'file-man.png',
        '.9'     => 'file-man.png',
        '.aiff'  => 'file-sound.png',
        '.avi'   => 'video-x-generic.png',
        '.bz2'   => 'package-x-generic.png',
        '.c'     => 'file-source.png',
        '.conf'  => 'text-x-generic.png',
        '.core'  => 'file-core.png',
        '.cpp'   => 'file-source.png',
        '.css'   => 'css.png',
        '.deb'   => 'file-deb.png',
        '.doc'   => 'x-office-document.png',
        '.dvi'   => 'file-dvi.png',
        '.exe'   => 'application-x-executable.png',
        '.flac'  => 'file-sound.png',
        '.fon'   => 'file-font-bitmap.png',
        '.gif'   => 'image-x-generic.png',
        '.gz'    => 'package-x-generic.png',
        '.h'     => 'file-source.png',
        '.hpp'   => 'file-source.png',
        '.htm'   => 'text-html.png',
        '.html'  => 'text-html.png',
        '.info'  => 'file-info.png',
        '.ini'   => 'text-x-generic.png',
        '.jpg'   => 'image-x-generic.png',
        '.key'   => 'x-office-presentation.png',
        '.ksh'   => 'file-shellscript.png',
        '.lnk'   => 'file-link.png',
        '.log'   => 'file-log.png',
        '.m3u'   => 'file-sound.png',
        '.m4a'   => 'file-sound.png',
        '.m4p'   => 'file-sound.png',
        '.mak'   => 'file-make.png',
        '.mid'   => 'file-midi.png',
        '.midi'  => 'file-midi.png',
        '.mov'   => 'video-x-generic.png',
        '.mp3'   => 'file-sound.png',
        '.mpg'   => 'video-x-generic.png',
        '.nef'   => 'image-x-generic.png',
        '.nfo'   => 'text-x-generic.png',
        '.odp'   => 'x-office-presentation.png',
        '.ods'   => 'x-office-presentation.png',
        '.odt'   => 'x-office-document.png',
        '.ogg'   => 'file-sound.png',
        '.otf'   => 'font-x-generic.png',
        '.pdf'   => 'file-pdf.png',
        '.php'   => 'text-html.png',
        '.pl'    => 'file-source.png',
        '.png'   => 'image-x-generic.png',
        '.pps'   => 'x-office-presentation.png',
        '.ppt'   => 'x-office-presentation.png',
        '.ps'    => 'file-postscript.png',
        '.py'    => 'file-source.png',
        '.rar'   => 'package-x-generic.png',
        '.rpm'   => 'file-rpm.png',
        '.rtf'   => 'x-office-document.png',
        '.sh'    => 'file-shellscript.png',
        '.shtml' => 'text-html.png',
        '.srt'   => 'text-x-generic.png',
        '.svg'   => 'file-vectorgfx.png',
        '.sxw'   => 'x-office-document.png',
        '.tar'   => 'package-x-generic.png',
        '.tgz'   => 'package-x-generic.png',
        '.tif'   => 'image-x-generic.png',
        '.tiff'  => 'image-x-generic.png',
        '.ttf'   => 'font-x-generic.png',
        '.txt'   => 'text-x-generic.png',
        '.unk'   => 'unknown.png',
        '.url'   => 'file-link.png',
        '.wav'   => 'file-sound.png',
        '.wma'   => 'file-sound.png',
        '.wmv'   => 'video-x-generic.png',
        '.xhtml' => 'text-html.png',
        '.xls'   => 'x-office-presentation.png',
        '.zip'   => 'package-x-generic.png'
        );
}

# -------------------------------------------------------------------------
# Return an "Expires" header for a given time.
# Stolen from CGI/Util.pm

sub expires {
    my ($time) = @_;

    my (@MON)  = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
    my (@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;

    # if user specifies "now" or "0", get system time.
    if (!defined($time) || !$time || (lc($time) eq 'now')) {
        $time = time();
    }

    # make HTTP date string from GMT'ed time
    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
    $year += 1900;
    return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
        $WDAY[$wday], $mday, $MON[$mon], $year, $hour, $min, $sec);
}
