use PApp::SQL; use Storable (); sub escape_html { local $_ = shift; s/([()<>%&?,; ='"\x00-\x1f\x80-\xff])/sprintf "%%%02X", ord($1)/ge; $_; } my $SD_VERSION = 1; my $ignore = qr/ ^(?:robots.txt$|\.) /x; 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 $stat; my (@files, @dirs); 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 @dirs, "$_/"; } else { my $s = -s _; $flen = length $_ if length $_ > $dlen; $slen = length $s if length $s > $dlen; push @files, [$_, $s]; } } if (@dirs) { $stat .= "Directories"; $dlen += 1; my $cols = int ((79 + $dlen) / $dlen); my $col = $cols; $cols = @dirs if @dirs < $cols; for (@dirs) { if (++$col >= $cols) { $stat .= ""; $col = 0; } $stat .= "$_ "; } $stat .= ""; } if (@files) { $flen = $flen + 1 + $slen + 1 + 3; my $cols = int ((79 + $flen) / $flen); my $col = $cols; $cols = @files if @files < $cols; $stat .= "". ("FileSize " x $cols); for (@files) { if (++$col >= $cols) { $stat .= ""; $col = 0; } $stat .= "$_->[0]$_->[1] "; } $stat .= ""; } $data->{stat} = $stat; } else { $data->{stat} = "Unable to index $uri: $!"; } $data; } sub conn::get_statdata { my $self = shift; my $mtime = $self->{stat}[9]; my $st = sql_exec \my($statdata), "select statdata from diridx where mtime = ? and path = ?", $mtime, $self->{path}; if ($st->fetch) { $statdata = Storable::thaw $statdata; return $statdata if $statdata->{version} == $SD_VERSION; } $self->slog(8, "creating index cache for $self->{path}"); $statdata = $self->gen_statdata; $statdata->{version} = $SD_VERSION; sql_exec "delete from diridx where path = ?", $self->{path}; sql_exec "insert into diridx (path, mtime, statdata) values (?, ?, ?)", $self->{path}, $mtime, 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; < $self->{uri} $data->{path} $data->{top} $self->{remote_addr}/$self->{country} - $::conns connection(s) - uptime $uptime - myhttpd/$VERSION $data->{stat} $data->{bot}