--- Coro/myhttpd/access.pl 2001/08/16 16:40:07 1.5 +++ Coro/myhttpd/access.pl 2001/08/19 23:57:52 1.6 @@ -1,11 +1,12 @@ -our @blocklist; +our @blockuri; +our @blockref; -sub read_blocklist { +sub read_blockuri { local *B; my %group; - @blocklist = (); - if (open B, ") { chomp; if (/^group\s+(\S+)\s+(.*)/i) { @@ -17,52 +18,46 @@ push @r, $group{$_} ? @{$group{$_}} : $_; } print "not($g) => (@r)\n"; - push @blocklist, [qr/$g/i, \@r]; + push @blockuri, [qr/$g/i, \@r]; } elsif (/\S/) { - print "blocklist: unparsable line: $_\n"; + print "blockuri: unparsable line: $_\n"; } } } else { - print "no blocklst\n"; + print "no blockuri\n"; } } -read_blocklist; - -use Tie::Cache; -tie %whois_cache, Tie::Cache::, $MAX_CONNECTS * 1.5; - -sub conn::access_check { - my $self = shift; - - my $uri = $self->{path}; - my %disallow; - - for (@blocklist) { - if ($uri =~ $_->[0]) { - $disallow{$_}++ for @{$_->[1]}; +sub read_blockref { + local *B; + @blockref = (); + if (open B, ") { + chomp; + if (/^([^\t]*)\t\s*(.*)/) { + push @blockref, qr/^$1/i; + } elsif (/\S/) { + print "blockref: unparsable line: $_\n"; + } } - } - - my $whois = $whois_cache{$self->{remote_addr}} - ||= ::ip_request($self->{remote_addr}); - - my $country = "XX"; - - if ($whois =~ /^\*cy: (\S+)/m) { - $country = uc $1; } else { - $self->slog(9, "no country($whois)"); + print "no blockref\n"; } +} - $self->{country} = $country; +read_blockuri; +read_blockref; - if ($disallow{$country}) { - $self->slog(6, "DISALLOW($uri,$country)"); +use Tie::Cache; +tie %whois_cache, Tie::Cache::, $MAX_CONNECTS * 1.5; - $whois =~ s/&/&/g; - $whois =~ s/err(403, "forbidden", { "Content-Type" => "text/html" }, <err(403, "forbidden", { "Content-Type" => "text/html" }, < This material is licensed in your country! @@ -73,7 +68,7 @@

My research has shown that your IP address ($self->{remote_addr}) most probably is located in this country: -$country (ISO-3166-2 code, XX == unknown). The full record is:

+$self->{country} (ISO-3166-2 code, XX == unknown). The full record is:

 $whois
@@ -97,6 +92,85 @@
 
 
 EOF
+}
+
+sub conn::err_block_referer {
+   my $self = shift;
+
+   my $uri = $self->{uri};
+   $uri =~ s/\/[^\/]+$/\//;
+   $uri = escape_uri $uri;
+   print "hiho $uri\n";#d#
+
+   $self->slog(6, "REFERER($self->{uri},$self->{h}{referer})");
+
+   $whois =~ s/&/&/g;
+   $whois =~ s/err(203, "non-authoritative", { "Content-Type" => "text/html" }, <
+
+Unallowed Referral
+
+
+
+
The site which referred you has done something bad!

+
+
It seems that you are coming from this URL:

+
+
$self->{h}{referer}

+
+
This site has been blocked, either because it required you to pay
+money, forced you to click on banners, claimed these files were theirs
+or something very similar. Please note that you can download these files
+without having to pay, without clicking banners or jump
+through other hoops.

+
+
Sites like the one you came from actively hurt the distribution of
+these files and the service quality for you since I can't move or correct
+files and you will likely not be able to see the full archive.

+
+
Having that this, you can find the original content (if it is still
+there) by following this link.

+
+
Thanks a lot for understanding.

+
+
+
+EOF
+}
+
+sub conn::access_check {
+   my $self = shift;
+
+   my $ref = $self->{h}{referer};
+   my $uri = $self->{path};
+   my %disallow;
+
+   for (@blockref) {
+      $self->err_block_referer if $ref =~ $_;
+   }
+
+   for (@blockuri) {
+      if ($uri =~ $_->[0]) {
+         $disallow{$_}++ for @{$_->[1]};
+      }
+   }
+   
+   my $whois = $whois_cache{$self->{remote_addr}}
+               ||= ::ip_request($self->{remote_addr});
+
+   my $country = "XX";
+
+   if ($whois =~ /^\*cy: (\S+)/m) {
+      $country = uc $1;
+   } else {
+      $self->slog(9, "no country($whois)");
+   }
+
+   $self->{country} = $country;
+
+   if ($disallow{$country}) {
+      $self->err_block_country($whois);
    }
 }