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 .= "$_ / "; $prefix .= "$_/"; } $data->{path} = $path; } sub read_file { local ($/, *X); (open X, "<$_[0]\x00") ? : (); } { 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}$_"; 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 R, "<.redirect") { while () { 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 < Page Redirection to $url This page has moved to $url.
The automatic redirection has failed. Please try a slightly newer browser next time, and in the meantime please follow this link ;)
EOF } } } } } sub format_time { sprintf "%02dd %02d:%02d:%02d", int ($_[0] / (60 * 60 * 24)), 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 .= ""; $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 .= ""; $col = 0; } if ("$self->{path}$_" =~ $conn::blockuri{$self->{country}}) { $stat .= "
Directories
$_ "; } else { $stat .= "$_ "; } } $stat .= "
"; } 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 .= "". (""; $col = 0; } $stat .= "
FileSize " x $cols); for (@{$data->{f}}) { if (++$col >= $cols) { $stat .= "
$_->[0]$_->[1] "; } $stat .= "
"; } < $self->{uri}

$data->{path}

$data->{top}
Server Status Page & Queueing Info
$stat $data->{bot} EOF } sub statuspage { my ($self, $verbose) = @_; my $uptime = format_time ($::NOW - $::starttime); my $content = < Server Status Page

Server Status Page

Myhttpd

version $VERSION; current:max connection count: $::conns:$::maxconns; uptime: $uptime;
client-id $self->{remote_id}, client country $self->{country};

Queue Statistics

    EOF for ( ["download queue", $queue_file], ["other queue", $queue_index], ) { my ($name, $queue) = @$_; my @waiters = $queue->waiters; if (@waiters) { $content .= "
  • $name
    ".(scalar @waiters)." client(s)"; $content .= "

    Waiting time until download starts, estimated:

      "; for ( ["by most recently started transfer", $queue->{lastspb}], ["by next client in queue", $waiters[0]{spb}], ) { my ($by, $spb) = @$_; $content .= "
    • $by
      "; if ($spb) { $content .= sprintf "100 KB file: %s; 1 MB file: %s; 100MB file: %s;", format_time($spb* 100_000), format_time($spb* 1_000_000), format_time($spb*100_000_000); } else { $content .= "(unavailable)"; } $content .= "
    • "; } $content .= "

    "; if ($verbose) { $content .= ""; for (@waiters) { my $conn = $_->{coro}{conn}; my $time = format_time ($::NOW - $_->{time}); $content .= "". "". "". "". "". "". "". ""; } $content .= "
    Remote IDCNSizeWaitingSPBURI
    $conn->{remote_id}$conn->{country}$_->{size}$time$_->{spb}".escape_html($conn->{name})."
  • "; } $content .= ""; } else { $content .= "
  • $name
    (empty)
  • "; } } $content .= < EOF $self->response(200, "ok", { "Content-Type" => "text/html", "Content-Length" => length $content, }, $content); }; $::internal{status} = sub { statuspage($_[0], 0) }; $::internal{queue} = sub { statuspage($_[0], 1) }; 1;