ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/myhttpd/err.pl
Revision: 1.7
Committed: Sun May 19 21:00:47 2002 UTC (22 years, 1 month ago) by root
Content type: text/plain
Branch: MAIN
CVS Tags: rel-2_5, rel-4_0, rel-3_41, rel-4_11, rel-3_55, rel-3_51, rel-4_01, rel-4_03, rel-4_02, rel-2_0, rel-2_1, rel-1_1, rel-1_0, rel-1_9, rel-1_2, rel-3_6, rel-3_62, rel-3_63, rel-3_61, rel-1_5, rel-1_4, rel-1_7, rel-1_6, rel-3_4, rel-3_1, rel-3_5, rel-3_3, rel-3_2, rel-3_0, rel-3_01, rel-3_11, rel-1_31, rel-4_1, stack_sharing, rel-3_501
Changes since 1.6: +2 -14 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 use HTTP::Date;
2    
3     use Coro::Event;
4    
5     sub conn::err_block_country {
6     my $self = shift;
7     my $whois = shift;
8    
9     $whois =~ s/&/&/g;
10     $whois =~ s/</&lt;/g;
11     $self->err(403, "forbidden", { "Content-Type" => "text/html", Connection => "close" }, <<EOF);
12     <html>
13     <head>
14     <title>This material is licensed in your country!</title>
15     </head>
16     <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
17    
18     <h1>This material is licensed in your country!</h1>
19    
20     <p>My research has shown that your IP address
21     (<b>$self->{remote_addr}</b>) most probably is located in this country:
22     <b>$self->{country}</b> (ISO-3166-2 code, XX == unknown). The full record is:</p>
23    
24     <pre>
25     $whois
26     </pre>
27    
28     <p>My database says that the material you are trying to access is licensed
29     in your country. If I would distribute these files to your country I would
30     actively <em>hurt</em> the industry behind it, which includes the artists
31     and authors of these videos/mangas. So I hope you understand that I try to
32     avoid this.</p>
33    
34     <div align="right">Thanks a lot for understanding.</div>
35    
36     </body>
37     </html>
38     EOF
39     }
40    
41     sub conn::err_block_referer {
42     my $self = shift;
43    
44     my $uri = $self->{uri};
45     $uri =~ s/\/[^\/]+$/\//;
46    
47     $self->slog(6, "REFERER($self->{uri},$self->{h}{referer})");
48    
49     $whois =~ s/&/&amp;/g;
50     $whois =~ s/</&lt;/g;
51     $self->err(203, "non-authoritative", { "Content-Type" => "text/html" }, <<EOF);
52     <html>
53     <head>
54     <title>Unallowed Referral</title>
55     </head>
56     <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
57    
58     <h1>The site which referred you has done something bad!</h1>
59    
60     <p>It seems that you are coming from this URL:</p>
61    
62     <pre>$self->{h}{referer}</pre>
63    
64     <p>This site has been blocked, either because it required you to pay
65     money, forced you to click on banners, claimed these files were theirs
66     or something very similar. Please note that you can download these files
67     <em>without</em> having to pay, <em>without</em> clicking banners or jump
68     through other hoops.</p>
69    
70     <p><b>Sites like the one you came from actively hurt the distribution of
71     these files and the service quality for you since I can't move or correct
72     files and you will likely not be able to see the full archive.</b></p>
73    
74     <p>Having that this, you can find the original content (if it is still
75     there) by <b>following <a href="$uri">this link</a>.</b></p>
76    
77     <div align="right">Thanks a lot for understanding.</div>
78    
79     </body>
80     </html>
81     EOF
82     }
83    
84     sub conn::err_blocked {
85     my $self = shift;
86 root 1.4 my $id = $self->{remote_id};
87 root 1.5 my $block = $conn::blocked{$id};
88    
89     $block->[2]++;
90    
91     if ($block->[0] < $::NOW + $::BLOCKTIME) {
92     $block->[0] = $::NOW + $::BLOCKTIME;
93     }
94    
95     my $status = 403;
96     my $hdr = {
97     "Content-Type" => "text/html",
98     "Retry-After" => $block->[0] - $::NOW,
99     "Connection" => "close",
100     };
101    
102 root 1.2 my $ctime = $HTTP_NOW;
103 root 1.5 my $etime = time2str $block->[0];
104    
105     my $limit = $block->[3];
106     $block->[3] = $::NOW + 10;
107 root 1.1
108 root 1.5 if ($limit > $::NOW) {
109     Coro::Event::do_timer(after => $limit - $::NOW);
110 root 1.1
111 root 1.5 if ($block->[2] > 30) {
112 root 1.6 $block->[3] = $::NOW + 180;
113 root 1.5 $status = 401;
114     $hdr->{Warning} = "Please do NOT retry, you have been blocked. Press Cancel instead.";
115     $hdr->{"WWW-Authenticate"} = "Basic realm=\"Please do NOT retry, you have been blocked. Press Cancel instead.\"";
116     }
117     }
118    
119     $self->err($status, $block->[1], $hdr,
120 root 1.1 <<EOF);
121     <html>
122     <head>
123 root 1.5 <title>$block->[1]</title>
124 root 1.1 </head>
125     <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
126    
127 root 1.5 <p>You have been blocked because you didn't behave. The exact reason was:</p>
128    
129     <h1><blockquote>"$block->[1]"</blockquote></h1>
130    
131     <p>You may retry not earlier than:</p>
132 root 1.1
133 root 1.2 <p><blockquote>$etime.</blockquote></p>
134    
135 root 1.7 <p>Until then, each access will renew the block.</p>
136 root 1.5
137     <p>For your reference, the current time and your connection ID is:</p>
138 root 1.2
139 root 1.3 <p><blockquote>$ctime | $id</blockquote></p>
140 root 1.1
141     </body></html>
142     EOF
143     }
144    
145     sub conn::err_segmented_download {
146     my $self = shift;
147     $self->err(400, "segmented downloads are not allowed",
148     { "Content-Type" => "text/html", Connection => "close" }, <<EOF);
149     <html>
150     <head>
151     <title>Segmented downloads are not allowed</title>
152     </head>
153     <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
154    
155 root 1.7 <p>Segmented downloads are not allowed on this server.</p>
156 root 1.1
157     </body></html>
158     EOF
159     }
160    
161     1;
162