#!/usr/bin/perl -w
#
# TWikiGuestCacheAddOn, part of:
# TWiki Enterprise Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2009-2018 Peter Thoeny, peter[at]thoeny.org
# and TWiki Contributors.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version. For
# more details read LICENSE in the root of this distribution.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# As per the GPL, removal of this notice is prohibited.
# 
# Configure variables with defaults:
# $TWiki::cfg{TWikiGuestCacheAddOn}{ExcludeTopics} = 'TWikiRegistration';
# $TWiki::cfg{TWikiGuestCacheAddOn}{Tier1CacheAge} = '1'; # hour
# $TWiki::cfg{TWikiGuestCacheAddOn}{Tier1Topics} = 'WebAtom, WebChanges, WebRss';
# $TWiki::cfg{TWikiGuestCacheAddOn}{Tier2CacheAge} = '6'; # hours
# $TWiki::cfg{TWikiGuestCacheAddOn}{Tier2Topics} = 'WebHome, WebTopicList';
# $TWiki::cfg{TWikiGuestCacheAddOn}{CacheAge} = '48'; # hours
# $TWiki::cfg{TWikiGuestCacheAddOn}{Debug} = 0;

BEGIN {
    # Set default current working directory (needed for mod_perl)
    if( $ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
        chdir $1;
    }
    if ( defined $ENV{GATEWAY_INTERFACE} or defined $ENV{MOD_PERL} ) {
        $TWiki::cfg{Engine} = 'TWiki::Engine::CGI';
        use CGI::Carp qw(fatalsToBrowser);
        $SIG{__DIE__} = \&CGI::Carp::confess;
    }
    else {
        $TWiki::cfg{Engine} = 'TWiki::Engine::CLI';
        require Carp;
        $SIG{__DIE__} = \&Carp::confess;
    }
    $ENV{TWIKI_ACTION} = 'view';
    @INC = ('.', grep { $_ ne '.' } @INC);
    require 'setlib.cfg';
}

#=====================================================
# Global variables and initialization
#use CGI::Carp qw(fatalsToBrowser);

my $now = time();
my $pathInfo = $ENV{PATH_INFO} || '';
my $queryString = $ENV{QUERY_STRING} || '';
my $sid = $ENV{HTTP_COOKIE} || '';
$sid = '' unless( $sid && $sid =~ s/.*TWIKISID\=([a-z0-9]+).*/$1/ );
my $dataDir = '';
if( do 'LocalSite.cfg' ) {
    $dataDir = $TWiki::cfg{DataDir};
}
my $dataUpdate = (stat( "$dataDir$pathInfo.txt" ))[9];

#=====================================================
sub _readFile {
    my $name = shift;
    my $data = '';
    open( IN_FILE, "<$name" ) || return '';
    local $/ = undef; # set to read to EOF
    $data = <IN_FILE>;
    close( IN_FILE );
    $data = '' unless $data; # no undefined
    return $data;
}

#=====================================================
sub _saveFile {
    my( $name, $text ) = @_;

    unless ( open( FILE, ">$name" ) )  {
        die "Can't create file $name - $!\n";
    }
    print FILE $text;
    close( FILE);
}

#=====================================================
sub _appendToFile {
    my ( $name, $text ) = @_;

    if( $name && $text ) {
        if( open( FILE, ">>$name" ) ) {
            print FILE "$text\n";
            close( FILE );
        } else {
            print STDERR 'Could not write "'.$text.'" to '."$name: $!\n";
        }
    }
}

#=====================================================
sub _addLogEntry
{
    my ( $script, $extra ) = @_;

    my $dateFormat = $TWiki::cfg{DefaultDateFormat} || '$year-$mo-$day';
    my $timeFormat = '$hour:$min:$sec';
    my ($sec,$min,$hour,$day,$mo,$year) = gmtime( $now );
    unless( $TWiki::cfg{HTTP}{HiddenFields} ) {
        # querky way to detect pre-TWiki-6.0
        $timeFormat = '$hour:$min';
        ($sec,$min,$hour,$day,$mo,$year) = localtime( $now );
    }
    $sec  = '0' . $sec if( $sec < 10 );
    $min  = '0' . $min if( $min < 10 );
    $hour = '0' . $hour if( $hour < 10 );
    $day  = '0' . $day if( $day < 10 );
    my @abbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
    my $month = $abbr[$mo];
    $mo++;
    $mo   = '0' . $mo if( $mo < 10 );
    $year += 1900;
    $dateFormat =~ s/\$year/$year/go;
    $dateFormat =~ s/\$mo/$mo/go;
    $dateFormat =~ s/\$month/$month/go;
    $dateFormat =~ s/\$day/$day/go;
    $timeFormat =~ s/\$hour/$hour/go;
    $timeFormat =~ s/\$min/$min/go;
    $timeFormat =~ s/\$sec/$sec/go;

    my $webTopic = $pathInfo;
    $webTopic =~ s/^\///;
    $webTopic =~ s/(.*)\//$1./;
    my $agent = $ENV{HTTP_USER_AGENT} || 'Unknown';
    $agent =~ s/[\/ ].*//;
    my $ip = $ENV{REMOTE_ADDR} || '';
    my $log = "| $dateFormat - $timeFormat | guest | $script | $webTopic "
            . "| $agent $extra | $ip |";
    my $logFile = $TWiki::cfg{LogFileName};
    $logFile =~ s/%DATE%/$year$mo/go;
    #print STDERR "$log -- $logFile";
    _appendToFile( $logFile, $log );
}

#=====================================================
sub _getAuthUser
{
    my $file = shift;
    open( FILE, "<$file" ) || return '';
    while( <FILE> ) {
        if( $_ =~ /'AUTHUSER' *\=\> *'([^']+)'/ ) {
            return $1; # authenticated user
        }
    }
    close( FILE );
    return ''; # guest (not authenticated user)
}

#=====================================================
sub _checkIfCache
{
    return 0 unless( $dataDir );    # no caching if LocalSite.cfg not valid
    return 0 if( scalar( @ARGV ) ); # no caching if command line call
    return 0 unless( $pathInfo );   # no caching if no path info
    return 0 if( $queryString );    # no caching if URL parameter(s)
    my $authUser = _getAuthUser( "$TWiki::cfg{WorkingDir}/tmp/cgisess_$sid" );
    return 0 if( $authUser );       # no caching if authenticated user
    return 0 unless( $dataUpdate ); # no caching if topic does not exist

    # check excludes
    if( $pathInfo  =~ /^(.*)\/(.*)$/ ) {
        my $topicName = $2;
        my $excludeTopics = $TWiki::cfg{TWikiGuestCacheAddOn}{ExcludeTopics} ||
                            'TWikiRegistration';
        $excludeTopics =~ s/$TWiki::cfg{NameFilter}//go;
        $excludeTopics =~ s/, */\|/go;
        $excludeTopics = '^(' . $excludeTopics . ')$';
        return 0 if( $topicName =~ /$excludeTopics/ );
    }

    return 1;
}

#=====================================================
sub _cacheAndReturnPage
{
    # cache age in seconds
    my $cacheAge = ( $TWiki::cfg{TWikiGuestCacheAddOn}{CacheAge} ||
                     '48' ) * 3600;
    my $tier1Age = ( $TWiki::cfg{TWikiGuestCacheAddOn}{Tier1CacheAge} ||
                     '1' ) * 3600;
    my $tier1Topics = $TWiki::cfg{TWikiGuestCacheAddOn}{Tier1Topics} ||
                      'WebAtom, WebChanges, WebRss';
    $tier1Topics =~ s/$TWiki::cfg{NameFilter}//go;
    $tier1Topics =~ s/, */\|/go;
    $tier1Topics = '^(' . $tier1Topics . ')$';
    my $tier2Age = ( $TWiki::cfg{TWikiGuestCacheAddOn}{Tier2CacheAge} ||
                     '6' ) * 3600;
    my $tier2Topics = $TWiki::cfg{TWikiGuestCacheAddOn}{Tier2Topics} ||
                      'WebHome, WebTopicList';
    $tier2Topics =~ s/$TWiki::cfg{NameFilter}//go;
    $tier2Topics =~ s/, */\|/go;
    $tier2Topics = '^(' . $tier2Topics . ')$';

    # create cache directories if needed
    my $cacheDir = $TWiki::cfg{PubDir} . '/.cache';
    mkdir( $cacheDir ) unless( -e $cacheDir );
    my $webs = $pathInfo;
    $webs =~ s/(.*)\/(.*)/$1/; # cut topic
    my $topicName = $2;        # extract topic name
    $webs =~ s/^\///;          # cut initial slash from web list
    foreach( split( /\//, $webs ) ) {
        $cacheDir .= "/$_";
        mkdir( $cacheDir ) unless( -e $cacheDir ); # create web directories if needed
    }

    # update cache file if needed
    my $cacheUpdate = (stat( "$cacheDir/$topicName.html" ))[9];
    my $text = '';
    my $extraParam = 'extralog=-%20caching%20topic';
    if( ! $cacheUpdate
      || $cacheUpdate < $dataUpdate
      || ( $topicName =~ /$tier1Topics/ && $cacheUpdate + $tier1Age < $now )
      || ( $topicName =~ /$tier2Topics/ && $cacheUpdate + $tier2Age < $now )
      || $cacheUpdate + $cacheAge < $now
      ) {
        # Cache topic and return content
        $ENV{QUERY_STRING} = $extraParam;
        my $cmd = $ENV{SCRIPT_NAME} || '/do/view';
        $cmd =~ s/^.*\//.\//o; # change '/do/view' to './view'
        $cmd .= " topic=$webs.$topicName 2>/dev/null";
        $text = `$cmd`;
        $text =~ s/^.*?\n\r?\n\r?//os;
        $text =~ s/<meta name="robots"[^>]*>//goi;
        $text =~ s/\?\Q$extraParam\E\#/#/gi;
        $text =~ s/\?\Q$extraParam\E\;/?/gi;
        _saveFile( "$cacheDir/$topicName.html", $text );

    } else { 
        # Return cached topic
        $text = _readFile( "$cacheDir/$topicName.html" );
        $text =~ s/<meta name="robots"[^>]*>//goi;
        $text =~ s/\?\Q$extraParam\E\#/#/gi;
        $text =~ s/\?\Q$extraParam\E\;/?/gi;
        _addLogEntry( 'view', '- from cache' ) if( $text );
    }

    # Check for failed cache with zero byte content
    unless( $text ) {
        # Cache failed, get rid of it 
        unlink( "$cacheDir/$topicName.html" );
        # ...and return regular TWiki page
        _uncachedTWikiView();
        return;
    }

    # Output proper content type
    if( $topicName =~ /^(WebRss|RssFeed|BlogFeed)$/ ) {
        print "Content-type: application/rss+xml\n\n";
    } elsif( $topicName =~ /^(Blog|Web)Atom$/ ) {
        print "Content-type: application/atom+xml\n\n";
    } else {
        print "Content-type: text/html\n\n";
    }
    if( $TWiki::cfg{TWikiGuestCacheAddOn}{Debug} ) {
        my $debug = "\n<pre>\n"
          . "dataDir: $dataDir\n"
          . "dataUpdate: $dataUpdate\n"
          . "webs: $webs\n"
          . "topicName: $topicName\n"
          . "cacheDir: $cacheDir\n"
          . "cacheUpdate: $cacheUpdate\n"
          . "cacheAge: $cacheAge\n"
          . "tier1Age: $tier1Age\n"
          . "tier1Topics: $tier1Topics\n"
          . "tier2Age: $tier1Age\n"
          . "tier2Topics: $tier1Topics\n"
          . "now: $now\n"
          . "sid: $sid\n"
          . "</pre>\n";
        $text =~ s/(<\/body)/$debug$1/;
    }
    print $text;
}

#=====================================================
sub _uncachedTWikiView
{
    require TWiki;
    require TWiki::UI;
    $TWiki::engine->run();
}

# Main =====================================================
if( _checkIfCache() ) {
    _cacheAndReturnPage();

} else {
    _uncachedTWikiView();
}

# END =====================================================
