# Copyright (C) 2005, 2009 Alex Schroeder # # 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. # # 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 General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . use strict; use v5.10; AddModuleDescription('big-brother.pl', 'Big Brother Extension'); our ($q, $Now, %Action, $SurgeProtectionViews, $SurgeProtectionTime, @MyAdminCode, $RCName, $VisitorFile, $FS); our ($VisitorTime, @BigBrotherSecretParameters); my $US = "\x1f"; $VisitorTime = 7200; # keep visitor data arround for 2 hours. # normal password parameter from wiki.pl # password parameters from login.pl @BigBrotherSecretParameters = qw(pwd pwd1 pwd2 oldpwd); push(@MyAdminCode, \&BigBrotherVisitors); sub BigBrotherVisitors { my ($id, $menuref, $restref) = @_; push(@$menuref, ScriptLink('action=visitors', Ts('Recent Visitors'), 'visitors')); } my %BigBrotherData; # replace the subs that DoSurgeProtection calls: # ReadRecentVisitors(); # AddRecentVisitor($name); # WriteRecentVisitors(); # if ($SurgeProtection and DelayRequired($name)) sub AddRecentVisitor { my ($name) = shift; my $value = $BigBrotherData{$name}; my %entries = $value ? %{$value} : (); # make sure we don't ignore hits in the same second my $ts = $Now; $ts++ while $entries{$ts}; my $action = GetParam('action', 'browse'); my $id = GetId(); # script/p/q -> q my %params = map { $_ => 1 } $q->param; for my $bad (@BigBrotherSecretParameters) { delete $params{$bad}; } my $url = ScriptUrl(join(';', "action=$action;id=" . UrlEncode($id), map { $_ . '=' . UrlEncode(GetParam($_)) } keys %params)); my $download = GetParam('action', 'browse') eq 'download' || GetParam('download', 0) || $q->path_info() =~ m/\/download\//; if ($download) { # do nothing } elsif ($id) { $entries{$ts} = $id . $US . $url; } elsif ($action eq 'rss' or $action eq 'rc') { $entries{$ts} = $RCName . $US . $url; } else { $entries{$ts} = T('some action') . $US . $url; } $BigBrotherData{$name} = \%entries; } sub DelayRequired { my $name = shift; return 0 unless $BigBrotherData{$name}; my %entries = %{$BigBrotherData{$name}}; my @times = sort keys %entries; return 0 if not $times[$SurgeProtectionViews - 1]; # all slots must be filled return 0 if ($Now - $times[0]) > $SurgeProtectionTime; return 1; } sub ReadRecentVisitors { my ($status, $data) = ReadFile($VisitorFile); %BigBrotherData = (); return unless $status; foreach (split(/\n/,$data)) { my ($name, %entries) = split /$FS/; $BigBrotherData{$name} = \%entries if $name and %entries; } } sub WriteRecentVisitors { my $data = ''; my $limit = $Now - $VisitorTime; # don't save visits older than this foreach my $name (keys %BigBrotherData) { my %entries = %{$BigBrotherData{$name}}; my @times = sort keys %entries; # strip entries older than the older visits while (@times and $times[0] < $limit) { splice(@times, 0, 1); } # if we still have more than the number of elements required for # surge protection, delete these as well @times = @times[-$SurgeProtectionViews .. -1] if @times > $SurgeProtectionViews; $data .= join($FS, $name, map { $_, $entries{$_}} @times) . "\n" if @times; } WriteStringToFile($VisitorFile, $data); } $Action{visitors} = \&DoBigBrother; sub DoBigBrother { # no caching of this page! print GetHeader('', T('Recent Visitors'), '', 1), $q->start_div({-class=>'content visitors'}); ReadRecentVisitors(); print '

' . $q->end_div(); PrintFooter(); }