1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/tools/page-loader/loader.pl Wed Dec 31 06:09:35 2014 +0100
1.3 @@ -0,0 +1,618 @@
1.4 +#!/usr/bin/perl
1.5 +#
1.6 +# This Source Code Form is subject to the terms of the Mozilla Public
1.7 +# License, v. 2.0. If a copy of the MPL was not distributed with this
1.8 +# file, You can obtain one at http://mozilla.org/MPL/2.0/.
1.9 +
1.10 +use strict;
1.11 +use CGI::Request;
1.12 +use CGI::Carp qw(fatalsToBrowser);
1.13 +use Time::HiRes qw(gettimeofday tv_interval);
1.14 +use POSIX qw(strftime);
1.15 +use DBI;
1.16 +
1.17 +# list of test pages, JS to insert, httpbase, filebase, etc.
1.18 +use PageData;
1.19 +
1.20 +use vars qw(%params $req $cgi $dbh $pagedata
1.21 + $gStartNow $gStartNowStr
1.22 + $gResponseNow $gLogging);
1.23 +
1.24 +$gStartNow = [gettimeofday]; # checkpoint the time
1.25 +$gStartNowStr = strftime "%Y%m%d%H%M%S", localtime;
1.26 +$gLogging = 1;
1.27 +
1.28 +$req = new CGI::Request; # get the HTTP/CGI request
1.29 +$cgi = $req->cgi;
1.30 +
1.31 +$pagedata = PageData->new;
1.32 +
1.33 +setDefaultParams();
1.34 +
1.35 +#XXXdebugcrap
1.36 +#warn $params{index}, " ", $params{maxidx};
1.37 +
1.38 +if (!defined($req->param('delay'))) {
1.39 + # give the user a form to pick options (but note that going
1.40 + # to "loader.pl?delay=1000" immediately starts the test run
1.41 + outputForm();
1.42 +}
1.43 +elsif (!$req->param('id')) {
1.44 + initialize(); # do redirect to start the cycle
1.45 +}
1.46 +elsif ($params{index} > $params{maxidx}) {
1.47 + redirectToReport(); # the test is over; spit out a summary
1.48 + markTestAsComplete(); # close the meta table entry
1.49 +}
1.50 +elsif (!isRequestStale()) {
1.51 + outputPage(); # otherwise, keep dishing out pages
1.52 + updateDataBase(); # client has the response; now write out stats to db
1.53 +}
1.54 +
1.55 +# cleanup
1.56 +$req = undef;
1.57 +$dbh->disconnect() if $dbh; # not strictly required (ignored in some cases anyways)
1.58 +
1.59 +#logMessage(sprintf("Page load server responded in %3d msec, total time %3d msec, pid: %d",
1.60 +# 1000*tv_interval($gStartNow, $gResponseNow), 1000*tv_interval($gStartNow), $$))
1.61 +# if $gResponseNow; # log only when a test page has been dished out
1.62 +
1.63 +exit 0;
1.64 +
1.65 +#######################################################################
1.66 +
1.67 +sub logMessage {
1.68 + print STDERR strftime("[%a %b %d %H:%M:%S %Y] ", localtime), @_, "\n"
1.69 + if $gLogging;
1.70 +}
1.71 +
1.72 +
1.73 +sub isRequestStale {
1.74 + my $limit = 30*60; # 30 minutes, although if we never stalled on mac I'd make it 3 minutes
1.75 + my $ts = decodeHiResTime($params{s_ts});
1.76 + my $delta = tv_interval($ts, $gStartNow);
1.77 + return undef if $delta < $limit;
1.78 + # otherwise, punt this request
1.79 + print "Content-type: text/html\n\n";
1.80 + print <<"ENDOFHTML";
1.81 +<html><head><title>Page Loading Times Test</title></head><body>
1.82 +<p><b>The timestamp on the request is too old to continue:<br>
1.83 +s_ts=$params{s_ts} was $delta seconds ago. Limit is $limit seconds.</b></p>
1.84 +</body></html>
1.85 +ENDOFHTML
1.86 + return 1; # it's stale
1.87 +}
1.88 +
1.89 +
1.90 +sub initialize {
1.91 + updateMetaTable();
1.92 + createDataSetTable();
1.93 +
1.94 + # start the test by bouncing off of an echo page
1.95 + my $script = $cgi->var("SCRIPT_NAME");
1.96 + my $server = $cgi->var("SERVER_NAME");
1.97 + my $proto = $ENV{SERVER_PORT} == 443 ? 'https://' : 'http://';
1.98 + my $me = $proto . $server . $script;
1.99 + $script =~ /^(.*\/).*$/;
1.100 + my $loc = "Location: ". $proto . $server . $1 . "echo.pl?";
1.101 + for (qw(id index maxcyc delay replace nocache timeout)) {
1.102 + $loc .= "$_=$params{$_}\&";
1.103 + }
1.104 + $loc .= "url=" . $me;
1.105 + print $loc, "\n\n";
1.106 +}
1.107 +
1.108 +
1.109 +sub redirectToReport {
1.110 + # n.b., can also add '&sort=1' to get a time sorted list
1.111 + my $proto = $ENV{SERVER_PORT} == 443 ? 'https://' : 'http://';
1.112 + my $loc = "Location: " . $proto . $cgi->var("SERVER_NAME");
1.113 + $cgi->var("SCRIPT_NAME") =~ /^(.*\/).*$/;
1.114 + $loc .= $1 . "report.pl?id=" . $params{id};
1.115 + # To use for a tinderbox, comment out the line above and uncomment this:
1.116 + # $loc .= $1 . "dump.pl?id=" . $params{id} . "&purge=1";
1.117 + print $loc, "\n\n";
1.118 +}
1.119 +
1.120 +
1.121 +sub generateTestId {
1.122 + # use the epoch time, in hex, plus a two-character random.
1.123 + return sprintf "%8X%02X", time(), int(256*rand());
1.124 +}
1.125 +
1.126 +
1.127 +sub setDefaultParams {
1.128 + $params{id} = $req->param('id') || generateTestId(); # "unique" id for this run
1.129 + $params{index} = $req->param('index') || 0; # request index for the test
1.130 + $params{maxcyc} = defined($req->param('maxcyc')) ?
1.131 + $req->param('maxcyc') : 3; # max visits (zero-based count)
1.132 + $params{delay} = $req->param('delay') || 1000; # setTimeout on the next request (msec)
1.133 + $params{replace} = $req->param('replace') || 0; # use Location.replace (1) or Location.href (0)
1.134 + $params{nocache} = $req->param('nocache') || 0; # serve content via uncacheable path
1.135 + $params{c_part} = $req->param('c_part') || 0; # client time elapsed; page head to onload (msec)
1.136 + $params{c_intvl} = $req->param('c_intvl') || 0; # client time elapsed; onload to onload event (msec)
1.137 + $params{c_ts} = $req->param('c_ts') || 0; # client timestamp (.getTime()) (msec)
1.138 + $params{content} = $req->param('content') || "UNKNOWN"; # name of content page for this data
1.139 + $params{s_ts} = $req->param('s_ts') || undef; # server timestamp; no default
1.140 + $params{timeout} = $req->param('timeout') || 30000; # msec; timer will cancel stalled page loading
1.141 + $params{maxidx} = ($params{maxcyc}+1) * $pagedata->length; # total pages loads to be done
1.142 + $params{curidx} = $params{index} % $pagedata->length; # current request index into page list
1.143 + $params{curcyc} = int(($params{index}-1) / $pagedata->length); # current "cycle" (visit)
1.144 +}
1.145 +
1.146 +
1.147 +sub outputPage {
1.148 + my $relpath = $pagedata->url($params{curidx});
1.149 + my $file = $pagedata->filebase . $relpath;
1.150 + open (HTML, "<$file") ||
1.151 + die "Can't open file: $file, $!";
1.152 +
1.153 + my $hook = "<script xmlns='http://www.w3.org/1999/xhtml'>\n";
1.154 + $hook .= "var g_moztest_Start = (new Date()).getTime();\n";
1.155 + $hook .= "var g_moztest_ServerTime='" . encodeHiResTime($gStartNow) . "';\n";
1.156 + $hook .= "var g_moztest_Content='" . $pagedata->name($params{curidx}) . "';\n";
1.157 + $hook .= $pagedata->clientJS; # ... and the main body
1.158 + $hook .= "var g_moztest_safetyTimer = ";
1.159 + $hook .= "window.setTimeout(moztest_safetyValve, " . $params{timeout} . ");";
1.160 + $hook .= "</script>\n";
1.161 +
1.162 + my $basepath = $pagedata->httpbase;
1.163 + $basepath =~ s/^http:/https:/i
1.164 + if $ENV{SERVER_PORT} == 443;
1.165 + #warn "basepath: $basepath";
1.166 + $basepath =~ s#^(.*?)(/base/)$#$1/nocache$2# if ($params{nocache});
1.167 + $hook .= "<base href='". $basepath . $relpath .
1.168 + "' xmlns='http://www.w3.org/1999/xhtml' />";
1.169 +
1.170 + my $magic = $pagedata->magicString;
1.171 + my $content = "";
1.172 + while (<HTML>) {
1.173 + s/$magic/$hook/;
1.174 + $content .= $_;
1.175 + }
1.176 +
1.177 + my $contentTypeHeader;
1.178 + my $mimetype = $pagedata->mimetype($params{curidx});
1.179 + my $charset = $pagedata->charset($params{curidx});
1.180 + if ($charset) {
1.181 + $contentTypeHeader = qq{Content-type: $mimetype; charset="$charset"\n\n};
1.182 + } else {
1.183 + $contentTypeHeader = qq{Content-type: $mimetype\n\n};
1.184 + }
1.185 + #warn $contentTypeHeader; #XXXjrgm testing...
1.186 +
1.187 + # N.B., these two cookie headers are obsolete, since I pass server info in
1.188 + # JS now, to work around a bug in winEmbed with document.cookie. But
1.189 + # since I _was_ sending two cookies as part of the test, I have to keep
1.190 + # sending two cookies (at least for now, and it's not a bad thing to test)
1.191 + #XXX other headers to test/use?
1.192 +
1.193 + $gResponseNow = [gettimeofday]; # for logging
1.194 + { # turn on output autoflush, locally in this block
1.195 + print "Set-Cookie: moztest_SomeRandomCookie1=somerandomstring\n";
1.196 + print "Set-Cookie: moztest_SomeRandomCookie2=somerandomstring\n";
1.197 + print $contentTypeHeader;
1.198 + local $| = 1;
1.199 + print $content;
1.200 + }
1.201 +
1.202 + return;
1.203 +}
1.204 +
1.205 +
1.206 +sub encodeHiResTime {
1.207 + my $timeref = shift;
1.208 + return unless ref($timeref);
1.209 + return $$timeref[0] . "-" . $$timeref[1];
1.210 +}
1.211 +
1.212 +
1.213 +sub decodeHiResTime {
1.214 + my $timestr = shift;
1.215 + return [ split('-', $timestr) ];
1.216 +}
1.217 +
1.218 +
1.219 +sub elapsedMilliSeconds {
1.220 + my ($r_time, $timestr) = @_;
1.221 + return "NaN" unless $timestr;
1.222 + my $delta = tv_interval( [ split('-', $timestr) ], $r_time );
1.223 + my $delta = int(($delta*1000) - $params{delay}); # adjust for delay (in msec)
1.224 + return $delta;
1.225 +}
1.226 +
1.227 +
1.228 +sub updateDataBase {
1.229 + connectToDataBase(); # (may already be cached)
1.230 + updateMetaTable();
1.231 + updateDataSetTable() unless $params{c_part} == -1; # the initial request
1.232 +}
1.233 +
1.234 +
1.235 +sub connectToDataBase {
1.236 + # don't reconnect if already connected. (Other drivers provide this
1.237 + # for free I think, but not this one).
1.238 + if (!ref($dbh)) {
1.239 + $dbh = DBI->connect("DBI:CSV:f_dir=./db", {RaiseError => 1, AutoCommit => 1})
1.240 + || die "Cannot connect: " . $DBI::errstr;
1.241 + }
1.242 +}
1.243 +
1.244 +
1.245 +#
1.246 +# Holds the individual page load data for this id.
1.247 +#
1.248 +# (Of course, this should really be a single table for all datasets, but
1.249 +# that was becoming punitively slow with DBD::CSV. I could have moved to
1.250 +# a "real" database, but I didn't want to make that a requirement for
1.251 +# installing this on another server and using this test (e.g., install a
1.252 +# few modules and you can run this; no sql installation/maintenance required).
1.253 +# At some point though, I may switch to some sql db, but hopefully still allow
1.254 +# this to be used with a simple flat file db. (Hmm, maybe I should try a *dbm
1.255 +# as a compromise (disk based but indexed)).
1.256 +#
1.257 +sub createDataSetTable {
1.258 + my $table = "t" . $params{id};
1.259 + return if -f "db/$table"; # don't create it if it exists
1.260 + logMessage("createDataSetTable:\tdb/$table");
1.261 + connectToDataBase(); # cached
1.262 +
1.263 + my ($sth, $sql);
1.264 + $sql = qq{
1.265 + CREATE TABLE $table
1.266 + (DATETIME CHAR(14),
1.267 + ID CHAR(10),
1.268 + INDEX INTEGER,
1.269 + CUR_IDX INTEGER,
1.270 + CUR_CYC INTEGER,
1.271 + C_PART INTEGER,
1.272 + S_INTVL INTEGER,
1.273 + C_INTVL INTEGER,
1.274 + CONTENT CHAR(128)
1.275 + )
1.276 + };
1.277 + $sth = $dbh->prepare($sql);
1.278 + $sth->execute();
1.279 + $sth->finish();
1.280 + return 1;
1.281 +}
1.282 +
1.283 +
1.284 +#
1.285 +# holds the information about all test runs
1.286 +#
1.287 +sub createMetaTable {
1.288 + my $table = shift;
1.289 + return if -f "db/$table"; # don't create it if it exists
1.290 + logMessage("createMetaTable:\tdb/$table");
1.291 +
1.292 + my ($sth, $sql);
1.293 +
1.294 + $sql = qq{
1.295 + CREATE TABLE $table
1.296 + (DATETIME CHAR(14),
1.297 + LASTPING CHAR(14),
1.298 + ID CHAR(8),
1.299 + INDEX INTEGER,
1.300 + CUR_IDX INTEGER,
1.301 + CUR_CYC INTEGER,
1.302 + CUR_CONTENT CHAR(128),
1.303 + STATE INTEGER,
1.304 + BLESSED INTEGER,
1.305 + MAXCYC INTEGER,
1.306 + MAXIDX INTEGER,
1.307 + REPLACE INTEGER,
1.308 + NOCACHE INTEGER,
1.309 + DELAY INTEGER,
1.310 + REMOTE_USER CHAR(16),
1.311 + HTTP_USER_AGENT CHAR(128),
1.312 + REMOTE_ADDR CHAR(15),
1.313 + USER_EMAIL CHAR(32),
1.314 + USER_COMMENT CHAR(256)
1.315 + )
1.316 + };
1.317 + $sth = $dbh->prepare($sql);
1.318 + $sth->execute();
1.319 + $sth->finish();
1.320 + warn 'created meta table';
1.321 + return 1;
1.322 +}
1.323 +
1.324 +
1.325 +sub updateMetaTable {
1.326 +
1.327 + connectToDataBase(); # if not already connected
1.328 +
1.329 + my $table = "tMetaTable";
1.330 + createMetaTable($table); # just returns if already created
1.331 +
1.332 + my ($sth, $sql);
1.333 +
1.334 + $sql = qq{
1.335 + SELECT INDEX, MAXCYC, MAXIDX, REPLACE, NOCACHE,
1.336 + DELAY, REMOTE_USER, HTTP_USER_AGENT, REMOTE_ADDR
1.337 + FROM $table
1.338 + WHERE ID = '$params{id}'
1.339 + };
1.340 + $sth = $dbh->prepare($sql);
1.341 + $sth->execute();
1.342 +
1.343 + my @dataset = ();
1.344 + while (my @data = $sth->fetchrow_array()) {
1.345 + push @dataset, {index => shift @data,
1.346 + maxcyc => shift @data,
1.347 + maxidx => shift @data,
1.348 + replace => shift @data,
1.349 + nocache => shift @data,
1.350 + delay => shift @data,
1.351 + remote_user => shift @data,
1.352 + http_user_agent => shift @data,
1.353 + remote_addr => shift @data
1.354 + };
1.355 + }
1.356 + $sth->finish();
1.357 + warn "More than one ID: $params{id} ??" if scalar(@dataset) > 1;
1.358 +
1.359 + if (scalar(@dataset) == 0) {
1.360 + # this is a new dataset and id
1.361 + initMetaTableRecord($table);
1.362 + return;
1.363 + }
1.364 +
1.365 + #XXX need to check that values are sane, and not update if they don't
1.366 + # match certain params. This should not happen in a normal test run.
1.367 + # However, if a test url was bookmarked or in history, I might get bogus
1.368 + # data collected after the fact. But I have a stale date set on the URL,
1.369 + # so that is good enough for now.
1.370 + # my $ref = shift @dataset; # check some $ref->{foo}
1.371 +
1.372 + $sql = qq{
1.373 + UPDATE $table
1.374 + SET LASTPING = ?,
1.375 + INDEX = ?,
1.376 + CUR_IDX = ?,
1.377 + CUR_CYC = ?,
1.378 + CUR_CONTENT = ?,
1.379 + STATE = ?
1.380 + WHERE ID = '$params{id}'
1.381 + };
1.382 + $sth = $dbh->prepare($sql);
1.383 + $sth->execute($gStartNowStr,
1.384 + $params{index}-1, # (index-1) is complete; (index) in progress
1.385 + ($params{curidx}-1) % $pagedata->length,
1.386 + $params{curcyc},
1.387 + $params{content},
1.388 + 'OPEN'
1.389 + );
1.390 + $sth->finish();
1.391 +
1.392 +}
1.393 +
1.394 +
1.395 +sub markTestAsComplete {
1.396 + connectToDataBase(); # if not already connected
1.397 + my $table = "tMetaTable";
1.398 + createMetaTable($table); # just returns if already created
1.399 + my ($sth, $sql);
1.400 + #XXX should probably check if this ID exists first
1.401 + $sql = qq{
1.402 + UPDATE $table
1.403 + SET STATE = "COMPLETE"
1.404 + WHERE ID = '$params{id}'
1.405 + };
1.406 + $sth = $dbh->prepare($sql);
1.407 + $sth->execute();
1.408 + $sth->finish();
1.409 +}
1.410 +
1.411 +
1.412 +sub initMetaTableRecord {
1.413 + # we know this record doesn't exist, so put in the initial values
1.414 + my $table = shift;
1.415 + my ($sth, $sql);
1.416 + $sql = qq{
1.417 + INSERT INTO $table
1.418 + (DATETIME,
1.419 + LASTPING,
1.420 + ID,
1.421 + INDEX,
1.422 + CUR_IDX,
1.423 + CUR_CYC,
1.424 + CUR_CONTENT,
1.425 + STATE,
1.426 + BLESSED,
1.427 + MAXCYC,
1.428 + MAXIDX,
1.429 + REPLACE,
1.430 + NOCACHE,
1.431 + DELAY,
1.432 + REMOTE_USER,
1.433 + HTTP_USER_AGENT,
1.434 + REMOTE_ADDR,
1.435 + USER_EMAIL,
1.436 + USER_COMMENT
1.437 + )
1.438 + VALUES (?,?,?,?,
1.439 + ?,?,?,?,
1.440 + ?,?,?,?,
1.441 + ?,?,?,?,
1.442 + ?,?,?)
1.443 + };
1.444 + $sth = $dbh->prepare($sql);
1.445 + $sth->execute($gStartNowStr,
1.446 + $gStartNowStr,
1.447 + $params{id},
1.448 + $params{index}-1,
1.449 + ($params{curidx}-1) % $pagedata->length,
1.450 + $params{curcyc},
1.451 + $params{content},
1.452 + "INIT",
1.453 + 0,
1.454 + $params{maxcyc},
1.455 + $params{maxidx},
1.456 + $params{replace},
1.457 + $params{nocache},
1.458 + $params{delay},
1.459 + $cgi->var("REMOTE_USER"),
1.460 + $cgi->var("HTTP_USER_AGENT"),
1.461 + $cgi->var("REMOTE_ADDR"),
1.462 + "",
1.463 + ""
1.464 + );
1.465 + $sth->finish();
1.466 +}
1.467 +
1.468 +
1.469 +sub updateDataSetTable {
1.470 + my $table = shift;
1.471 + my $table = "t" . $params{id};
1.472 +
1.473 + my ($sth, $sql);
1.474 + $sql = qq{
1.475 + INSERT INTO $table
1.476 + (DATETIME,
1.477 + ID,
1.478 + INDEX,
1.479 + CUR_IDX,
1.480 + CUR_CYC,
1.481 + C_PART,
1.482 + S_INTVL,
1.483 + C_INTVL,
1.484 + CONTENT
1.485 + )
1.486 + VALUES (?,?,?,?,
1.487 + ?,?,?,?,?)
1.488 + };
1.489 +
1.490 + my $s_intvl = elapsedMilliSeconds( $gStartNow, $params{s_ts} );
1.491 +
1.492 + $sth = $dbh->prepare($sql);
1.493 + $sth->execute($gStartNowStr,
1.494 + $params{id},
1.495 + $params{index}-1,
1.496 + ($params{curidx}-1) % $pagedata->length,
1.497 + $params{curcyc},
1.498 + $params{c_part},
1.499 + $s_intvl,
1.500 + $params{c_intvl},
1.501 + $req->param('content'),
1.502 + );
1.503 + $sth->finish();
1.504 +
1.505 +}
1.506 +
1.507 +
1.508 +sub outputForm {
1.509 + my @prog = split('/', $0); my $prog = $prog[$#prog];
1.510 + print "Content-type: text/html\n\n";
1.511 + my $bgcolor = $ENV{SERVER_PORT} == 443 ? '#eebb66' : '#ffffff';
1.512 + print <<"ENDOFHTML";
1.513 +<html>
1.514 +<head>
1.515 + <title>Page Loading Times Test</title>
1.516 +</head>
1.517 +<body bgcolor="$bgcolor">
1.518 + <h3>Page Loading Times Test</h3>
1.519 +
1.520 +<p>Questions: <a href="mailto:jrgm\@netscape.com">John Morrison</a>
1.521 +
1.522 +ENDOFHTML
1.523 + print " - ";
1.524 + my $script = $cgi->var("SCRIPT_NAME");
1.525 + my $server = $cgi->var("SERVER_NAME");
1.526 + # pick the "other" protocol (i.e., test is inverted)
1.527 + my $proto = $ENV{SERVER_PORT} == 443 ? 'http://' : 'https://';
1.528 + my $other = $proto . $server . $script;
1.529 + if ($ENV{SERVER_PORT} == 443) {
1.530 + print "[ <a href='$other'>With no SSL</a> | <b>With SSL</b> ]<br>";
1.531 + } else {
1.532 + print "[ <b>With no SSL</b> | <a href='$other'>With SSL</a> ]<br>";
1.533 + }
1.534 + print <<"ENDOFHTML";
1.535 +
1.536 + <form method="get" action="$prog" >
1.537 + <table border="1" cellpadding="5" cellspacing="2">
1.538 + <tr>
1.539 + <td valign="top">
1.540 + Page-load to Page-load Delay (msec):<br>
1.541 + (Use 1000. Be nice.)
1.542 + </td>
1.543 + <td valign="top">
1.544 + <select name="delay">
1.545 + <option value="0">0
1.546 + <option value="500">500
1.547 + <option selected value="1000">1000
1.548 + <option value="2000">2000
1.549 + <option value="3000">3000
1.550 + <option value="4000">4000
1.551 + <option value="5000">5000
1.552 + </select>
1.553 + </td>
1.554 + </tr>
1.555 + <tr>
1.556 + <td valign="top">
1.557 + Number of test cycles to run:<br>
1.558 + <br>
1.559 + </td>
1.560 + <td valign="top">
1.561 + <select name="maxcyc">
1.562 + <option value="0">1
1.563 + <option value="1">2
1.564 + <option value="2">3
1.565 + <option value="3">4
1.566 + <option value="4" selected>5
1.567 + <option value="5">6
1.568 + <option value="6">7
1.569 + </select>
1.570 + </td>
1.571 + </tr>
1.572 + <tr>
1.573 + <td valign="top">
1.574 + How long to wait before cancelling (msec):<br>
1.575 + (Don't change this unless on a very slow link, or very slow machine.)
1.576 + </td>
1.577 + <td valign="top">
1.578 + <select name="timeout">
1.579 + <option value="15000">15000
1.580 + <option selected value="30000">30000
1.581 + <option value="45000">45000
1.582 + <option value="60000">60000
1.583 + <option value="90000">90000
1.584 + </select>
1.585 + </td>
1.586 + </tr>
1.587 + <tr>
1.588 + <td valign="top">
1.589 + <input type="reset" value="reset">
1.590 + </td>
1.591 + <td valign="top">
1.592 + <input type="submit" value="submit">
1.593 + </td>
1.594 + </tr>
1.595 + </table>
1.596 +
1.597 +<hr>
1.598 +<p>
1.599 + You can visit the content that will be loaded, minus the embedded
1.600 + javascript, by clicking on any of the links below.
1.601 +</p>
1.602 +
1.603 + <table border="1" cellpadding="5" cellspacing="2">
1.604 +ENDOFHTML
1.605 +
1.606 + my $i;
1.607 + print "<tr>\n";
1.608 + my $base = $pagedata->httpbase;
1.609 + $base =~ s/^http:/https:/i
1.610 + if $ENV{SERVER_PORT} == 443;
1.611 + for ($i=0; $i<$pagedata->length; $i++) {
1.612 + print "<td nowrap><a href='", $base, $pagedata->url($i), "'>";
1.613 + print $pagedata->name($i);
1.614 + print "</a>\n";
1.615 + print "</tr><tr>\n" if (($i+1)%4 == 0);
1.616 + }
1.617 + print "</tr>" if (($i+1)%4 != 0);
1.618 + print "</table></form></body></html>\n";
1.619 + return;
1.620 +}
1.621 +
