ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/myhttpd/access.pl
Revision: 1.5
Committed: Thu Aug 16 16:40:07 2001 UTC (22 years, 10 months ago) by root
Content type: text/plain
Branch: MAIN
Changes since 1.4: +5 -1 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1
2     our @blocklist;
3    
4     sub read_blocklist {
5     local *B;
6     my %group;
7     @blocklist = ();
8     if (open B, "<blocklist") {
9     while (<B>) {
10     chomp;
11     if (/^group\s+(\S+)\s+(.*)/i) {
12     $group{$1} = [split /\s+/, $2];
13     } elsif (/^!([^\t]*)\t\s*(.*)/) {
14     my $g = $1;
15     my @r;
16     for (split /\s+/, $2) {
17     push @r, $group{$_} ? @{$group{$_}} : $_;
18     }
19     print "not($g) => (@r)\n";
20     push @blocklist, [qr/$g/i, \@r];
21     } elsif (/\S/) {
22     print "blocklist: unparsable line: $_\n";
23     }
24     }
25     } else {
26     print "no blocklst\n";
27     }
28     }
29    
30     read_blocklist;
31    
32 root 1.5 use Tie::Cache;
33     tie %whois_cache, Tie::Cache::, $MAX_CONNECTS * 1.5;
34    
35 root 1.1 sub conn::access_check {
36     my $self = shift;
37    
38     my $uri = $self->{path};
39     my %disallow;
40    
41     for (@blocklist) {
42     if ($uri =~ $_->[0]) {
43     $disallow{$_}++ for @{$_->[1]};
44     }
45     }
46    
47 root 1.5 my $whois = $whois_cache{$self->{remote_addr}}
48     ||= ::ip_request($self->{remote_addr});
49 root 1.1
50     my $country = "XX";
51    
52     if ($whois =~ /^\*cy: (\S+)/m) {
53     $country = uc $1;
54     } else {
55     $self->slog(9, "no country($whois)");
56     }
57    
58 root 1.3 $self->{country} = $country;
59    
60 root 1.1 if ($disallow{$country}) {
61 root 1.2 $self->slog(6, "DISALLOW($uri,$country)");
62 root 1.3
63 root 1.1 $whois =~ s/&/&amp;/g;
64     $whois =~ s/</&lt;/g;
65     $self->err(403, "forbidden", { "Content-Type" => "text/html" }, <<EOF);
66     <html>
67     <head>
68     <title>This material is licensed in your country!</title>
69     </head>
70     <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
71    
72     <h1>This material is licensed in your country!</h1>
73    
74     <p>My research has shown that your IP address
75     (<b>$self->{remote_addr}</b>) most probably is located in this country:
76     <b>$country</b> (ISO-3166-2 code, XX == unknown). The full record is:</p>
77    
78     <pre>
79     $whois
80     </pre>
81    
82     <p>My database says that the material you are trying to access is licensed
83     in your country. If I would distribute these files to your country I would
84     actively <em>hurt</em> the industry behind it, which includes the artists
85     and authors of these videos/mangas. So I hope you understand that I try to
86     avoid this.</p>
87    
88     <p>If you <em>really</em> think that this is wrong, i.e. the
89     material you tried to access is <em>not</em> licensed in your
90     country or your ip address was misdetected, you can write to <a
91     href="mailto:licensed\@plan9.de">licensed\@plan9.de</a>. Please explain
92     what happened and why you think this is wrong in as much detail as
93     possible.</p>
94    
95     <div align="right">Thanks a lot for understanding.</div>
96    
97     </body>
98     </html>
99     EOF
100     }
101     }
102    
103     1;