Jump to content

User:HighInBC/MCP/NameWatcher

From Wikipedia, the free encyclopedia

This is a plugin, not a stand alone program. See here[1] for GFDL history prior to 02:54, June 4, 2007.

package HBCPlugins::NameWatcher;
use     strict;
use     Data::Dumper;
use     MediaWiki;
use     URI::Escape;
our     $self;

sub new
  {
  shift;
  $self = shift;
  bless($self);

  $self->{params}{version_number} = '1.0.2';
  $self->{params}{VERSION} = 'HBC NameWatcherBot v'.$self->{params}{version_number}; 
  warn $self->{params}{VERSION}." starting up.\n";
  $self->{params}{parameter_expected} =
   {
    'Status'                    => 1,
    'Default target'            => 1,
    'Long name'                 => 1,
    'Repeating character'       => 1,
    'Write rate'                => 1,
    'Recheck duration'          => 1,
    'Recheck interval'          => 1,
   };
  $self->{params}{parameter_required} =
   [
    'Status',
    'Default target',
   ];
  $self->{params}{default_params} =
   {
    'Write rate'                => 10,
    'Long name'         => 0,
    'Repeating character'       => 0,
   };

  $self->{params}{whitelist} = [];
  $self->{params}{blacklist} = [];
  $self->{params}{delayed_names} = {};
  
  &{$self->{shared}{add_job}}(\&contact_irc_plugin , 0);
  &{$self->{shared}{add_job}}(\&login,0);
  &{$self->{shared}{add_job}}(\&check_homoglyphs,2);
  &{$self->{shared}{add_job}}(\&check_parameters,2);
  &{$self->{shared}{add_job}}(\&check_whitelist,2);
  &{$self->{shared}{add_job}}(\&check_blacklist,2);
  &{$self->{shared}{add_job}}(\&debug_report,5);

  return $self;
  }

sub check_version {
  my ($active_version,$my_version) = @_;
  my @active_parts = split(/\./, $active_version);
  my @my_parts = split(/\./, $my_version);

  return 0 if scalar(@active_parts) > scalar(@my_parts); # should never happen

  foreach (@active_parts) {
    my $check_part = shift(@my_parts);
    last if $check_part > $_;
    next if $_ <= $check_part;
    return 0;
  }
  return 1;
}
                                  

sub send_info {
  my $type = shift;
  if ($self->{params}{send_info_to}) {
    my %payloads = (
     'client'    => $self->{WP_obj},
     'panel'     => $self->{params}{param},
     'blacklist' => $self->{params}{blacklist},
     'whitelist' => $self->{params}{whitelist}
    );
    foreach my $target (@{$self->{params}{send_info_to}}) {
      warn "Sending data to $target: $type\n";
      $self->{shared}{$target}->set_info($type, $payloads{$type});
    }
  }
}

sub login
  {
  warn "Connecting to Wikipedia...\n";
  my $c                  =   MediaWiki->new;
  $c->setup
                          ({
                            'bot' => {'user' => $self->{params}{username},'pass' => $self->{params}{password}},
                            'wiki' => {'host' => 'en.wikipedia.org','path' => 'w'}
                          }) || warn "Failed to log in\n";
  my $whoami              =  $c->user();
  warn "$whoami connected\n";
  $self->{WP_obj} = $c;
  send_info('client');
  &{$self->{shared}{add_job}}(\&login,3600);
  }

sub debug_report
  {
  warn Dumper
   ({
#    'Whitelist'        => $self->{params}{whitelist},
#    'Blacklist'        => $self->{params}{blacklist},
    'Params'    => $self->{params}{param},
    'Delayed'   => $self->{params}{delayed_names},
   });
  &{$self->{shared}{add_job}}([\&debug_report],300);
  }

sub contact_irc_plugin
  {
  $self->{IRCFeed} = $self->{shared}{$self->{params}{irc_label}} || die;
  $self->{IRCFeed}->add_hook
   ({
     'check'    => sub
        {
        my $text = shift;
        my $pattern = chr(0x03).'03(.*?)'.chr(0x03);
        my $createpattern = chr(0x03).'4\s*create'.chr(0x03);
        if (($text =~ m|$createpattern|) && ($text =~ m"$pattern"))
          {
          return $1;
          }
        else
          {
          return 0;
          }
        },
     'callback' => \&check_name,
    }
   );
  $self->{IRCFeed}->add_hook
   ({
     'check'    => sub {$_[0] =~ m|User:HBC NameWatcherBot/Control panel|},
     'callback' => \&check_parameters,
    }
   );
  $self->{IRCFeed}->add_hook
   ({
     'check'    => sub {$_[0] =~ m|User:HBC NameWatcherBot/Whitelist|},
     'callback' => \&check_whitelist,
    }
   );
  $self->{IRCFeed}->add_hook
   ({
     'check'    => sub {$_[0] =~ m|User:HBC NameWatcherBot/Blacklist|},
     'callback' => \&check_blacklist,
    }
   );
  return;
  }

sub check_parameters
  {
  warn "Checking parameters...\n";
  my $page = $self->{WP_obj}->get('User:HBC NameWatcherBot/Control panel','r')->content();
  %{$self->{params}{param}} = ();
  foreach my $line (split("\n",$page))
    {
    if ($line =~ m|^;(.*?):(.*)$|)
      {
      $self->{params}{param}{$1} = $2 if ($self->{params}{parameter_expected}{$1});
      }
    }
  die "Bot is not turned on in the control panel\n" unless (lc($self->{params}{param}{'Status'}) eq 'on');
  foreach my $key (@{$self->{params}{parameter_required}})
    {
    die "Missing required parameter: $key\n" unless ($self->{params}{param}{$key});
    }
  %{$self->{params}{param}} = (%{$self->{params}{default_params}},%{$self->{params}{param}});
  send_info('panel');
  }

sub check_homoglyphs {
  warn "Checking homoglyphs...\n";
  my $page = $self->{WP_obj}->get('User:HBC_NameWatcherBot/Homoglyphs','r')->content();
  utf8::upgrade($page);
  @{$self->{params}{homoglyphs}} = ();
  foreach my $line (split("\n",$page)) {
    next unless ($line =~ m|^;(.+?):\s*(.+)$|);
    my $symbol = $1;
    my @matches = split(/\s+/,$2);
    for (@matches) {$_ = quotemeta($_)};
    push (@{$self->{params}{homoglyphs}}, $symbol, \@matches)
  }
}

sub check_whitelist
  {
  warn "Checking whitelist...\n";
  my $page = $self->{WP_obj}->get('User:HBC NameWatcherBot/Whitelist','r')->content();
  @{$self->{params}{whitelist}} = ();
  foreach my $line (split("\n",$page))
    {
    push(@{$self->{params}{whitelist}},$1) if ($line =~ m|^;(.*)$|);
    }
  send_info('whitelist');
  }

sub check_blacklist
  {
  warn "Checking blacklist...\n";
  my $page = $self->{WP_obj}->get('User:HBC NameWatcherBot/Blacklist','r')->content();
  @{$self->{params}{blacklist}} = ();
  foreach my $line (split("\n",$page))
    {
    if ($line =~ m|^;(.*?)(:(.*))?$|)
      {
      my $rh_entry = {};
      ${$rh_entry}{word} = $1;
      if ($2)
        {
        my @flags = split(',',$3);
        ${$rh_entry}{flags} = parse_flags(\@flags);
        }
      if (${$rh_entry}{'flags'}{'HOMOGLYPH'}) {
        my $hg_regex = compile_homoglyph_pattern(${$rh_entry}{'word'});
        ${$rh_entry}{'flags'}{'LABEL'}[0] = ('Homoglyph of: "'.${$rh_entry}{'word'}.'"');
        ${$rh_entry}{'flags'}{'REGEX'} = 1;
        ${$rh_entry}{'word'} = $hg_regex;
      }
      push(@{$self->{params}{blacklist}},$rh_entry);
      }
    }
  send_info('blacklist');
  }

sub parse_flags
  {
  my $ra_flags = shift;
  my %has_flag;
  foreach my $flag (@{$ra_flags})
    {
    if ($flag =~ m|(.*)\((.*)\)|)
      {
      my (@params) = split('\|',$2);
      $has_flag{$1} = \@params;
      }
    else
      {
      $has_flag{$flag} = 1
      }
    }
  return \%has_flag;
  }

sub check_name
  {
  shift;
  my($name) = shift;
  my $display_name = "'$name'";
  my $master_name = $name;
  warn "Checking name: $display_name\n";
  foreach my $white_word (@{$self->{params}{whitelist}}) {$name =~ s|$white_word||gi;} # Remove occurances of whitelisted words
  my $ra_offenses = [];
  foreach my $rh_black_word (@{$self->{params}{blacklist}})
    {
    my $word = ${$rh_black_word}{word};
    if (${$rh_black_word}{flags}{'REGEX'})
      {
      if (${$rh_black_word}{flags}{'CASE_SENSITIVE'})
        {
        push(@{$ra_offenses},$rh_black_word) if ($name =~ m|$word|);
        }
      else
        {
        push(@{$ra_offenses},$rh_black_word) if ($name =~ m|$word|i);
        }
      }
    else
      {
      if (${$rh_black_word}{flags}{'CASE_SENSITIVE'})
        {
        push(@{$ra_offenses},$rh_black_word) if (index($name,$word) > -1);
        }
      else
        {
        push(@{$ra_offenses},$rh_black_word) if (index(lc($name),lc($word)) > -1);
        }
      }
    }
  &{$self->{shared}{add_job}}([\&bad_name,$master_name,$ra_offenses],0) if
        (
         scalar(@{$ra_offenses}) ||
         (($self->{params}{param}{'Long name'}) && (length($name) > $self->{params}{param}{'Long name'})) ||
         (($self->{params}{param}{'Repeating characters'}) && (detect_repeatition($name,$self->{params}{param}{'Repeating characters'}))) ||
         (($self->{params}{param}{'Repeating numbers'}) && (detect_repeatition_numbers($name,$self->{params}{param}{'Repeating numbers'})))
        );
  return 1;
  }

sub bad_name
  {
  my ($name, $ra_offenses) = @_;
  my(@offense_reports) = ('* {{user-uaa|1='.$name.'}}');
  my $need_rechecking = 0; # default no reason to report
  my $need_header = 0;
  my $has_edited = user_has_edited($name);
  my $is_blocked = is_blocked($name);
  my $target_page = $self->{params}{param}{'Default target'};
  push(@offense_reports,':* This user has edited at least one time.') if ($has_edited);
  if (($self->{params}{param}{'Long name'}) && (length($name) > $self->{params}{param}{'Long name'}))
    {
    push(@offense_reports, ":* At ".length($name)." characters, this name exceeds ".$self->{params}{param}{'Long name'}." characters");
    }
  if (($self->{params}{param}{'Repeating characters'}) && (my $char = detect_repeatition($name,$self->{params}{param}{'Repeating characters'})))
    {
    push(@offense_reports, ":* This name has the character \"'''".$char."'''\" repeating ".$self->{params}{param}{'Repeating characters'}." or more than times in a row.");
    }
  if (($self->{params}{param}{'Repeating numbers'}) && (detect_repeatition_numbers($name,$self->{params}{param}{'Repeating numbers'})))
    {
    push(@offense_reports, ":* This name has ".$self->{params}{param}{'Repeating numbers'}." or more numbers in a row.");
    }
  foreach my $rh_blackword (@{$ra_offenses})
    {
    my $rh_has_flag = ${$rh_blackword}{flags};
    my $label = ((${$rh_has_flag}{'LABEL'}) ? ("called '''".${${$rh_has_flag}{'LABEL'}}[0]."'''") : ("'''${$rh_blackword}{word}'''"));
    my $name_pattern = '('.${$rh_blackword}{word}.')';
    my $match;
    if (${$rh_has_flag}{'CASE_SENSITIVE'})
      {
      $name =~ m|$name_pattern|;
      $match = " The portion that matched was '''$1'''." if ($1);
      }
    else
      {
      $name =~ m|$name_pattern|i;
      $match = " The portion that matched was '''$1'''." if ($1);
      }
    my(@report) = (((${$rh_has_flag}{'REGEX'}) ? (":* Matches the regular expression $label.$match") : (":* Matches the literal pattern $label.")));
    if (${$rh_has_flag}{'CASE_SENSITIVE'}) {
      push (@report, "::* This filter is case sensitive.");
    }
    if (${$rh_has_flag}{'WAIT_TILL_EDIT'})
      {
      if ($has_edited)
        {
        push (@report, "::* This report was delayed until the user edited.");
        delete(${$self->{params}{param}{delayed_names}}{$name});
        }
      else
        {
        warn "\t$name has not edited, not counting match to the string $label at this point, rechecking in ".$self->{params}{param}{'Recheck interval'}." seconds.\n";
        $need_rechecking = 1 unless (scalar(@offense_reports) > 1);
        next;
        }
      }
    if (${$rh_has_flag}{'HOMOGLYPH'}) {
      push (@report, "::* This filter attempts to see past the use of similar looking characters and creative substitutions, see [[Homoglyphs]].");
    }
    $need_rechecking = 0;
    warn Dumper
     ({
      'Name'    => $name,
      'Flags'   => $rh_has_flag,
      'Word'    => ${$rh_blackword}{'word'},
     });
    if  (${$rh_has_flag}{'HTTP_CHECK'})
      {
      warn "Gotta check '$name' for http server.\n";
      my $code = $self->{WP_obj}->{ua}->head('http://'.$name)->code();
      if (($code == 500) && (ref(${$rh_has_flag}{'HTTP_CHECK'})) && (lc(${${$rh_has_flag}{'HTTP_CHECK'}}[0]) eq 'ignore_fail'))
        {
        warn "Ignoring failed connection.\n";
        return;
        }
      my $info = '';
      if        ($code =~ m|^2..$|)
        {
        $info = "A response code starting in 2 means '''HTTP server found, succesful request'''.";
        }
      elsif     ($code =~ m|^3..$|)
        {
        $info = "A response code starting in 3 means '''HTTP server found, client redirected'''.";
        }
      elsif     ($code =~ m|^4..$|)
        {
        $info = "A response code starting in 4 means '''HTTP server found, HTTP server gave error'''.";
        }
      elsif     ($code =~ m|^5..$|)
        {
        $info = "A response code starting in 5 means '''HTTP server not found'''.";
        }
      push (@report, "::* When using the name '''$name([http://$name link])''' as a http URL I got a response code of '''$code'''.".$info);
      }
    if  (${$rh_has_flag}{'ALTERNATE_TARGET'})
      {
      $target_page = ${${$rh_has_flag}{'ALTERNATE_TARGET'}}[0];
      warn "Alternate target: $target_page\n";
      }
    if  (${$rh_has_flag}{'USE_HEADER'})
      {
      $need_header = 1;
      }
    if  (${$rh_has_flag}{'LOW_CONFIDENCE'})
      {
      push (@report, "::* The string $label is prone to false positives, please take extra care ensuring this name is actually a violation before blocking.");
      }
    if  (${$rh_has_flag}{'NOTE'})
      {
      push (@report, "::* The string $label has a comment associated with it: ".${${$rh_has_flag}{'NOTE'}}[0]);
      }
    if  (${$rh_has_flag}{'SOCK_PUPPET'})
      {
      push (@report, "::* The string $label is often associate with sock puppets of [[User:".${${$rh_has_flag}{'SOCK_PUPPET'}}[0]."]] {{#ifexist:Category:Suspected Wikipedia sockpuppets of ".${${$rh_has_flag}{'SOCK_PUPPET'}}[0]."|(see [[:Category:Suspected Wikipedia sockpuppets of ".${${$rh_has_flag}{'SOCK_PUPPET'}}[0]."]])}}");
      }
    push (@offense_reports,@report);
    }
  if ($need_rechecking)
    {
    ${$self->{params}{param}{delayed_names}}{$name} ||= time();
    my $report_age = (time() - ${$self->{params}{param}{delayed_names}}{$name});
    if (($report_age > $self->{params}{param}{'Recheck duration'}) || ($is_blocked))
      {
      warn "Forgetting about $name, it has been $report_age seconds since creation and no edits.\n";
      warn "\tThe user is blocked you see.\n" if ($is_blocked);
      delete(${$self->{params}{param}{delayed_names}}{$name});
      }
    else
      {
      warn "Scheduling recheck of $name\n";
      &{$self->{shared}{add_job}}([\&check_name,$name,$name],$self->{params}{param}{'Recheck interval'});
      }
    return 1;
    }
  unshift(@offense_reports, "== Account [[User:$name]] created ==") if $need_header;
  my $report = (join("\n",@offense_reports)." ~~~~\n");
  warn "Writing to: $target_page\n";
  my $page = $self->{WP_obj}->get($target_page, 'rw');
  if (($page->content() =~ m|<\!-- HBC NameWatcherBot v(\d+\.\d+\.\d+) allowed -->|) && !($is_blocked))
    {
    my $version_number_needed = $1;
    unless (check_version($version_number_needed,$self->{params}{version_number})) {
      warn "I need $version_number_needed and my version is ".$self->{params}{version_number}.".\n";
      warn "I am too old to edit this page.\n";
      return;
    }
    while ($page->{'content'} !~ m|\n\n$|) {$page->{'content'} = $page->{'content'}."\n";}
    $page->{'content'} = ($page->{'content'}.$report);
    $page->{'summary'} = "Reporting [[Special:Contributions/$name|$name]] ([[Special:Blockip/$name|block]]).";
    $page->save();
    warn ($page->{'summary'}."\n");
#    warn ($page->{'content'}."\n\n\n");
    sleep($self->{params}{param}{'Write rate'});
    warn "\n";
    }
  elsif ($is_blocked)
    {
    warn "Skipping, user is already blocked.\n";
    }
  else
    {
    warn "I don't have permission to write to '$target_page'\n";
    return;
    }
  }

sub user_has_edited
{
    my ($name) = @_;
    my $url = 'http://en.wikipedia.org/w/api.php?action=query&list=usercontribs&format=xml&ucuser='.uri_escape($name);
    my $data = $self->{WP_obj}->{ua}->get($url)->content();
    if (!$data || $data =~ m|<usercontribs\s*/>|) {
        # blank XML container, no contribs, return zero
        return 0;
    } else {
        return 1;
    }
}

sub is_blocked
  {
  my ($name) = @_;
  my $url = $self->{WP_obj}->{index}.'?title=Special:Ipblocklist&ip='.uri_escape($name);
  my $data = $self->{WP_obj}->{ua}->get($url)->content(); # Get blocklist info for user
  return ($data =~ m|</a>\) blocked <a href|)       # If the user is currently blocked
  }

sub detect_repeatition
  {
  my $string = shift;
  my $limit = shift;
  my $last_char;
  my $current_rep = 1;
  while (my $char = substr($string,0,1,''))
    {
    if ($char eq $last_char)
      {
      $current_rep++;
      }
    else
      {
      $last_char = $char;
      $current_rep = 1;
      }
    return $char if ($current_rep >= $limit);
    }
  return 0;
  }

sub detect_repeatition_numbers
  {
  my $string = shift;
  my $limit = shift;
  my $last_char;
  my $current_rep = 1;
  while (my $char = substr($string,0,1,''))
    {
    if ($char =~ m|^[0-9]$|)
      {
      $current_rep++;
      }
    else
      {
      $current_rep = 0;
      }
    return 1 if ($current_rep >= $limit);
    }
  return 0;
  }

sub compile_homoglyph_pattern {
  my $target_pattern = shift;
  my @homoglyphs = @{$self->{params}{homoglyphs}};
  while (scalar(@homoglyphs)) {
    my ($str, $ra_values) =  (shift(@homoglyphs),shift(@homoglyphs));
    next unless (scalar(@{$ra_values}));
    my $pattern = ('('.join('|', $str,@{$ra_values}).')');
    $target_pattern =~ s"$str"$pattern"ig; #"
  }
  return $target_pattern;
}

1;