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 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 .= "Directories"; $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 .= "$_ "; } 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 .= "". ("FileSize " x $cols); for (@{$data->{f}}) { if (++$col >= $cols) { $stat .= ""; $col = 0; } $stat .= "$_->[0]$_->[1] "; } $stat .= ""; } my $waiters = sprintf "%d/%d", $::transfers[0][0]->waiters+0, $::transfers[1][0]->waiters+0; my $avgtime = sprintf "%d/%d second(s)", $::transfers[0][1], $::transfers[1][1]; < $self->{uri} $data->{path} $data->{top} $self->{remote_id}/$self->{country} - $::conns connection(s) - uptime $uptime - myhttpd/$VERSION clients waiting for data transfer: $waiters average waiting time until transfer starts: $avgtime (adjust your timeout values) $stat $data->{bot}