Revision: | 1.34 |
Committed: | Sat Dec 2 03:29:29 2006 UTC (17 years, 7 months ago) by root |
Content type: | text/plain |
Branch: | MAIN |
CVS Tags: | rel-4_91, rel-4_22, rel-4_21, rel-4_0, rel-4_3, rel-3_41, rel-5_151, rel-4_13, rel-4_11, rel-5_1, rel-5_0, rel-4_748, rel-3_55, rel-4_8, rel-4_9, rel-3_51, rel-4_741, rel-4_743, rel-4_742, rel-4_744, rel-4_747, rel-6_13, rel-4_01, rel-4_03, rel-4_02, rel-3_6, rel-3_62, rel-3_63, rel-3_61, rel-3_4, rel-5_161, rel-3_1, rel-4_74, rel-4_71, rel-4_72, rel-4_73, rel-5_162, rel-5_2, rel-4_802, rel-4_803, rel-3_5, rel-4_801, rel-3_3, rel-3_2, rel-4_804, rel-3_0, rel-4_479, rel-3_01, rel-4_50, rel-4_51, rel-4_4, rel-3_11, rel-4_45, rel-4_745, rel-4_901, rel-4_49, rel-4_48, rel-4_1, rel-4_2, rel-4_746, rel-5_11, rel-5_12, rel-5_15, rel-5_14, rel-5_17, rel-5_16, rel-4_47, rel-4_46, rel-4_7, rel-3_501, rel-5_132, rel-5_131, rel-4_911, rel-4_912, rel-4_31, rel-4_32, rel-4_33, rel-4_34, rel-4_35, rel-4_36, rel-4_37 |
Changes since 1.33: | +6 -7 lines |
Log Message: | *** empty log message *** |
# | Content |
---|---|
1 | use List::Util qw(sum); |
2 | |
3 | use Storable (); |
4 | |
5 | my $SD_VERSION = 1; |
6 | |
7 | my $ignore = qr/ ^(?:robots.txt$|\.) /x; |
8 | |
9 | our %diridx; |
10 | |
11 | if ($db_env) { |
12 | tie %diridx, BerkeleyDB::Hash, |
13 | -Env => $db_env, |
14 | -Filename => "directory", |
15 | -Flags => DB_CREATE, |
16 | or die "unable to create database index"; |
17 | } |
18 | |
19 | sub conn::gen_statdata { |
20 | my $self = shift; |
21 | my $data; |
22 | |
23 | { |
24 | my $path = ""; |
25 | my $prefix = ""; |
26 | |
27 | for ("http://".$self->server_hostport, split /\//, substr $self->{name}, 1) { |
28 | next if $_ eq "."; |
29 | $path .= "<a href='".escape_uri("$prefix$_")."/'>$_</a> / "; |
30 | $prefix .= "$_/"; |
31 | } |
32 | $data->{path} = $path; |
33 | } |
34 | |
35 | sub read_file { |
36 | local $/; |
37 | (open my $fh, "<$_[0]\x00") ? <$fh> : () |
38 | } |
39 | |
40 | { |
41 | my $path = $self->{path}; |
42 | do { |
43 | $data->{top} ||= read_file "$path.dols/top"; |
44 | $data->{bot} ||= read_file "$path.dols/bot"; |
45 | $path =~ s/[^\/]*\/+$// |
46 | or die "malformed path: $path"; |
47 | } while $path ne ""; |
48 | } |
49 | |
50 | if (opendir my $dir, $self->{path}) { |
51 | my $dlen = 0; |
52 | my $flen = 0; |
53 | my $slen = 0; |
54 | for (sort readdir $dir) { |
55 | next if /$ignore/; |
56 | stat "$self->{path}$_"; |
57 | if (-d _) { |
58 | next unless 0555 == ((stat _)[2] & 0555); |
59 | $dlen = length $_ if length $_ > $dlen; |
60 | push @{$data->{d}}, $_; |
61 | } else { |
62 | next unless 0444 == ((stat _)[2] & 0444); |
63 | my $s = -s _; |
64 | $flen = length $_ if length $_ > $dlen; |
65 | $slen = length $s if length $s > $dlen; |
66 | push @{$data->{f}}, [$_, $s]; |
67 | } |
68 | } |
69 | $data->{dlen} = $dlen; |
70 | $data->{flen} = $flen; |
71 | $data->{slen} = $slen; |
72 | } |
73 | |
74 | $data; |
75 | } |
76 | |
77 | sub conn::get_statdata { |
78 | my $self = shift; |
79 | |
80 | my $mtime = $self->{stat}[9]; |
81 | |
82 | $statdata = $diridx{$self->{path}}; |
83 | |
84 | if (defined $statdata) { |
85 | $$statdata = Storable::thaw $statdata; |
86 | return $$statdata |
87 | if $$statdata->{version} == $SD_VERSION |
88 | && $$statdata->{mtime} == $mtime; |
89 | } |
90 | |
91 | $self->slog(8, "creating index cache for $self->{path}"); |
92 | |
93 | $$statdata = $self->gen_statdata; |
94 | $$statdata->{version} = $SD_VERSION; |
95 | $$statdata->{mtime} = $mtime; |
96 | |
97 | $diridx{$self->{path}} = Storable::freeze $$statdata; |
98 | (tied %diridx)->db_sync; |
99 | |
100 | $$statdata; |
101 | } |
102 | |
103 | sub handle_redirect { # unused |
104 | if (-f ".redirect") { |
105 | if (open my $fh, "<.redirect") { |
106 | while (<$fh>) { |
107 | if (/^(?:$host$port)$uri([^ \tr\n]*)[ \t\r\n]+(.*)$/) { |
108 | my $rem = $1; |
109 | my $url = $2; |
110 | print $nph ? "HTTP/1.0 302 Moved\n" : "Status: 302 Moved\n"; |
111 | print <<EOF; |
112 | Location: $url |
113 | Content-Type: text/html |
114 | |
115 | <html> |
116 | <head><title>Page Redirection to $url</title></head> |
117 | <meta http-equiv="refresh" content="0;URL=$url"> |
118 | </head> |
119 | <body text="black" link="#1010C0" vlink="#101080" alink="red" bgcolor="white"> |
120 | <large> |
121 | This page has moved to $url.<br /> |
122 | <a href="$url"> |
123 | The automatic redirection has failed. Please try a <i>slightly</i> |
124 | newer browser next time, and in the meantime <i>please</i> follow this link ;) |
125 | </a> |
126 | </large> |
127 | </body> |
128 | </html> |
129 | EOF |
130 | } |
131 | } |
132 | } |
133 | } |
134 | } |
135 | |
136 | sub format_time { |
137 | if ($_[0] < 0) { |
138 | "--:--:--"; |
139 | } elsif ($_[0] >= 60*60*24) { |
140 | sprintf "%dd %02d:%02d:%02d", |
141 | int ($_[0] / (60 * 60 * 24)), |
142 | int ($_[0] / (60 * 60)) % 24, |
143 | int ($_[0] / 60) % 60, |
144 | int ($_[0]) % 60; |
145 | } else { |
146 | sprintf "%02d:%02d:%02d", |
147 | int ($_[0] / (60 * 60)) % 24, |
148 | int ($_[0] / 60) % 60, |
149 | int ($_[0]) % 60; |
150 | } |
151 | } |
152 | |
153 | sub conn::diridx { |
154 | my $self = shift; |
155 | |
156 | my $data = $self->get_statdata; |
157 | |
158 | my $stat; |
159 | if ($data->{dlen}) { |
160 | $stat .= "<table><tr><th>Directories</th></tr>"; |
161 | $data->{dlen} += 1; |
162 | my $cols = int ((79 + $data->{dlen}) / $data->{dlen}); |
163 | $cols = @{$data->{d}} if @{$data->{d}} < $cols; |
164 | my $col = $cols; |
165 | for (@{$data->{d}}) { |
166 | if (++$col >= $cols) { |
167 | $stat .= "<tr>"; |
168 | $col = 0; |
169 | } |
170 | if ("$self->{path}$_" =~ $conn::blockuri{$self->{country}}) { |
171 | $stat .= "<td>$_ "; |
172 | } else { |
173 | $stat .= "<td><a href='".escape_uri("$_/")."'>$_</a> "; |
174 | } |
175 | } |
176 | $stat .= "</table>"; |
177 | } |
178 | if ($data->{flen}) { |
179 | $data->{flen} += 1 + $data->{slen} + 1 + 3; |
180 | my $cols = int ((79 + $data->{flen}) / $data->{flen}); |
181 | $cols = @{$data->{f}} if @{$data->{f}} < $cols; |
182 | my $col = $cols; |
183 | $stat .= "<table><tr>". ("<th align='left'>File<th>Size<th> " x $cols); |
184 | for (@{$data->{f}}) { |
185 | if (++$col >= $cols) { |
186 | $stat .= "<tr>"; |
187 | $col = 0; |
188 | } |
189 | $stat .= "<td><a href='".escape_uri($_->[0])."'>$_->[0]</a><td align='right'>$_->[1]<td> "; |
190 | } |
191 | $stat .= "</table>"; |
192 | } |
193 | |
194 | <<EOF; |
195 | <html> |
196 | <head><title>$self->{uri}</title></head> |
197 | <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000"> |
198 | <h1>$data->{path}</h1> |
199 | $data->{top} |
200 | <hr /> |
201 | <a href="/internal/status">Server Status Page & Queueing Info</a> |
202 | <hr /> |
203 | $stat |
204 | $data->{bot} |
205 | </body> |
206 | </html> |
207 | EOF |
208 | } |
209 | |
210 | 1; |