maintain-campaignwiki

#! /home/alex/perl5/perlbrew/perls/perl-5.26.1/bin/perl

# maintain-campaignwiki maintains Oddmuse namespaces
# Copyright (C) 2009-2019  Alex Schroeder <alex@gnu.org>
#
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option) any
# later version.
#
# 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. See the GNU Affero General Public License for more
# details.
#
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <https://www.gnu.org/licenses/>.

use utf8; # this file contains UTF-8 encoded strings
use Modern::Perl '2017';
use LWP::UserAgent;
use POSIX qw(strftime);
use File::Path qw(remove_tree);
use File::ReadBackwards;
use File::Slurp;

# You may pass a namespaces on the command line
my @ns = @ARGV;

# Control PATH
$ENV{PATH} = '/bin:/usr/bin:/home/alex/bin';

# Base URL
my $wiki = 'https://campaignwiki.org/wiki';

# Set the VERBOSE environment variable to produce output
my $verbose = $ENV{VERBOSE};
say "Verbose" if $verbose;

# Printing UTF-8 encoded namespaces to stdout if verbose
binmode(STDOUT, ":utf8");

my $home    = "/home/alex";
my $docroot = "$home/campaignwiki.org";
my $script  = "$home/farm/wiki.pl";
my $data_dir = "$home/campaignwiki";
my $name    = "Campaign Wiki";

# Read Oddmuse sources
{
  no warnings qw(once);
  $OddMuse::RunCGI = 0;
  $OddMuse::DataDir = $data_dir;
}
require $script;
OddMuse::Init(); # set up $q and read config file

# Directory where you want the maintenance HTML files to end up.
my $maint = "$docroot/maintenance";
mkdir $maint;

# Directory with the static output files
my $static_dir = "$docroot/export";

# Extract the administrator password from the config file.  Should
# look as follows: $AdminPass="foo";
say "Read config file" if $verbose;
my $config = read_file("$data_dir/config");
my ($pw) = $config =~ /\$AdminPass = "(.*)";/;
say "Password $pw" if $verbose;

# Publish config file without password
say "Save config file without password" if $verbose;
$config =~ s/\$AdminPass = "(.*)";/\$AdminPass = "*secret*"; # not the real password/;
write_file("$docroot/config", $config);

# Publish this script
say "Publish script" if $verbose;
my $ua = LWP::UserAgent->new;

sub post {
  my $title = shift;
  my $text = shift;
  my %params = (title => $title,
		text => $text,
		raw => 1,
		username => "CronJob",
		pwd => $pw,
		summary => "Update");
  my $response = $ua->post($wiki, \%params);
  my $status = $response->code . ' ' . $response->message;
  warn "POST $title failed: $status.\n" unless $response->is_success;
  return $response->is_success;
}

# Must read source before chdir
my $source = read_file($0);
post('maintain-campaignwiki', $source);

# Clean up any old locks
say "Clean up old locks" if $verbose;
my $now = time;
my $max_age = 3 * 60 * 60; # 3h
opendir(my $dh, $data_dir)
    or die "Can't opendir $data_dir: $!";
my @temp_dirs = grep { -d }
    map { utf8::decode($_); "$data_dir/$_/temp"; }
    readdir $dh;
closedir $dh;
for my $temp_dir (@temp_dirs) {
  opendir(my $tdh, $temp_dir)
      or die "Can't opendir $temp_dir: $!";
  while (readdir $tdh) {
    utf8::decode($_);
    next unless /^lock/ && -d "$temp_dir/$_";
    my $age = $now - (stat("$temp_dir/$_"))[9];
    if ($age > $max_age) {
      say "Removing $temp_dir/$_ ($age seconds old)" if $verbose;
      remove_tree "$temp_dir/$_";
    }
  }
}

# Find all the namespaces in the "hive".
say "Getting all the namespaces" if $verbose;
if (not @ns) {
  opendir($dh, $data_dir)
      or die "Can't opendir $data_dir: $!";
  @ns = sort
      grep { /^[^a-z]/ && !/^\.\.?$/ && -d "$data_dir/$_" }
      map { utf8::decode($_); $_; }
      readdir $dh;
  closedir $dh;
}

# Maintenance action for all namespaces.
say "Removing old maintenance reports" if $verbose;
unlink glob "$maint/*.html";

# say "Running maintenance for all namespaces" if $verbose;
for my $ns ('Main', @ns) {
  say $ns if $verbose;
  # reset some variables that will get changed in NamespacesInitVariables
  no warnings qw(once);
  $OddMuse::ScriptName = $wiki;
  $OddMuse::FullUrl    = $wiki;
  $OddMuse::DataDir    = $data_dir;
  $OddMuse::SiteName   = $name;
  OddMuse::SetParam('ns', $ns); # requires $q to be setup
  OddMuse::NamespacesInitVariables();
  my $html = OddMuse::ToString(\&OddMuse::DoMaintain);
  $html =~ s/^.*?\r\n\r\n//s; # strip headers
  OddMuse::WriteStringToFile("$maint/$ns.html", $html);
  # make sure we don't run into surge protection
  sleep 1;
}

# Clean up possible pageidx file belonging to alex instead of www-data
my $uid = (getpwnam('alex'))[2];
say "Removing pageidx files belonging to alex ($uid)" if $verbose;
opendir($dh, $data_dir)
    or die "Can't opendir $data_dir: $!";
map { utf8::decode($_);
      unlink "$data_dir/$_/pageidx"
	  if -f "$data_dir/$_/pageidx"
	  and (stat("$data_dir/$_/pageidx"))[4] eq $uid
} readdir $dh;
closedir $dh;

# Clean up static copies but leave the uploaded files in place!
say "Cleaning up static copies" if $verbose;
remove_tree glob "$static_dir/*";

# We used to leave static images in place, but no more.

# Status -- find empty wikis by counting the number of page files.
# When counting, ignore symlinks because BannedContent.pg is a symlink
# (see above).  Also post the data collected on the Status page.  Make
# sure that nothing in the rest of this script visits the wikis lest
# their data directories be recreated.
say "Computing status and deleting old wikis" if $verbose;
my $active       = "\n\n== Active Wikis\n";
my $active_de    = "\n\n== Aktive Wikis\n";
my $status       = "\n\n== Other Wikis\n";
my $status_de    = "\n\n== Andere Wikis\n";
my $hiatus       = "\n\n== Wikis in Hiatus\nThese wikis had no activity in half a year.\n";
my $hiatus_de    = "\n\n== Wikis mit Unterbruch\nIn diesen Wikis wurde im letzten halben Jahr nichts geändert.\n";
my $hibernate    = "\n\n== Hibernating Wikis\nThese wikis had no activity in the last year.\n";
my $hibernate_de = "\n\n== Wikis im Winterschlaf\nIn diesen Wikis wurde im letzten Jahr nichts geändert.\n";

for my $ns (@ns) {
  my $pg=0;
  if (-d "$data_dir/$ns/page") {
    my @pages = glob "$data_dir/$ns/page/*.pg";
    $pg = @pages; # number of pages
  }
  if (not $pg) {
    say "Deleting $ns" if $verbose;
    # delete mail timestamp
    unlink "$home/.rc2mail/CampaignWiki-$ns.ts";
    # delete directory
    if (not remove_tree "$data_dir/$ns") {
      $status .= "\n* $ns had 0 pages but deletion failed";
      $status_de .= "\n* $ns hat 0 Seiten, konnte aber nicht gelöscht werden";
    }
  } else {
    say $ns if $verbose;
    my $file = "$data_dir/$ns/rc.log";
    $file = "$data_dir/$ns/oldrc.log" if -z $file;
    my $rc = File::ReadBackwards->new($file)
	or die "cannot read $file: $!";
    my $last_line = $rc->readline;
    my $ts;
    ($ts) = $last_line =~ /^(\d+)/ if $last_line;

    if (not $ts) {

      warn "$ns has no timestamp in $file\n";

    } else {

      # compute string
      my $mod = OddMuse::TimeToText($ts);
      my $days = int(($now - $ts) / 24 / 60 / 60);
      $mod = "**$mod**" if $days < 7;
      my $name = $ns;
      $name =~ s/_/ /g;
      my $str    = "\n* [$ns:HomePage $name] has [$ns:?action=index $pg page"
	  . ($pg != 1 ? "s" : "")
	  . "], last modified $mod"
	  . ($pg > 99 ? " &#x2605;" : "");
      my $str_de = "\n* [$ns:HomePage $name] hat [$ns:?action=index $pg Seite"
	  . ($pg != 1 ? "n" : "")
	  . "], letzte Änderung am $mod"
	  . ($pg > 99 ? " &#x2605;" : "");

      # assign to one of the sections
      if ($days > 366) {
	$hibernate    .= $str;
	$hibernate_de .= $str_de;
      } elsif ($days > 183) {
	$hiatus       .= $str;
	$hiatus_de    .= $str_de;
      } elsif ($days > 32) {
	$status       .= $str;
	$status_de    .= $str_de;
      } else {
	$active       .= $str;
	$active_de    .= $str_de;
      }
    }
  }
}

say "Posting Status" if $verbose;

# assemble final page to post
my $page = "Large wikis with more than 100 pages are marked with a star (&#x2605;).\n";
$page .= $active;
$page .= $status;
$page .= $hiatus;
$page .= $hibernate;

post('Status', $page);

say "Posting Übersicht" if $verbose;

$page = "Grosse Wikis mit mehr als hundert Seiten sind mit einem Stern (&#x2605;) markiert.\n";
$page .= $active_de;
$page .= $status_de;
$page .= $hiatus_de;
$page .= $hibernate_de;

post('Übersicht', $page);