ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/myhttpd/access.pl
Revision: 1.3
Committed: Sat Aug 11 16:34:46 2001 UTC (22 years, 11 months ago) by root
Content type: text/plain
Branch: MAIN
Changes since 1.2: +5 -0 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     sub conn::access_check {
33     my $self = shift;
34    
35     my $uri = $self->{path};
36     my %disallow;
37    
38     for (@blocklist) {
39     if ($uri =~ $_->[0]) {
40     $disallow{$_}++ for @{$_->[1]};
41     }
42     }
43    
44     my $whois = ::ip_request($self->{remote_addr});
45    
46     my $country = "XX";
47    
48     if ($whois =~ /^\*cy: (\S+)/m) {
49     $country = uc $1;
50     } else {
51     $self->slog(9, "no country($whois)");
52     }
53    
54 root 1.3 $self->{country} = $country;
55    
56 root 1.1 if ($disallow{$country}) {
57 root 1.2 $self->slog(6, "DISALLOW($uri,$country)");
58 root 1.3
59     Coro::Event::do_timer(after => 5);
60    
61 root 1.1 $whois =~ s/&/&amp;/g;
62     $whois =~ s/</&lt;/g;
63     $self->err(403, "forbidden", { "Content-Type" => "text/html" }, <<EOF);
64     <html>
65     <head>
66     <title>This material is licensed in your country!</title>
67     </head>
68     <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
69    
70     <h1>This material is licensed in your country!</h1>
71    
72     <p>My research has shown that your IP address
73     (<b>$self->{remote_addr}</b>) most probably is located in this country:
74     <b>$country</b> (ISO-3166-2 code, XX == unknown). The full record is:</p>
75    
76     <pre>
77     $whois
78     </pre>
79    
80     <p>My database says that the material you are trying to access is licensed
81     in your country. If I would distribute these files to your country I would
82     actively <em>hurt</em> the industry behind it, which includes the artists
83     and authors of these videos/mangas. So I hope you understand that I try to
84     avoid this.</p>
85    
86     <p>If you <em>really</em> think that this is wrong, i.e. the
87     material you tried to access is <em>not</em> licensed in your
88     country or your ip address was misdetected, you can write to <a
89     href="mailto:licensed\@plan9.de">licensed\@plan9.de</a>. Please explain
90     what happened and why you think this is wrong in as much detail as
91     possible.</p>
92    
93     <div align="right">Thanks a lot for understanding.</div>
94    
95     </body>
96     </html>
97     EOF
98     }
99     }
100    
101     1;