Revision: | 1.4 |
Committed: | Mon Jul 29 21:41:54 2002 UTC (22 years ago) by root |
Content type: | text/plain |
Branch: | MAIN |
CVS Tags: | rel-2_5, rel-4_91, rel-4_22, rel-4_21, rel-4_0, rel-4_3, rel-3_41, rel-5_151, rel-4_13, rel-4_11, rel-5_1, rel-5_0, rel-6_0, rel-6_5, rel-4_748, rel-3_55, rel-4_8, rel-4_9, rel-3_51, rel-4_741, rel-4_743, rel-4_742, rel-6_10, rel-4_744, rel-4_747, rel-6_13, rel-4_01, rel-4_03, rel-4_02, rel-2_0, rel-2_1, rel-1_1, rel-1_0, rel-1_9, rel-1_2, rel-3_6, rel-3_62, rel-3_63, rel-3_61, rel-1_5, rel-1_4, rel-1_7, rel-1_6, rel-3_4, rel-6_09, rel-6_08, rel-6_07, rel-6_06, rel-6_05, rel-6_04, rel-6_03, rel-6_02, rel-6_01, rel-5_161, rel-3_1, rel-4_74, rel-4_71, rel-4_72, rel-4_73, rel-5_371, rel-5_372, rel-6_512, rel-6_513, rel-6_511, rel-6_514, rel-5_22, rel-5_23, rel-5_24, rel-5_25, rel-6_32, rel-6_33, rel-6_31, rel-6_36, rel-6_37, rel-5_162, rel-5_2, rel-6_38, rel-6_39, rel-4_802, rel-4_803, rel-3_5, rel-4_801, rel-3_3, rel-3_2, rel-4_804, rel-3_0, rel-5_37, rel-5_36, rel-4_479, rel-6_23, rel-3_01, rel-6_29, rel-6_28, rel-6_46, rel-4_50, rel-4_51, rel-6_45, rel-4_4, rel-3_11, rel-1_31, rel-4_45, rel-6_51, rel-6_52, rel-6_53, rel-6_54, rel-6_55, rel-6_56, rel-6_57, rel-4_745, rel-4_901, rel-4_49, rel-4_48, rel-4_1, rel-4_2, rel-4_746, rel-5_11, rel-5_12, rel-5_15, rel-5_14, rel-5_17, rel-5_16, stack_sharing, rel-4_47, rel-4_46, rel-4_7, rel-3_501, rel-6_43, rel-6_42, rel-6_41, rel-6_47, rel-5_132, rel-5_131, rel-6_44, rel-6_49, rel-6_48, rel-4_911, rel-4_912, rel-4_31, rel-4_32, rel-4_33, rel-4_34, rel-4_35, rel-4_36, rel-4_37, HEAD |
Changes since 1.3: | +1 -1 lines |
Log Message: | *** empty log message *** |
# | User | Rev | Content |
---|---|---|---|
1 | root | 1.1 | sub statuspage { |
2 | my ($self, $verbose) = @_; | ||
3 | |||
4 | my $uptime = format_time ($::NOW - $::starttime); | ||
5 | |||
6 | my $content = <<EOF; | ||
7 | <html> | ||
8 | <head><title>Server Status Page</title></head> | ||
9 | <body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000"> | ||
10 | <h1>Server Status Page</h1> | ||
11 | root | 1.4 | <h2>$::NAME</h2> |
12 | root | 1.1 | version <b>$VERSION</b>; current:max connection count: <b>$::conns</b>:<b>$::maxconns</b>; uptime: <b>$uptime</b>;<br /> |
13 | client-id <b>$self->{remote_id}</b>; client country <b>$self->{country}</b>;<br /> | ||
14 | <h2>Queue Statistics</h2> | ||
15 | <ul> | ||
16 | EOF | ||
17 | |||
18 | for ( | ||
19 | ["download queue", $queue_file], | ||
20 | $verbose ? (["other queue", $queue_index]) | ||
21 | : (), | ||
22 | ) { | ||
23 | my ($name, $queue) = @$_; | ||
24 | my @waiters = $queue->waiters; | ||
25 | $waiters[$_]{idx} = $_ + 1 for 0..$#waiters; | ||
26 | |||
27 | if (@waiters) { | ||
28 | $content .= "<li>$name<br />".(scalar @waiters)." client(s); $queue->{started} downloads started; $queue->{slots} slots free;"; | ||
29 | |||
30 | $content .= "<p>Waiting time until download starts, estimated:<ul>"; | ||
31 | for ( | ||
32 | ["by queue average", $queue->{avgspb}], | ||
33 | $verbose ? (["by most recently started transfer", $queue->{lastspb}], | ||
34 | ["by next client in queue", $waiters[0]{spb}]) | ||
35 | : (), | ||
36 | ) { | ||
37 | my ($by, $spb) = @$_; | ||
38 | $content .= "<li>$by<br />"; | ||
39 | if ($spb) { | ||
40 | $content .= sprintf "100 KB file: <b>%s</b>; 1 MB file: <b>%s</b>; 100MB file: <b>%s</b>;", | ||
41 | format_time($spb* 100_000), | ||
42 | format_time($spb* 1_000_000), | ||
43 | format_time($spb*100_000_000); | ||
44 | } else { | ||
45 | $content .= "(unavailable)"; | ||
46 | } | ||
47 | $content .= "</li>"; | ||
48 | } | ||
49 | $content .= "</ul></p>"; | ||
50 | |||
51 | @waiters = grep { $verbose || $_->{coro}{conn}{remote_id} eq $self->{remote_id} } @waiters; | ||
52 | if (@waiters) { | ||
53 | $content .= "<table border='1' width='100%'><tr><th>#</th><th>CN</th>". | ||
54 | "<th>Remote ID</th><th>Size</th><th>Waiting</th><th>ETA</th><th>URI</th></tr>"; | ||
55 | for (@waiters) { | ||
56 | my $conn = $_->{coro}{conn}; | ||
57 | my $time = format_time ($::NOW - $_->{time}); | ||
58 | my $eta = $queue->{avgspb} * $_->{size} - ($::NOW - $_->{time}); | ||
59 | |||
60 | $content .= "<tr>". | ||
61 | "<td align='right'>$_->{idx}</td>". | ||
62 | "<td>$conn->{country}</td>". | ||
63 | "<td>$conn->{remote_id}</td>". | ||
64 | "<td align='right'>$_->{size}</td>". | ||
65 | "<td align='right'>$time</td>". | ||
66 | "<td align='right'>".($eta < 0 ? "<font color='red'>overdue</font>" : format_time $eta)."</td>". | ||
67 | "<td>".escape_html($conn->{name})."</td>". | ||
68 | "</tr>"; | ||
69 | } | ||
70 | $content .= "</table></li>"; | ||
71 | } | ||
72 | $content .= "</li>"; | ||
73 | } else { | ||
74 | $content .= "<li>$name<br />(empty)</li>"; | ||
75 | } | ||
76 | } | ||
77 | |||
78 | $content .= <<EOF; | ||
79 | </ul> | ||
80 | root | 1.2 | <h2>Active Connections</h2> |
81 | root | 1.1 | <ul> |
82 | EOF | ||
83 | |||
84 | my @data; | ||
85 | my $count = 0; | ||
86 | my $fullrate = 0; | ||
87 | |||
88 | for (values %conn::conn) { | ||
89 | for (values %$_) { | ||
90 | next unless $_; | ||
91 | $count++; | ||
92 | my $rate = sprintf "%.1f", $_->{written} / (($::NOW - $_->{time}) || 1e999); | ||
93 | $fullrate += $rate; | ||
94 | |||
95 | next unless $verbose || $_->{remote_id} eq $self->{remote_id}; | ||
96 | |||
97 | push @data, "<tr><td>$_->{country}</td><td>$_->{remote_id}</td><td align='right'>$_->{written}</td><td align='right'>$rate</td><td>$_->{method}</td><td>$_->{uri}</td></tr>"; | ||
98 | } | ||
99 | } | ||
100 | |||
101 | if (@data) { | ||
102 | $content .= "<table width='100%' border='1'><tr><th>CN</th><th>Remote ID</th><th>bytes written</th><th>bps</th><th>RM</th><th>URI</th></tr>" | ||
103 | . (join "", sort @data) | ||
104 | . "</table>"; | ||
105 | } | ||
106 | |||
107 | root | 1.3 | $content .= "<p>$count active connections, $fullrate bytes/s amortized.</p>"; |
108 | root | 1.1 | |
109 | $content .= <<EOF; | ||
110 | </ul> | ||
111 | </body> | ||
112 | </html> | ||
113 | EOF | ||
114 | |||
115 | $self->response(200, "ok", | ||
116 | { | ||
117 | "Content-Type" => "text/html", | ||
118 | "Content-Length" => length $content, | ||
119 | }, | ||
120 | $content); | ||
121 | }; | ||
122 | |||
123 | $::internal{status} = sub { statuspage($_[0], 0) }; | ||
124 | $::internal{queue} = sub { statuspage($_[0], 1) }; | ||
125 | |||
126 | 1; | ||
127 |