Coro/myhttpd/diridx.pl

use Storable ();

my $SD_VERSION = 1;

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

our %diridx;

if ($::DIRIDX) {
   require GDBM_File;
   my $dbm = tie %diridx, GDBM_File, $::DIRIDX,
                 &GDBM_File::GDBM_WRCREAT, # | &GDBM_File::GDBM_FAST,
                 0600;
   $dbm->setopt(&GDBM_File::GDBM_CACHESIZE, (pack "i", 1_000), length (pack "i", 1_000));
}

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 ($/, *X);
      (open X, "<$_[0]\x00") ? <X> : ();
   }

   {
      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 "";
   }

   local *DIR;
   if (opendir DIR, $self->{path}) {
      my $dlen = 0;
      my $flen = 0;
      my $slen = 0;
      for (sort readdir DIR) {
         next if /$ignore/;
         stat "$self->{path}$_";
         next unless -r _;
         if (-d _) {
            $dlen = length $_ if length $_ > $dlen;
            push @{$data->{d}}, $_;
         } else {
            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;

   $$statdata;
}

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

   my $data = $self->get_statdata;

   my $uptime = int (time - $::starttime);
   $uptime = sprintf "%02dd %02d:%02d",
                     int ($uptime / (60 * 60 * 24)),
                     int ($uptime / (60 * 60)) % 24,
                     int ($uptime / 60) % 60;
   
   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}
<small><div align="right"><tt>$self->{remote_id}/$self->{country} - $::conns connection(s) - uptime $uptime - myhttpd/$VERSION</tt></div></small>
<hr>
$stat
$data->{bot}
</body>
</html>
EOF
}

sub handle_redirect { # unused
   if (-f ".redirect") {
      if (open R, "<.redirect") {
         while (<R>) {
            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
            }
         }
      }
   }
}

1;
Revision:	1.9
Committed:	Sun Aug 26 14:55:46 2001 UTC (22 years, 10 months ago) by root
Content type:	text/plain
Branch:	MAIN
Changes since 1.8:	+60 -56 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	use Storable ();
2
3			my $SD_VERSION = 1;
4
5			my $ignore = qr/ ^(?:robots.txt$\|\.) /x;
6
7	root	1.9	our %diridx;
8
9			if ($::DIRIDX) {
10			require GDBM_File;
11			my $dbm = tie %diridx, GDBM_File, $::DIRIDX,
12			&GDBM_File::GDBM_WRCREAT, # \| &GDBM_File::GDBM_FAST,
13			0600;
14			$dbm->setopt(&GDBM_File::GDBM_CACHESIZE, (pack "i", 1_000), length (pack "i", 1_000));
15			}
16
17	root	1.1	sub conn::gen_statdata {
18			my $self = shift;
19			my $data;
20
21			{
22			my $path = "";
23			my $prefix = "";
24
25			for ("http://".$self->server_hostport, split /\//, substr $self->{name}, 1) {
26			next if $_ eq ".";
27	root	1.7	$path .= "<a href='".escape_uri("$prefix$_")."/'>$_</a> / ";
28	root	1.1	$prefix .= "$_/";
29			}
30			$data->{path} = $path;
31			}
32
33			sub read_file {
34			local ($/, *X);
35			(open X, "<$_[0]\x00") ? <X> : ();
36			}
37
38			{
39			my $path = $self->{path};
40			do {
41			$data->{top} \|\|= read_file "$path.dols/top";
42			$data->{bot} \|\|= read_file "$path.dols/bot";
43			$path =~ s/[^\/]*\/+$//
44			or die "malformed path: $path";
45			} while $path ne "";
46			}
47
48			local *DIR;
49			if (opendir DIR, $self->{path}) {
50			my $dlen = 0;
51			my $flen = 0;
52			my $slen = 0;
53			for (sort readdir DIR) {
54			next if /$ignore/;
55			stat "$self->{path}$_";
56			next unless -r _;
57			if (-d _) {
58			$dlen = length $_ if length $_ > $dlen;
59	root	1.9	push @{$data->{d}}, $_;
60	root	1.1	} else {
61			my $s = -s _;
62			$flen = length $_ if length $_ > $dlen;
63			$slen = length $s if length $s > $dlen;
64	root	1.9	push @{$data->{f}}, [$_, $s];
65	root	1.1	}
66			}
67	root	1.9	$data->{dlen} = $dlen;
68			$data->{flen} = $flen;
69			$data->{slen} = $slen;
70	root	1.1	}
71
72			$data;
73			}
74
75			sub conn::get_statdata {
76			my $self = shift;
77
78			my $mtime = $self->{stat}[9];
79
80	root	1.9	$statdata = $diridx{$self->{path}};
81	root	1.6
82	root	1.9	if (defined $statdata) {
83			$$statdata = Storable::thaw $statdata;
84			return $$statdata
85			if $$statdata->{version} == $SD_VERSION
86			&& $$statdata->{mtime} == $mtime;
87	root	1.1	}
88
89			$self->slog(8, "creating index cache for $self->{path}");
90
91	root	1.6	$$statdata = $self->gen_statdata;
92			$$statdata->{version} = $SD_VERSION;
93	root	1.9	$$statdata->{mtime} = $mtime;
94	root	1.1
95	root	1.9	$diridx{$self->{path}} = Storable::freeze $$statdata;
96	root	1.1
97	root	1.6	$$statdata;
98	root	1.1	}
99
100			sub conn::diridx {
101			my $self = shift;
102
103			my $data = $self->get_statdata;
104	root	1.5
105			my $uptime = int (time - $::starttime);
106			$uptime = sprintf "%02dd %02d:%02d",
107			int ($uptime / (60 * 60 * 24)),
108			int ($uptime / (60 * 60)) % 24,
109			int ($uptime / 60) % 60;
110	root	1.1
111	root	1.9	my $stat;
112			if ($data->{dlen}) {
113			$stat .= "<table><tr><th>Directories</th></tr>";
114			$data->{dlen} += 1;
115			my $cols = int ((79 + $data->{dlen}) / $data->{dlen});
116			$cols = @{$data->{d}} if @{$data->{d}} < $cols;
117			my $col = $cols;
118			for (@{$data->{d}}) {
119			if (++$col >= $cols) {
120			$stat .= "<tr>";
121			$col = 0;
122			}
123			if ("$self->{path}$_" =~ $conn::blockuri{$self->{country}}) {
124			$stat .= "<td>$_ ";
125			} else {
126			$stat .= "<td><a href='".escape_uri("$_/")."'>$_</a> ";
127			}
128			}
129			$stat .= "</table>";
130			}
131			if ($data->{flen}) {
132			$data->{flen} += 1 + $data->{slen} + 1 + 3;
133			my $cols = int ((79 + $data->{flen}) / $data->{flen});
134			$cols = @{$data->{f}} if @{$data->{f}} < $cols;
135			my $col = $cols;
136			$stat .= "<table><tr>". ("<th align='left'>File<th>Size<th> " x $cols);
137			for (@{$data->{f}}) {
138			if (++$col >= $cols) {
139			$stat .= "<tr>";
140			$col = 0;
141			}
142			$stat .= "<td><a href='".escape_uri($_->[0])."'>$_->[0]</a><td align='right'>$_->[1]<td> ";
143			}
144			$stat .= "</table>";
145			}
146
147	root	1.1	<<EOF;
148			<html>
149			<head><title>$self->{uri}</title></head>
150			<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
151			<h1>$data->{path}</h1>
152			$data->{top}
153	root	1.8	<small><div align="right"><tt>$self->{remote_id}/$self->{country} - $::conns connection(s) - uptime $uptime - myhttpd/$VERSION</tt></div></small>
154	root	1.1	<hr>
155	root	1.9	$stat
156	root	1.1	$data->{bot}
157			</body>
158			</html>
159			EOF
160			}
161
162			sub handle_redirect { # unused
163			if (-f ".redirect") {
164			if (open R, "<.redirect") {
165			while (<R>) {
166			if (/^(?:$host$port)$uri([^ \tr\n])[ \t\r\n]+(.)$/) {
167			my $rem = $1;
168			my $url = $2;
169			print $nph ? "HTTP/1.0 302 Moved\n" : "Status: 302 Moved\n";
170			print <<EOF;
171			Location: $url
172			Content-Type: text/html
173
174			<html>
175			<head><title>Page Redirection to $url</title></head>
176			<meta http-equiv="refresh" content="0;URL=$url">
177			</head>
178			<body text="black" link="#1010C0" vlink="#101080" alink="red" bgcolor="white">
179			<large>
180			This page has moved to $url.<br />
181			<a href="$url">
182	root	1.7	The automatic redirection has failed. Please try a <i>slightly</i>
183			newer browser next time, and in the meantime <i>please</i> follow this link ;)
184	root	1.1	</a>
185			</large>
186			</body>
187			</html>
188			EOF
189			}
190			}
191			}
192			}
193			}
194
195			1;