| … | |
… | |
| 206 | </body> |
206 | </body> |
| 207 | </html> |
207 | </html> |
| 208 | EOF |
208 | EOF |
| 209 | } |
209 | } |
| 210 | |
210 | |
| 211 | sub statuspage { |
|
|
| 212 | my ($self, $verbose) = @_; |
|
|
| 213 | |
|
|
| 214 | my $uptime = format_time ($::NOW - $::starttime); |
|
|
| 215 | |
|
|
| 216 | my $content = <<EOF; |
|
|
| 217 | <html> |
|
|
| 218 | <head><title>Server Status Page</title></head> |
|
|
| 219 | <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000"> |
|
|
| 220 | <h1>Server Status Page</h1> |
|
|
| 221 | <h2>Myhttpd</h2> |
|
|
| 222 | version <b>$VERSION</b>; current:max connection count: <b>$::conns</b>:<b>$::maxconns</b>; uptime: <b>$uptime</b>;<br /> |
|
|
| 223 | client-id <b>$self->{remote_id}</b>; client country <b>$self->{country}</b>;<br /> |
|
|
| 224 | <h2>Queue Statistics</h2> |
|
|
| 225 | <ul> |
|
|
| 226 | EOF |
|
|
| 227 | |
|
|
| 228 | for ( |
|
|
| 229 | ["download queue", $queue_file], |
|
|
| 230 | $verbose ? (["other queue", $queue_index]) |
|
|
| 231 | : (), |
|
|
| 232 | ) { |
|
|
| 233 | my ($name, $queue) = @$_; |
|
|
| 234 | my @waiters = $queue->waiters; |
|
|
| 235 | $waiters[$_]{idx} = $_ + 1 for 0..$#waiters; |
|
|
| 236 | |
|
|
| 237 | if (@waiters) { |
|
|
| 238 | $content .= "<li>$name<br />".(scalar @waiters)." client(s); $queue->{started} downloads started; $queue->{slots} slots free;"; |
|
|
| 239 | |
|
|
| 240 | $content .= "<p>Waiting time until download starts, estimated:<ul>"; |
|
|
| 241 | for ( |
|
|
| 242 | ["by queue average", $queue->{avgspb}], |
|
|
| 243 | $verbose ? (["by most recently started transfer", $queue->{lastspb}], |
|
|
| 244 | ["by next client in queue", $waiters[0]{spb}]) |
|
|
| 245 | : (), |
|
|
| 246 | ) { |
|
|
| 247 | my ($by, $spb) = @$_; |
|
|
| 248 | $content .= "<li>$by<br />"; |
|
|
| 249 | if ($spb) { |
|
|
| 250 | $content .= sprintf "100 KB file: <b>%s</b>; 1 MB file: <b>%s</b>; 100MB file: <b>%s</b>;", |
|
|
| 251 | format_time($spb* 100_000), |
|
|
| 252 | format_time($spb* 1_000_000), |
|
|
| 253 | format_time($spb*100_000_000); |
|
|
| 254 | } else { |
|
|
| 255 | $content .= "(unavailable)"; |
|
|
| 256 | } |
|
|
| 257 | $content .= "</li>"; |
|
|
| 258 | } |
|
|
| 259 | $content .= "</ul></p>"; |
|
|
| 260 | |
|
|
| 261 | @waiters = grep { $verbose || $_->{coro}{conn}{remote_id} eq $self->{remote_id} } @waiters; |
|
|
| 262 | if (@waiters) { |
|
|
| 263 | $content .= "<table border='1' width='100%'><tr><th>#</th><th>Remote ID</th>". |
|
|
| 264 | "<th>CN</th><th>Size</th><th>Waiting</th><th>ETA</th><th>URI</th></tr>"; |
|
|
| 265 | for (@waiters) { |
|
|
| 266 | my $conn = $_->{coro}{conn}; |
|
|
| 267 | my $time = format_time ($::NOW - $_->{time}); |
|
|
| 268 | my $eta = $queue->{avgspb} * $_->{size} - ($::NOW - $_->{time}); |
|
|
| 269 | |
|
|
| 270 | $content .= "<tr>". |
|
|
| 271 | "<td align='right'>$_->{idx}</td>". |
|
|
| 272 | "<td>$conn->{remote_id}</td>". |
|
|
| 273 | "<td>$conn->{country}</td>". |
|
|
| 274 | "<td align='right'>$_->{size}</td>". |
|
|
| 275 | "<td align='right'>$time</td>". |
|
|
| 276 | "<td align='right'>".($eta < 0 ? "<font color='red'>overdue</font>" : format_time $eta)."</td>". |
|
|
| 277 | "<td>".escape_html($conn->{name})."</td>". |
|
|
| 278 | "</tr>"; |
|
|
| 279 | } |
|
|
| 280 | $content .= "</table></li>"; |
|
|
| 281 | } |
|
|
| 282 | $content .= "</li>"; |
|
|
| 283 | } else { |
|
|
| 284 | $content .= "<li>$name<br />(empty)</li>"; |
|
|
| 285 | } |
|
|
| 286 | } |
|
|
| 287 | |
|
|
| 288 | $content .= <<EOF; |
|
|
| 289 | </ul> |
|
|
| 290 | </body> |
|
|
| 291 | </html> |
|
|
| 292 | EOF |
|
|
| 293 | |
|
|
| 294 | $self->response(200, "ok", |
|
|
| 295 | { |
|
|
| 296 | "Content-Type" => "text/html", |
|
|
| 297 | "Content-Length" => length $content, |
|
|
| 298 | }, |
|
|
| 299 | $content); |
|
|
| 300 | }; |
|
|
| 301 | |
|
|
| 302 | $::internal{status} = sub { statuspage($_[0], 0) }; |
|
|
| 303 | $::internal{queue} = sub { statuspage($_[0], 1) }; |
|
|
| 304 | |
|
|
| 305 | 1; |
211 | 1; |
