view release on metacpan or  search on metacpan

lib/App/Phoebe/SpeedBump.pm  view on Meta::CPAN

  $speed_data->{$ip}->{seconds} = $seconds;
  $speed_data->{$ip}->{until} = $now + $seconds;
  $speed_data->{$ip}->{probation} = $now + 2 * $seconds;
  return $seconds if $seconds < 2419200;
  # finally, check if there are enough other IPs in the same network to warrant a net range block
  $speed_data->{$ip}->{cidr} ||= speed_bump_cidr($ip, $now);
  my $cidr = $speed_data->{$ip}->{cidr};
  if ($cidr) {
    my $count = 0;
    for (keys %$speed_data) {
      $count++ if exists $speed_data->{$_}->{cidr} and $speed_data->{$_}->{cidr} eq $cidr;
    }
    speed_bump_add_cidr($cidr, $now + $seconds) if $count >= 3;
  }
  return $seconds;
}

sub speed_bump_add_cidr {
  my $cidr = shift;
  my $until = shift;
  $log->info("Blocking CIDR $cidr");
  $speed_cidr_data->{$cidr} = $until;
}

# load on startup
Mojo::IOLoop->next_tick(sub {
  my $dir = $server->{wiki_dir};
  return unless -f "$dir/speed-bump.json";
  my $bytes = read_binary("$dir/speed-bump.json");
  $speed_data = decode_json $bytes;
  speed_bump_compute_cidr_blocks() });

# save every half hour
Mojo::IOLoop->recurring(1800 => sub {
  my $bytes = encode_json $speed_data;
  my $dir = $server->{wiki_dir};
  write_binary("$dir/speed-bump.json", $bytes) });

sub speed_bump_admin {
  my $stream = shift;
  my $url = shift;
  my $hosts = host_regex();
  my $port = port($stream);
  if ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump$!) {
    success($stream);
    $stream->write("# Speed Bump\n");
    $stream->write("Administer the block lists from this menu.\n");
    $stream->write("=> /do/speed-bump/status status\n");
    $stream->write("=> /do/speed-bump/debug debug\n");
    $stream->write("=> /do/speed-bump/save save\n");
    $stream->write("=> /do/speed-bump/load load\n");
    $stream->write("=> /do/speed-bump/reset reset\n");
    return 1;
  } elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump/status$!) {
    with_speed_bump_fingerprint($stream, sub {
      success($stream);
      speed_bump_status($stream) });
    return 1;
  } elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump/debug$!) {
    with_speed_bump_fingerprint($stream, sub {
      success($stream, 'text/plain; charset=UTF-8');
      use Data::Dumper;
      $stream->write(Dumper($speed_data)) });
    return 1;
  } elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump/save$!) {
    with_speed_bump_fingerprint($stream, sub {
      success($stream);
      my $bytes = encode_json $speed_data;
      my $dir = $server->{wiki_dir};
      write_binary("$dir/speed-bump.json", $bytes);
      $stream->write("# Speed Bump Saved\n");
      $stream->write("=> /do/speed-bump menu\n") });
    return 1;
  } elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump/load$!) {
    with_speed_bump_fingerprint($stream, sub {
      success($stream);
      my $dir = $server->{wiki_dir};
      my $bytes = read_binary("$dir/speed-bump.json");
      $speed_data = decode_json $bytes;
      speed_bump_compute_cidr_blocks();
      $stream->write("# Speed Bump Loaded\n");
      $stream->write("=> /do/speed-bump menu\n") });
    return 1;
  } elsif ($url =~ m!^gemini://(?:$hosts)(?::$port)?/do/speed-bump/reset$!) {
    with_speed_bump_fingerprint($stream, sub {
      $speed_data = undef;
      success($stream);
      $stream->write("# Speed Bump Reset\n");
      $stream->write("The speed bump data has been reset.\n");
      $stream->write("=> /do/speed-bump menu\n") });
    return 1;
  }
  return;
}

sub speed_bump_compute_cidr_blocks {
  my %count;
  my %until;
  # check which CIDR has been blocked at least three times
  for my $ip (keys %$speed_data) {
    my $cidr = $speed_data->{$ip}->{cidr};
    next unless $cidr;
    $count{$cidr}++;
    $until{$cidr} ||= $speed_data->{$ip}->{until};
    $until{$cidr} = $speed_data->{$ip}->{until}
      if $speed_data->{$ip}->{until} and $speed_data->{$ip}->{until} > $until{$cidr};
  }
  # only copy the blocked-until timestamp for those CIDRs that were listed at least three times
  for my $cidr (keys %count) {
    next unless $count{$cidr} >= 3;
    speed_bump_add_cidr($cidr, $until{$cidr});
  }
}

sub with_speed_bump_fingerprint {
  my $stream = shift;
  my $fun = shift;
  my $fingerprint = $stream->handle->get_fingerprint();
  if ($fingerprint and grep { $_ eq $fingerprint} @known_fingerprints) {
    $fun->();
  } elsif ($fingerprint) {