Coro/myhttpd/diridx.pl

package main;

use List::Util qw(sum);

use Coro::AIO ();
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 $prefix = "http://" . $self->server_hostport;
      my $path = "<a href='$prefix/'>$prefix</a> / ";

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

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

   my $entries = Coro::AIO::aio_readdir $self->{path};

   {
      my $dlen = 0;
      my $flen = 0;
      my $slen = 0;

      for (sort @$entries) {
         next if /$ignore/;

         Coro::AIO::aio_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];
   my $statdata;

#   $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.38
Committed:	Mon Mar 8 07:38:21 2010 UTC (16 years, 7 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	rel-6_0, rel-6_5, rel-6_10, rel-6_09, rel-6_08, rel-6_07, rel-6_06, rel-6_05, rel-6_04, rel-6_03, rel-6_02, rel-6_01, rel-5_371, rel-5_372, rel-6_512, rel-6_513, rel-6_511, rel-6_514, rel-5_22, rel-5_23, rel-5_24, rel-5_25, rel-6_32, rel-6_33, rel-6_31, rel-6_36, rel-6_37, rel-6_38, rel-6_39, rel-5_37, rel-5_36, rel-6_23, rel-6_29, rel-6_28, rel-6_46, rel-6_45, rel-6_51, rel-6_52, rel-6_53, rel-6_54, rel-6_55, rel-6_56, rel-6_57, rel-6_43, rel-6_42, rel-6_41, rel-6_47, rel-6_44, rel-6_49, rel-6_48, HEAD
Changes since 1.37:	+8 -6 lines
Log Message:	uri's are difficult stuff
#	User	Rev	Content
1	root	1.38	package main;
2
3	root	1.12	use List::Util qw(sum);
4
5	root	1.36	use Coro::AIO ();
6	root	1.1	use Storable ();
7
8			my $SD_VERSION = 1;
9
10			my $ignore = qr/ ^(?:robots.txt$\|\.) /x;
11
12	root	1.9	our %diridx;
13
14	root	1.10	if ($db_env) {
15			tie %diridx, BerkeleyDB::Hash,
16			-Env => $db_env,
17			-Filename => "directory",
18			-Flags => DB_CREATE,
19			or die "unable to create database index";
20	root	1.9	}
21
22	root	1.1	sub conn::gen_statdata {
23			my $self = shift;
24			my $data;
25
26			{
27	root	1.38	my $prefix = "http://" . $self->server_hostport;
28			my $path = "<a href='$prefix/'>$prefix</a> / ";
29	root	1.1
30	root	1.38	for (split /\//, substr $self->{name}, 1) {
31	root	1.1	next if $_ eq ".";
32	root	1.38	$prefix .= "/" . escape_uri $_;
33			$path .= "<a href='$prefix/'>$_</a> / ";
34	root	1.1	}
35			$data->{path} = $path;
36			}
37
38			{
39			my $path = $self->{path};
40			do {
41	root	1.36	Coro::AIO::aio_load "$path.dols/top", $data->{top}
42			unless Coro::AIO::aio_stat "$path.dols/top";
43	root	1.37	Coro::AIO::aio_load "$path.dols/bot", $data->{bot}
44	root	1.36	unless Coro::AIO::aio_stat "$path.dols/bot";
45	root	1.1	$path =~ s/[^\/]*\/+$//
46			or die "malformed path: $path";
47			} while $path ne "";
48			}
49
50	root	1.36	my $entries = Coro::AIO::aio_readdir $self->{path};
51
52			{
53	root	1.1	my $dlen = 0;
54			my $flen = 0;
55			my $slen = 0;
56	root	1.36
57			for (sort @$entries) {
58	root	1.1	next if /$ignore/;
59	root	1.36
60			Coro::AIO::aio_stat "$self->{path}$_";
61	root	1.1	if (-d _) {
62	root	1.15	next unless 0555 == ((stat _)[2] & 0555);
63	root	1.1	$dlen = length $_ if length $_ > $dlen;
64	root	1.9	push @{$data->{d}}, $_;
65	root	1.1	} else {
66	root	1.15	next unless 0444 == ((stat _)[2] & 0444);
67	root	1.1	my $s = -s _;
68			$flen = length $_ if length $_ > $dlen;
69			$slen = length $s if length $s > $dlen;
70	root	1.9	push @{$data->{f}}, [$_, $s];
71	root	1.1	}
72			}
73	root	1.9	$data->{dlen} = $dlen;
74			$data->{flen} = $flen;
75			$data->{slen} = $slen;
76	root	1.1	}
77
78	root	1.36	$data
79	root	1.1	}
80
81			sub conn::get_statdata {
82			my $self = shift;
83
84			my $mtime = $self->{stat}[9];
85	root	1.36	my $statdata;
86	root	1.1
87	root	1.36	# $statdata = $diridx{$self->{path}};
88			#
89			# if (defined $statdata) {
90			# $$statdata = Storable::thaw $statdata;
91			# return $$statdata
92			# if $$statdata->{version} == $SD_VERSION
93			# && $$statdata->{mtime} == $mtime;
94			# }
95	root	1.1
96	root	1.36	# $self->slog(8, "creating index cache for $self->{path}");
97	root	1.1
98	root	1.6	$$statdata = $self->gen_statdata;
99			$$statdata->{version} = $SD_VERSION;
100	root	1.9	$$statdata->{mtime} = $mtime;
101	root	1.1
102	root	1.36	# $diridx{$self->{path}} = Storable::freeze $$statdata;
103			# (tied %diridx)->db_sync;
104	root	1.1
105	root	1.36	$$statdata
106	root	1.1	}
107
108	root	1.16	sub handle_redirect { # unused
109			if (-f ".redirect") {
110	root	1.34	if (open my $fh, "<.redirect") {
111			while (<$fh>) {
112	root	1.16	if (/^(?:$host$port)$uri([^ \tr\n])[ \t\r\n]+(.)$/) {
113			my $rem = $1;
114			my $url = $2;
115			print $nph ? "HTTP/1.0 302 Moved\n" : "Status: 302 Moved\n";
116			print <<EOF;
117			Location: $url
118			Content-Type: text/html
119
120			<html>
121			<head><title>Page Redirection to $url</title></head>
122			<meta http-equiv="refresh" content="0;URL=$url">
123			</head>
124			<body text="black" link="#1010C0" vlink="#101080" alink="red" bgcolor="white">
125			<large>
126			This page has moved to $url.<br />
127			<a href="$url">
128			The automatic redirection has failed. Please try a <i>slightly</i>
129			newer browser next time, and in the meantime <i>please</i> follow this link ;)
130			</a>
131			</large>
132			</body>
133			</html>
134			EOF
135			}
136			}
137			}
138			}
139			}
140
141			sub format_time {
142	root	1.23	if ($_[0] < 0) {
143			"--:--:--";
144			} elsif ($_[0] >= 606024) {
145	root	1.29	sprintf "%dd %02d:%02d:%02d",
146	root	1.23	int ($_[0] / (60 * 60 * 24)),
147			int ($_[0] / (60 * 60)) % 24,
148			int ($_[0] / 60) % 60,
149			int ($_[0]) % 60;
150			} else {
151			sprintf "%02d:%02d:%02d",
152			int ($_[0] / (60 * 60)) % 24,
153			int ($_[0] / 60) % 60,
154			int ($_[0]) % 60;
155			}
156	root	1.16	}
157
158	root	1.1	sub conn::diridx {
159			my $self = shift;
160
161			my $data = $self->get_statdata;
162	root	1.5
163	root	1.9	my $stat;
164			if ($data->{dlen}) {
165			$stat .= "<table><tr><th>Directories</th></tr>";
166			$data->{dlen} += 1;
167			my $cols = int ((79 + $data->{dlen}) / $data->{dlen});
168			$cols = @{$data->{d}} if @{$data->{d}} < $cols;
169			my $col = $cols;
170			for (@{$data->{d}}) {
171			if (++$col >= $cols) {
172			$stat .= "<tr>";
173			$col = 0;
174			}
175			if ("$self->{path}$_" =~ $conn::blockuri{$self->{country}}) {
176			$stat .= "<td>$_ ";
177			} else {
178	root	1.38	$stat .= "<td><a href='".escape_uri($_)."/'>$_</a> ";
179	root	1.9	}
180			}
181			$stat .= "</table>";
182			}
183			if ($data->{flen}) {
184			$data->{flen} += 1 + $data->{slen} + 1 + 3;
185			my $cols = int ((79 + $data->{flen}) / $data->{flen});
186			$cols = @{$data->{f}} if @{$data->{f}} < $cols;
187			my $col = $cols;
188			$stat .= "<table><tr>". ("<th align='left'>File<th>Size<th> " x $cols);
189			for (@{$data->{f}}) {
190			if (++$col >= $cols) {
191			$stat .= "<tr>";
192			$col = 0;
193			}
194			$stat .= "<td><a href='".escape_uri($_->[0])."'>$_->[0]</a><td align='right'>$_->[1]<td> ";
195			}
196			$stat .= "</table>";
197			}
198
199	root	1.1	<<EOF;
200			<html>
201			<head><title>$self->{uri}</title></head>
202			<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
203			<h1>$data->{path}</h1>
204			$data->{top}
205	root	1.13	<hr />
206	root	1.16	<a href="/internal/status">Server Status Page & Queueing Info</a>
207	root	1.12	<hr />
208	root	1.9	$stat
209	root	1.1	$data->{bot}
210			</body>
211			</html>
212			EOF
213			}
214
215			1;