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