User:Woodsstock/Blame

From Wikipedia, the free encyclopedia

Wikiblame[edit]

Here's a hack to find who put some nefarious text into an article. Please let me know if you have any comments or suggestions. 


#!/usr/bin/perl -w
# FILE: wiki-blame.pl
# AUTHOR: TotoBaggins on en.wikipedia.org
# 
# LICENSE: GPL
#
# DESCRIPTION: This program outputs a URL of the first revision of an article
# to contain a particular bit of text.  We only download log_2 N articles,
# so it's reasonably fast and kind to the servers.
# 
# USAGE:
#
#    ./wiki-blame.pl {article or history URL} {offending text}
#
# The URL must be url-encoded.
# The offending text should be quoted as a single argument.
# 
# EXAMPLES:
#
# Find which revision inserted some text at or before an old revision
# of the C++ article:
# 
#   ./wiki-blame.pl 'http://en.wikipedia.org/w/index.php?title=C%2B%2B&oldid=101608911' 'Evil Text'
#
#
# Find which revision inserted some text at or before the current revision
# of the C++ article:
#
#   ./wiki-blame.pl 'http://en.wikipedia.org/wiki/C%2B%2B' 'Evil Text'
#
# 
# BUGS:
#
# -- We only look back 2000 edits worth.
# -- We could be politer and faster if we stepped back through
#    history exponentially.
# -- We are too dependent on wikipedia.org's URL layout.
# 

use strict;
use LWP::UserAgent;
use HTML::Parser;
use HTML::LinkExtor;
use Carp;
use Data::Dumper;

my $WebAgent = LWP::UserAgent->new(keep_alive => 1);

sub get_page
{
    my $url = shift;
    my $response = $WebAgent->get($url);
    $response->is_success() or croak $response->status_line();
    return $response->content();
}

sub get_links
{
    my $url = shift;
    my $url_front = $url;
    $url_front =~ s,^([^/]+//[^/]+)/.*,$1,;
    my $page = get_page($url);
    my $linky = HTML::LinkExtor->new();
    $linky->utf8_mode(1);
    $linky->parse($page) or croak "Can't parse: $page";
    my @urls;
    foreach my $link ($linky->links())
    {
        my ($tag, %links) = @$link;
        my $url = $links{href} or next;
        push @urls, "$url_front$url";
    }
    return @urls;
}


use constant YES_MARKER => 100;
use constant NO_MARKER  => 0;

{
    my %MarkerCache;
    sub url_has_text
    {
        my ($url, $text) = @_;
        unless (defined $MarkerCache{$url})
        {
            my $page = get_page($url);
            use File::Slurp;
            $url =~ /oldid=(\d+)/;
            write_file("oldid-$1.html", $page);
            $MarkerCache{$url} = index($page, $text) >= 0
                                    ? YES_MARKER : NO_MARKER;
        }
        return $MarkerCache{$url};
    }
}

# This is from List::Search, which had a bug.  It can be
# removed when "List::Search::nlist_search(2, [2, 2, 2])" returns 0 and not 1
sub custom_list_search
{
    my ($cmp_code, $key, $array_ref) = @_;

    my $max_index = scalar(@$array_ref) - 1;

    my $low  = 0;
    my $mid  = undef;
    my $high = $max_index;
    my $lowest_match = undef;

    while ($low <= $high)
    {
        $mid = int($low + (($high - $low) / 2));
        my $mid_val = $array_ref->[$mid];

        my $cmp_result = $cmp_code->($key, $mid_val);

        if ($cmp_result > 0)
        {
            $low = $mid + 1;
        }
        else
        {
            if ($cmp_result == 0
                 && (!defined($lowest_match) || $lowest_match > $mid))
            {
                $lowest_match = $mid;
            }
            $high = $mid - 1;
        }
    }

    # Look at the values here and work out what to return.
    # Perhaps there are no matches in the array
    return -1 if $cmp_code->($key, $array_ref->[-1]) == 1;

    # Perhaps $mid is just before the best match
    return $mid + 1 if $cmp_code->($key, $array_ref->[$mid]) == 1;

    # $mid is correct
    return $mid;
}

sub snarf_history_urls
{
    my ($article_url, $limit) = @_;

    my $idx_url = $article_url;
    $idx_url =~ s/\&oldid=(\d+)$/\&action=history&limit=$limit/
        ||
    $idx_url =~ s,/wiki/(.+),/w/index.php?title=$1&limit=$limit&action=history,
        or die $idx_url;

    my @all_urls = get_links($idx_url);

    my @history_urls;
    foreach my $url (@all_urls)
    {
        # only old article urls
        next unless $url =~ m,/index.php\?title=[^&]+&oldid=\d+$,;

        push @history_urls, $url;
    }
    # make chronological
    @history_urls = reverse @history_urls;

    return @history_urls;
}

sub get_first_history_url
{
    my $url = shift;
    return $url if $url =~ /&oldid=\d/;
    my @history_urls = snarf_history_urls($url, 1);
    return $history_urls[0];
}

sub find_rev_that_added
{
    my ($offending_history_url, $offending_text) = @_;
    my $history_index_url = $offending_history_url;

    # FIXME: we limit it to 2000 urls to be kind to the wikiservers
    # We should really bite off pieces of history stepwise.
    my $max_urls = 2000;
    my @history_urls = snarf_history_urls($offending_history_url, $max_urls);

    $offending_history_url =~ /\&oldid=(\d+)/ or die $offending_history_url;
    my $offending_id = $1;

#     my %url2index;
    my $saw_offender;
    my @before_offender_urls;
    foreach my $url (@history_urls)
    {
#         $url2index{$url} = @before_offender_urls;
        push @before_offender_urls, $url;
        last if $url =~ /\&oldid=$offending_id\b/;
    }

    my $url2marker = sub {
        my ($key, $url) = @_;
        my $has_it = url_has_text($url, $offending_text);
        my $ret = $key <=> $has_it;
#         warn "has($has_it), ret($ret), u2i($url2index{$url}), $url\n";
        return $key <=> $has_it;
    };
    my $first_with = custom_list_search($url2marker, YES_MARKER,
                                        \@before_offender_urls);
    return unless $first_with >= 0;

    if ($first_with == $max_urls)
    {
        warn "Warning: It looks like that edit occurred further in "
             . "the past than I feel comfortable looking (beyond "
             . "$max_urls edits).\n";
        return;
    }

    return $before_offender_urls[$first_with];
}

@ARGV == 2 or die "usage: $0 {article or history URL} {offending text}\n";
my $url = shift;
my $offending_text = shift;

my $offending_history_url = get_first_history_url($url);

if (my $found_url = find_rev_that_added($offending_history_url,
                                        $offending_text))
{
    if ($found_url eq $offending_history_url)
    {
        print "No earlier revisions found.\n";
    }
    else
    {
        print "Earliest revision: $found_url\n";
    }
}
else
{
    print "Not found\n";
}

Retrieved from "https://en.wikipedia.org/w/index.php?title=User:Woodsstock/Blame&oldid=108853286"