Coro/myhttpd/diridx.pl

use List::Util qw(sum);

use Storable ();

my $SD_VERSION = 1;

my $ignore = qr/ ^(?:robots.txt$|\.) /x;

our %diridx;

if ($db_env) {
   tie %diridx, BerkeleyDB::Hash,
       -Env => $db_env,
       -Filename => "directory",
       -Flags => DB_CREATE,
          or die "unable to create database index";
}

sub conn::gen_statdata {
   my $self = shift;
   my $data;
   
   {
      my $path = "";
      my $prefix = "";

      for ("http://".$self->server_hostport, split /\//, substr $self->{name}, 1) {
         next if $_ eq ".";
         $path .= "<a href='".escape_uri("$prefix$_")."/'>$_</a> / ";
         $prefix .= "$_/";
      }
      $data->{path} = $path;
   }

   sub read_file {
      local $/;
      (open my $fh, "<$_[0]\x00") ? <$fh> : ()
   }

   {
      my $path = $self->{path};
      do {
         $data->{top} ||= read_file "$path.dols/top";
         $data->{bot} ||= read_file "$path.dols/bot";
         $path =~ s/[^\/]*\/+$//
            or die "malformed path: $path";
      } while $path ne "";
   }

   if (opendir my $dir, $self->{path}) {
      my $dlen = 0;
      my $flen = 0;
      my $slen = 0;
      for (sort readdir $dir) {
         next if /$ignore/;
         stat "$self->{path}$_";
         if (-d _) {
            next unless 0555 == ((stat _)[2] & 0555);
            $dlen = length $_ if length $_ > $dlen;
            push @{$data->{d}}, $_;
         } else {
            next unless 0444 == ((stat _)[2] & 0444);
            my $s = -s _;
            $flen = length $_ if length $_ > $dlen;
            $slen = length $s if length $s > $dlen;
            push @{$data->{f}}, [$_, $s];
         }
      }
      $data->{dlen} = $dlen;
      $data->{flen} = $flen;
      $data->{slen} = $slen;
   }

   $data;
}

sub conn::get_statdata {
   my $self = shift;

   my $mtime = $self->{stat}[9];

   $statdata = $diridx{$self->{path}};

   if (defined $statdata) {
      $$statdata = Storable::thaw $statdata;
      return $$statdata
         if $$statdata->{version} == $SD_VERSION
            && $$statdata->{mtime} == $mtime;
   }

   $self->slog(8, "creating index cache for $self->{path}");

   $$statdata = $self->gen_statdata;
   $$statdata->{version} = $SD_VERSION;
   $$statdata->{mtime}   = $mtime;

   $diridx{$self->{path}} = Storable::freeze $$statdata;
   (tied %diridx)->db_sync;

   $$statdata;
}

sub handle_redirect { # unused
   if (-f ".redirect") {
      if (open my $fh, "<.redirect") {
         while (<$fh>) {
            if (/^(?:$host$port)$uri([^ \tr\n]*)[ \t\r\n]+(.*)$/) {
               my $rem = $1;
               my $url = $2;
               print $nph ? "HTTP/1.0 302 Moved\n" : "Status: 302 Moved\n";
               print <<EOF;
Location: $url
Content-Type: text/html

<html>
<head><title>Page Redirection to $url</title></head>
<meta http-equiv="refresh" content="0;URL=$url">
</head>
<body text="black" link="#1010C0" vlink="#101080" alink="red" bgcolor="white">
<large>
This page has moved to $url.<br />
<a href="$url">
The automatic redirection has failed. Please try a <i>slightly</i>
newer browser next time, and in the meantime <i>please</i> follow this link ;)
</a>
</large>
</body>
</html>
EOF
            }
         }
      }
   }
}

sub format_time {
   if ($_[0] < 0) {
      "--:--:--";
   } elsif ($_[0] >= 60*60*24) {
      sprintf "%dd&#160;%02d:%02d:%02d",
              int ($_[0] / (60 * 60 * 24)),
              int ($_[0] / (60 * 60)) % 24,
              int ($_[0] / 60) % 60,
              int ($_[0]) % 60;
   } else {
      sprintf "%02d:%02d:%02d",
              int ($_[0] / (60 * 60)) % 24,
              int ($_[0] / 60) % 60,
              int ($_[0]) % 60;
   }
}

sub conn::diridx {
   my $self = shift;

   my $data = $self->get_statdata;

   my $stat;
   if ($data->{dlen}) {
      $stat .= "<table><tr><th>Directories</th></tr>";
      $data->{dlen} += 1;
      my $cols = int ((79 + $data->{dlen}) / $data->{dlen});
      $cols = @{$data->{d}} if @{$data->{d}} < $cols;
      my $col = $cols;
      for (@{$data->{d}}) {
         if (++$col >= $cols) {
            $stat .= "<tr>";
            $col = 0;
         }
         if ("$self->{path}$_" =~ $conn::blockuri{$self->{country}}) {
            $stat .= "<td>$_ ";
         } else {
            $stat .= "<td><a href='".escape_uri("$_/")."'>$_</a> ";
         }
      }
      $stat .= "</table>";
   }
   if ($data->{flen}) {
      $data->{flen} += 1 + $data->{slen} + 1 + 3;
      my $cols = int ((79 + $data->{flen}) / $data->{flen});
      $cols = @{$data->{f}} if @{$data->{f}} < $cols;
      my $col = $cols;
      $stat .= "<table><tr>". ("<th align='left'>File<th>Size<th>&nbsp;" x $cols);
      for (@{$data->{f}}) {
         if (++$col >= $cols) {
            $stat .= "<tr>";
            $col = 0;
         }
         $stat .= "<td><a href='".escape_uri($_->[0])."'>$_->[0]</a><td align='right'>$_->[1]<td>&nbsp;";
      }
      $stat .= "</table>";
   }

   <<EOF;
<html>
<head><title>$self->{uri}</title></head>
<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
<h1>$data->{path}</h1>
$data->{top}
<hr />
<a href="/internal/status">Server Status Page &amp; Queueing Info</a>
<hr />
$stat
$data->{bot}
</body>
</html>
EOF
}

1;
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] >= 606024) {
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;