#!/usr/bin/perl -w
# file KLEIDER/web/src/favourites/logs.pl
# Auswertung der Logdateien
# 2017-06-05 Herbert Schiemann <h.schiemann@herbaer.de>
# GPL Version 2 oder neuer
# 2018-01-01 exclua Voreinstellung korrigiert
# 2018-01-03 Element time in Ausgabe "finished"
# 2019-09-17 ownmark in UA markiert Selbstbesuche
# 2020-04-13 Pfad-Voreinstellungen

use Cwd qw(realpath);
use File::Spec::Functions qw(catfile) ;
use IO::Uncompress::Gunzip;
use HTTP::Date;       # str2time
use Herbaer::Readargs ;
use Herbaer::Replace ;
use Herbaer::XMLDataWriter ;

use utf8;
binmode (STDERR, ":utf8") ;
binmode (STDOUT, ":utf8") ;

my $webbase = realpath ($0);
$webbase =~ s/\/src\/favourites\/logs.pl$//;

# Hash der Kommandozeilen-Argumente
my $args = {
   "[cnt]verbose" => 1,

   # Zeitstempel für die Ausgabedateien
   "timestamp"  => "neu", # strftime("%Y%m%d%H%M%S", localtime())

   # Verzeichnis der Skripte
   "srcdir"     => "$webbase/src/favourites",

   # Verzeichnis der Besuchsdaten
   "datadir"    => "$webbase/visits",

   # Eingabe: offene Besuche (alt)
   "openin"     => "\${datadir}/open.xml",

   # Verzeichnis der neuen Access-Log-Dateien
   "newlogs"    => "\${datadir}/newlogs",

   # Filter des Dateinamens von Access-Logs
   "logsflt"    => '^access_log_\d{4}-\d{2}-\d{2}\.gz$',

   # Ausgabe: offene Besuche (neu)
   "openout"    => "\${datadir}/open.xml.\${timestamp}",

   # Ausgabe: abgschlossene Besuche, Summen
   "finished"   => "\${datadir}/finished.xml.\${timestamp}",

   # Ausgabe: abgschlossene Besuche, Details
   "detailed"   => "\${datadir}/detailed.xml.\${timestamp}",

   # Nach dieser Zeit in Sekunden gilt ein Besuch als beendet
   "timeout"    => 300,

   # Regex der Pfade, die einen eigenen Besuch kennzeichnen
   "own"        => '^/usage/',

   # Filter für Zugriffpfad auf Bildergeschichte (Story-ID)
   "storyidflt" => '^/(?:l\/[a-z]+/)?s(2[^/]+)(?:/story.xml\b.*)?$',

   # Filter für Zugriffspfad auf Bild (Story-ID, Bild-ID)
   "imageflt"   => '^/(?:l/[a-z]+/)?s(2[^/]+)/(?:images|smallimg)/([^./]+)\.jpg$',

   # Filter für die Kennung der Sprache
   "langflt"    => '^/(?:l/[a-z]+/)?local/local\.xml\.([a-z]+)$',

   # Regex-Liste der ausgenommenen User Agents
   "exclua"     => [
      "\\+?crawl@",
      "\\+?spider@",
      "\\+?bot@",
      "\\+?info@",
      "\\bips-agent\\b",
      "\\bhttps?://",
      "\\bBingPreview\\b",
      "\\bGooglebot\\b",
      "\\bit2media-domain-crawler\\b",
      "\\bIceweasel/3\\.5\\.16 \\(like Firefox/3\\.5\\.16\\)",
      "^Mozilla/5\\.0 "
      . "\\(Linux; Android 4\\.4\\.2; de-de; SAMSUNG SM-G900F Build/KOT49H\\)"
      . " AppleWebKit/537\\.36 \\(KHTML, like Gecko\\) Version/1\\.6"
      . " Chrome/28\\.0\\.1500\\.94 Mobile Safari/537\\.36\$",
      ],

   # Wurzelverzeichnis des Servers
   "docroot"    => "$webbase/docroot",

   # Markierer für eigene Aufrufe
   "ownmark"    => "(herbaer)",

   # Filter der Verzeichnisnamen der Bildergeschichten
   "storyflt"   => '^s(\d.+)$',
};

# gibt die Version nach STDOUT aus
sub version {
   print <<'VERSION' ;
KLEIDER/web/src/favourites/logs.pl
Besuche und Zugriffe auf Stories und Bilder
2017 Herbert Schiemann <h.schiemann@herbaer.de>
VERSION
}
$args -> {"[sr]version"} = sub { version (); exit 0; };

$args -> {"[sr]help"} = sub {
   version ();
   print_message_with_values (<<'HELP', $args);
logs.pl [Optionen]
--[no_]verbose               Umfang der Meldungen ${[cnt]verbose}
--timestamp  TIMESTAMP       Zeitstempel der Ausgabedateien ${timestamp}
--srcdir     SRCDIR          Verzeichnis der Skripte
                             ${srcdir}
--datadir    DATADIR         Verzeichnis der Besuchsdaten
                             ${datadir}
--openin     OPENIN          Eingabe: offene Besuche
                             ${openin}
--newlogs    NEWLOGS         Verzeichnis der neuen Access-Log-Dateien
                             ${newlogs}
--logsflt    LOGSFLT         Filter des Dateinamens von Access-Logs
                             ${logsflt}
--openout    OPENOUT         Ausgabe: offene Besuche
                             ${openout}
--finished   FINISHED        Ausgabe: abgeschlossene Besuche, Summen
                             ${finished}
--detailed   DETAILED        Ausgabe: abgeschlossene Besuche, Details
                             ${detailed}
--timeout    TIMEOUT         Ein Besuch endet TIMEOUT ${timeout} sec nach letztem Request
--own        OWN             Regex der Pfade, die einen eigenen Besuch kennzeichnen
                             ${own}
--storyidflt STORYIDFLT      Filter der Zugriffspfade der Bildergeschichten (Story-ID):
                             ${storyidflt}
--imageflt   IMAGEFLT        Filter der Zugriffspfade der Bilder (Story-ID, Bild-ID):
                             ${imageflt}
--langflt    LANGFLT         Filter für die Kennung der Sprache
                             ${langflt}
--exclua     EXCLUA          Liste der RegEx der ausgenommenen "User Agent"s
                             ${exclua}
--docroot    DOCROOT         Wurzelverzeichnis des Servers
                             ${docroot}
--ownmark    OWNMARK         UA-Markierung eigener Besuche ${ownmark}
--storyflt   STORYFLT        Filter der lokalen Verzeichnisnamen der Bildergeschichten
                             ${storyflt}
HELP
   exit 0;
};

=for comment

Struktur der Daten eines Besuchs

open_visits -> key
  ip
  first_access
  agent
  ref
  trfin
  trfout
  reqtime
  files
    $file cnt
  stories
    $storyid cnt
  images
    $image cnt
  lang
    [$lang, ...]
  own

=cut

# "globale" Daten für dieses Programm
my $data = {
   # "offene" Besuche
   # Ein offener Besuch ist bestimmt durch die IP-Adresse und den "Agenten"
   "open_visits" => {},
   # Zeit des zuletzt verarbeiteten Log-Eintrags
   "last_time"   => undef,
   # Zeit des ersten verarbeiteten Log-Eintrags
   "first_time"  => undef,
   # Anzahl der Besuche
   "numvisits"   => undef,
   # Besuchte stories
   "numstories"  => undef,
   # besuchte Bilder
   "numimages"   => undef,
};

my $xml_options = {
   '%visits'       => ["visits",  "visit"],
   '%files'        => ["files",   "ignore", "#file"],
   '%images'       => ["images",  "ignore", "#image"],
   '%stories'      => ["stories", "ignore", "#story"],
   '%lang'         => ["",        "ignore", "#lang"],
   '$ignore'       => 'IGNORE',
   '$first_access' => ["", "time"],
   '$last_access'  => ["", "time"],
   '$time'         => ["", "time"],
   '$first_time'   => ["", "time"],
   '$last_time'    => ["", "time"],
   '%numstories'   => ["numstories", "bylang", '@story'],
   '%numimages'    => ["numimages",  "bylang", '@image'],
   '%numvisits'    => ["numvisits",  "bylang",  '@lang'],
   '%bylang'       => ["", "num", '@lang'],
   '$bylang'       => ["num"],
};

sub init {
   my ($data, $args) = @_;
   my $k;
   my $re;
   my $el;  # Ergebnis-Liste
   my $li;  # Listenelement
   for $k (
      "logsflt", "storyflt",  "own", "storyidflt",
      "imageflt", "langflt", "exclua"
   )
   {
      $re = $args -> {$k};
      if (ref ($re) eq "ARRAY") {
         $el = [];
         for $li (@$re) {
            if ($li eq "none") {
               $el = [];
            }
            else {
               push (@$el, qr/$li/);
            }
         }
         $args -> {$k} = $el;
      }
      else {
         $args -> {$k} = qr/$re/ ;
      }
   }
   for $k ("openin", "newlogs", "openout", "finished", "detailed") {
      $args -> {$k} = replace ($args -> {$k}, $args);
   }
   $re = quotemeta ($args -> {"ownmark"});
   $args -> {"ownmark"} = qr/\s*$re/o;
} # init

# prüft, ob ein Regulärer Ausdruck der Liste liste auf die Zeichenkette s passt
# match_relist ($string, $liste)
sub match_relist {
   my ($s, $l) = @_;
   my $i;
   for $i (@$l) {
      return 1 if $s =~ $i;
   }
   return 0;
} # match_relist

# Offene Besuche lesen
sub read_openin {
   my ($data, $args) = @_;
   my $verb   = $args -> {"[cnt]verbose"};
   my $exclua = $args -> {"exclua"};
   my $own    = $args -> {"own"};
   my $f      = $args -> {"openin"};
   return unless -r $f;
   my $t      = catfile ($args -> {"srcdir"}, "visits_in.xslt");
   my $h;
   my $l;
   my $v;
   my $n;
   my $files;
   my $imgs;
   my $stos;
   my $langs;
   my $ov = $data -> {"open_visits"};
   my $add_v = sub {
      my $k;
      if ($v) {
         if (match_relist ($v -> {"agent"}, $exclua)) {
            $v = undef;
         }
      }
      if ($v) {
         $v -> {"files"}   = $files if %$files;
         $v -> {"images"}  = $imgs if %$imgs;
         $v -> {"stories"} = $stos if %$stos;
         $v -> {"lang"}    = $langs if %$langs;
         $k = $v -> {"ip"} . "/" . $v -> {"agent"};
         $ov -> {$k} = $v;
      }
      $v = undef;
      $files = {};
      $imgs  = {};
      $stos  = {};
      $langs = {};      
   };

   open ($h, "-|:encoding(utf-8)", "xsltproc", $t, $f);
   if (!$h) {
      print STDERR "Kann offene Besuche $f nicht lesen:$!\n";
      return;
   }
   while (defined ($l = <$h>)) {
      $l =~ s/\s+$//;
      $l =~ s/^\s+//;
      next if $l =~ /^#/;
      next unless $l;
      $l =~ /^([A-Z]+)\s(.+)/o or next;
      $l = $1;
      $n = $2;
      if ( $l eq "IP" ) {
         $add_v -> ();
         $v = {"ip" => $n};
      }
      elsif ( ! $v) {
         next;
      }
      elsif ( $l eq "AGENT" ) {
         $v -> {"agent"} = $n;
      }
      elsif ( $l eq "FIRST" ) {
         $v -> {"first_access"} = str2time ($n);
      }
      elsif ( $l eq "LAST" ) {
         $n = str2time ($n);
         $v -> {"last_access"} = $n;
      }
      elsif ( $l eq "TRFIN" ) {
         $v -> {"trfin"} += $n;
      }
      elsif ( $l eq "TRFOUT" ) {
         $v -> {"trfout"} += $n;
      }
      elsif ( $l eq "REQTIME" ) {
         $v -> {"reqtime"} += $n;
      }
      elsif ( $l eq "FILE" ) {
         ++ $files -> {$n};
         ++ $v -> {"ownsite"} if $n =~ $own;
      }
      elsif ( $l eq "STORY" ) {
         ++ $stos -> {$n};
      }
      elsif ( $l eq "IMAGE" ) {
         ++ $imgs -> {$n};
      }
      elsif ( $l eq "LANG" ) {
         ++ $langs -> {$n};
      }
      elsif ( $l eq "OWNSITE" ) {
         $v -> {"ownsite"} += $n;
      }
      else {
         print STDERR "Eingabefehler open visits\n" if $verb;
      }
   }
   $add_v -> ();
   close $h;
} # read_openin

read_args ($args);
init ($data, $args);
read_openin ($data, $args);
find_stories ($data, $args, $args -> {"docroot"});  # auch unbesuchte Stories
process_logs ($data, $args);
exit 0;

# sucht alle Bildergeschichten
sub find_stories {
   my ($data, $args, $docroot) = @_ ;
   my $verbose = $args -> {"[cnt]verbose"};
   my $de;  # Verzeichniseintrag
   my $dh;  # Verzeichnis-Handle
   my $re = $args -> {"storyflt"};
   opendir ($dh, $docroot) or do {
      print STDERR "Kann Verzeichnis \"$docroot\" nicht lesen: $!\n" if $verbose;
      return;
   };
   my $s = ($data -> {"numstories"} //= {});
   while (defined ($de = readdir ($dh))) {
      if ( $de =~ $re ) { $s -> {$1} //= {"total" => 0}; }
   }
   closedir ($dh);
} # find_stories

# verarbeitet die Access-Logs
sub process_logs {
   my ($data, $args) = @_ ;
   my $verbose = $args -> {"[cnt]verbose"};
   my $xmlwriter = new Herbaer::XMLDataWriter (
      $xml_options,
      "utf-8",
      "http://herbaer.de/xmlns/20170605/visits/"
   );
   $data -> {"xmlwriter"} = $xmlwriter;
   $xmlwriter -> open ($args -> {"detailed"});
   $xmlwriter -> open_element ("visits");
   $xmlwriter -> write ("time", "", time());

   my $dir = $args -> {"newlogs"};
   my $file;
   my $re = $args -> {"logsflt"};
   my $files = [];
   my $dh;
   if (! opendir ($dh, $dir)) {
      print STDERR "Kann Verzeichnis \"$dir\" nicht öffnen: \!\n" if $verbose;
      return;
   }
   while ($file = readdir ($dh)) {
      next if $file =~ /^\.\.?$/;
      push (@$files, $file) if ($file =~ $re);
   }
   closedir ($dh);
   $files = [sort @$files];
   $xmlwriter -> write ("accesslogfile", "", $files);
   for $file (@$files) {
      process_logfile ($data, $args, catfile ($dir, $file));
   }
   for $k ("first_time", "last_time",) {
      $xmlwriter -> write ("$k", "", $data -> {$k});
   }
   $xmlwriter -> close ();
   if ( $data -> {"numvisits"} -> {"total"} ) {
      print STDERR "Zusammenfassungen\n" if $verbose;
      $xmlwriter -> open ($args -> {"finished"});
      $xmlwriter -> open_element ("visits");
      $xmlwriter -> write ("time", "", time());
      my $k;
      for $k ("numvisits", "numstories", "numimages", "first_time", "last_time",) {
         $xmlwriter -> write ("$k", "", $data -> {$k});
      }
      $xmlwriter -> close ();
      if (%{$data -> {"open_visits"}}) {
         $xmlwriter -> open ($args -> {"openout"});
         $xmlwriter -> write ("visits", undef, $data -> {"open_visits"});
         $xmlwriter -> close ();
      }
   }
} # process_logs

# verarbeitet eine access-log-Datei
sub process_logfile {
   my ($data, $args, $logfile) = @_;
   my $verbose   = $args -> {"[cnt]verbose"};
   my $ov        = $data -> {"open_visits"};
   my $own       = $args -> {"own"};           # kennzeichnet Pfade von Selbstbesuche
   my $self      = $args -> {"ownmark"};       # UA-Markierung für Selbstbesuche
   my $storyflt  = $args -> {"storyidflt"};    # Filter für Story-Anfragen
   my $imageflt  = $args -> {"imageflt"};      # Filter für Bild-Anfragen
   my $langflt   = $args -> {"langflt"};       # Filter für die Kennung der Sprache
   my $rereplimg = $args -> {"rereplimg"};     # endet die Anzeige eines Bildes?
   my $exclua    = $args -> {"exclua"};        # Regex-Liste der ausgenommenen User Agents
   my $visit;
   my $file;                                   # Request-Pfad
   my $files;                                  # Hash der Files eines Besuchs
   my $images;                                 # Bilder eines Besuchs
   my $stories;                                # besuchte Stories eines Besuchs
   my $lang;                                   # Hash der Sprachen
   my $timeout   = $args -> {"timeout"} + 0;
   # Besuche mit einem letzten Zugriff vor endtime werden geschlossen.
   my $endtime;
   # Zeit des Zugriffs des vorhergehenden Eintrags
   my $last_time = $data -> {"last_time"} || 0;
   my $line;
   my ($k, $v);                                 # Schlüssel und Besuchsdaten
   print STDERR "Access-Log-Datei $logfile\n" if $verbose;
   my $gz = new IO::Uncompress::Gunzip ($logfile) or do {
      print STDERR "Kann Datei $logfile nicht öffnen:$!\n" if $verbose;
      return;
   };
   my $logfmt =                                 # combined log format mit Erweiterung
      '^(\S+)\s+(\S+)\s+(\S+)\s+' .
      '\[([^]]+)\]\s+'            .
      '"([^"]+)"\s+'              .
      '(\d+)\s+'                  .
      '(\d+|-)\s+'                .
      '"([^"]+)"\s+'              .
      '"([^"]+)"\s+'              .
      '(\.*)'                     ;
   my $xfmt = '^"Traffic\s+IN:(\d+)\sOUT:(\d+)"\s+"ReqTime:(\d+)sec"';
   my ($ip, $client, $user, $time, $request, $status, $size, $referer, $agent);
   my ($ext, $trfin, $trfout, $reqtime);
   my $isself;
   while ($line = <$gz>) {
      $line =~ /$logfmt/o or next;
      $ip      = $1;
      $time    = str2time($4);
      $request = $5;
      $status  = $6;
      $size    = $7;
      $referer = $8;
      $agent   = $9;
      $ext     = $10;
      if ($ext =~ /$xfmt/o) {
         $trfin   = $1;
         $trfout  = $2;
         $reqtime = $3;
      }
      else {
         $trfin   = undef;
         $trfout  = undef;
         $reqtime = undef;
      }
      if ($time > $last_time) {
         $endtime = $time - $timeout;
         while ( ($k, $v) = each %$ov ) {
            if ( $v -> {"last_access"} < $endtime ) {
               close_visit ($data, $args, $v);
               delete $ov -> {$k};
            }
         }
         $last_time = $time;
      }
      next if $agent eq "-";
      next if match_relist ($agent, $exclua);
      next unless $request =~ /^GET/o ;
      # 304 bedeutet "Daten nicht geändert"
      next unless 200 <= $status && $status < 400;
      $isself = $agent =~ s/$self// ? 1 : 0;
      $data -> {"first_time"} //= $time;
      $visit = ($ov -> {"$ip#$agent"} //= {
         "first_access" => $time,
         "ip"           => $ip,
         "agent"        => $agent,
      });
      if (
         ! $visit -> {"ref"}
         && $referer ne "-"
         && $referer !~ /^https?:\/\/kleider\.herbaer\.de/
      ) {
         $visit -> {"ref"} = $referer;
      }
      $visit ->  {"trfin"}   += $trfin   if $trfin;
      $visit ->  {"trfout"}  += $trfout  if $trfout;
      $visit ->  {"reqtime"} += $reqtime if $reqtime;
      $request =~ /^GET\s+([^ #]*)/o;
      $file = $1;
      ++ $visit -> {"files"} -> {$file};
      if ($verbose > 1) {
         print STDERR "FILE $file\n";
      }
      if ( $file =~ $own || $isself ) {
         ++ $visit -> {"own"};
      }
      elsif ( $file =~ $storyflt ) {
         ++ $visit -> {"stories"} -> {$1};
      }
      elsif ( $file =~ $imageflt ) {
         ++ $visit -> {"images"} -> {"$1/$2"};
      }
      elsif ( $file =~ $langflt ) {
         ++ $visit -> {"lang"} -> {$1};
      }
      $visit -> {"last_access"} = $time;
   };
   close ($gz);
   $data -> {"last_time"} = $last_time;
} # process_logfile

sub close_visit {
   my ($data, $args, $visit) = @_;
   if ($visit -> {"stories"} && $visit -> {"images"} && ! $visit -> {"own"}) {
      $data -> {"xmlwriter"} -> write ("visit", "", $visit);
      my ($k, $v, $l);
      my $langs = ["total", keys %{$visit -> {"lang"}}];
      my $numvisits = ($data -> {"numvisits"} //= {});
      for $l (@$langs) {
         ++ $numvisits -> {$l};
      }
      my $stories = ($data -> {"numstories"} //= {});
      while ( ($k, $v) = each (%{$visit -> {"stories"}}) ) {
         for $l (@$langs) {
            ++ $stories -> {$k} -> {$l};
         }
      }
      my $images = ($data -> {"numimages"} //= {});
      while ( ($k, $v) = each (%{$visit -> {"images"}}) ) {
         for $l (@$langs) {
            ++ $images -> {$k} -> {$l};
         }
      }
   }
} # close_visit
# end of file KLEIDER/web/src/favourites/logs.pl