Coro/myhttpd/internal.pl

sub statuspage {
   my ($self, $verbose) = @_;

   my $uptime = format_time ($::NOW - $::starttime);
   
   my $content = <<EOF;
<html>
<head><title>Server Status Page</title></head>
<body bgcolor="#ffffff" text="#000000" link="#0000ff" vlink="#000080" alink="#ff0000">
<h1>Server Status Page</h1>
<h2>$::NAME</h2>
version <b>$VERSION</b>; current:max connection count: <b>$::conns</b>:<b>$::maxconns</b>; uptime: <b>$uptime</b>;<br />
client-id <b>$self->{remote_id}</b>; client country <b>$self->{country}</b>;<br />
<h2>Queue Statistics</h2>
<ul>
EOF

   for (
         ["download queue", $queue_file],
         $verbose ? (["other queue",    $queue_index])
                  : (),
   ) {
      my ($name, $queue) = @$_;
      my @waiters = $queue->waiters;
      $waiters[$_]{idx} = $_ + 1 for 0..$#waiters;

      if (@waiters) {
         $content .= "<li>$name<br />".(scalar @waiters)." client(s); $queue->{started} downloads started; $queue->{slots} slots free;";
         
         $content .= "<p>Waiting time until download starts, estimated:<ul>";
         for (
               ["by queue average", $queue->{avgspb}],
               $verbose ? (["by most recently started transfer", $queue->{lastspb}],
                           ["by next client in queue", $waiters[0]{spb}])
                        : (),
         ) {
            my ($by, $spb) = @$_;
            $content .= "<li>$by<br />";
            if ($spb) {
               $content .= sprintf "100 KB file: <b>%s</b>; 1 MB file: <b>%s</b>; 100MB file: <b>%s</b>;",
                                   format_time($spb*    100_000),
                                   format_time($spb*  1_000_000),
                                   format_time($spb*100_000_000);
            } else {
               $content .= "(unavailable)";
            }
            $content .= "</li>";
         }
         $content .= "</ul></p>";

         @waiters = grep { $verbose || $_->{coro}{conn}{remote_id} eq $self->{remote_id} } @waiters;
         if (@waiters) {
            $content .= "<table border='1' width='100%'><tr><th>#</th><th>CN</th>".
                        "<th>Remote ID</th><th>Size</th><th>Waiting</th><th>ETA</th><th>URI</th></tr>";
            for (@waiters) {
               my $conn = $_->{coro}{conn};
               my $time = format_time ($::NOW - $_->{time});
               my $eta  = $queue->{avgspb} * $_->{size} - ($::NOW - $_->{time});

               $content .= "<tr>".
                           "<td align='right'>$_->{idx}</td>".
                           "<td>$conn->{country}</td>".
                           "<td>$conn->{remote_id}</td>".
                           "<td align='right'>$_->{size}</td>".
                           "<td align='right'>$time</td>".
                           "<td align='right'>".($eta < 0 ? "<font color='red'>overdue</font>" : format_time $eta)."</td>".
                           "<td>".escape_html($conn->{name})."</td>".
                           "</tr>";
            }
            $content .= "</table></li>";
         }
         $content .= "</li>";
      } else {
         $content .= "<li>$name<br />(empty)</li>";
      }
   }

   $content .= <<EOF;
</ul>
<h2>Active Connections</h2>
<ul>
EOF

   my @data;
   my $count = 0;
   my $fullrate = 0;

   for (values %conn::conn) {
      for (values %$_) {
         next unless $_;
         $count++;
         my $rate = sprintf "%.1f", $_->{written} / (($::NOW - $_->{time}) || 1e999);
         $fullrate += $rate;

         next unless $verbose || $_->{remote_id} eq $self->{remote_id};
         
         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>";
      }
   }

   if (@data) {
      $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>"
                . (join "", sort @data)
                . "</table>";
   }

   $content .= "<p>$count active connections, $fullrate bytes/s amortized.</p>";

   $content .= <<EOF;
</ul>
</body>
</html>
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;

Revision:	1.4
Committed:	Mon Jul 29 21:41:54 2002 UTC (24 years, 2 months 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