[LON-CAPA-cvs] cvs: modules /droeschl Makefile httptest.conf httptest.sample lonhttptest.pm
droeschl
droeschl at source.lon-capa.org
Thu Mar 8 00:52:24 EST 2012
droeschl Thu Mar 8 05:52:24 2012 EDT
Added files:
/modules/droeschl httptest.conf httptest.sample lonhttptest.pm
Makefile
Log:
Testing http vs lonc/lond
-------------- next part --------------
Index: modules/droeschl/httptest.conf
+++ modules/droeschl/httptest.conf
<Location /adm/httptest>
#AuthType LONCAPA
#Require valid-user
#PerlAuthzHandler Apache::lonacc
SetHandler perl-script
PerlHandler Apache::lonhttptest
ErrorDocument 403 /adm/login
ErrorDocument 413 /adm/overloaded.txt
ErrorDocument 500 " "
</Location>
Index: modules/droeschl/httptest.sample
+++ modules/droeschl/httptest.sample
#curl "http://lonvm.home.local/adm/httptest?all=1&count=100" > httptest.sample
Test done: test_lonnetPut x100
Δt [ms] Status
7.038 ok
2.632 ok
2.628 ok
3.151 ok
2.507 ok
2.444 ok
2.790 ok
2.448 ok
2.592 ok
2.713 ok
2.916 ok
2.867 ok
2.670 ok
2.632 ok
3.243 ok
3.760 ok
2.948 ok
2.300 ok
3.194 ok
2.961 ok
2.320 ok
2.267 ok
2.098 ok
2.384 ok
2.267 ok
3.457 ok
2.741 ok
2.527 ok
2.289 ok
2.194 ok
2.303 ok
2.260 ok
2.206 ok
2.631 ok
3.559 ok
3.068 ok
2.269 ok
2.357 ok
2.416 ok
2.467 ok
3.735 ok
5.571 ok
3.297 ok
2.707 ok
2.842 ok
3.100 ok
3.473 ok
3.239 ok
5.125 ok
3.076 ok
2.943 ok
2.729 ok
3.465 ok
2.569 ok
2.453 ok
2.427 ok
2.542 ok
2.617 ok
2.515 ok
2.662 ok
2.612 ok
3.626 ok
3.030 ok
3.529 ok
3.285 ok
3.573 ok
4.545 ok
2.803 ok
3.435 ok
3.121 ok
3.485 ok
3.449 ok
2.812 ok
4.439 ok
5.528 ok
3.168 ok
3.299 ok
3.365 ok
5.307 ok
2.915 ok
2.139 ok
2.283 ok
2.958 ok
3.089 ok
2.816 ok
2.493 ok
2.178 ok
2.212 ok
1.985 ok
2.951 ok
3.268 ok
3.681 ok
2.798 ok
3.092 ok
3.382 ok
3.525 ok
3.399 ok
2.407 ok
2.400 ok
2.440 ok
Δt(first request, last response) [ms]:301.822185516357
Test done: test_lonnetPutGet x100
Δt [ms] Status
44.465 ok
43.626 ok
44.142 ok
46.240 ok
44.790 ok
43.416 ok
45.841 ok
44.113 ok
46.617 ok
44.066 ok
44.608 ok
46.129 ok
44.168 ok
45.486 ok
50.953 ok
44.384 ok
43.344 ok
44.839 ok
47.171 ok
45.798 ok
46.489 ok
44.487 ok
45.968 ok
46.891 ok
45.059 ok
44.016 ok
44.708 ok
44.156 ok
44.876 ok
43.872 ok
43.757 ok
43.062 ok
44.172 ok
43.225 ok
43.712 ok
45.889 ok
44.310 ok
43.401 ok
45.184 ok
43.593 ok
43.480 ok
43.911 ok
45.429 ok
48.048 ok
46.167 ok
45.601 ok
44.061 ok
44.808 ok
43.943 ok
43.873 ok
43.462 ok
45.612 ok
45.117 ok
46.207 ok
45.816 ok
45.024 ok
43.750 ok
44.068 ok
45.738 ok
42.970 ok
45.066 ok
44.079 ok
43.891 ok
44.788 ok
45.173 ok
44.909 ok
45.943 ok
45.187 ok
44.869 ok
44.310 ok
43.081 ok
43.843 ok
43.791 ok
44.030 ok
44.042 ok
43.838 ok
43.505 ok
45.470 ok
43.907 ok
44.069 ok
44.957 ok
44.153 ok
43.818 ok
45.107 ok
43.111 ok
43.726 ok
43.549 ok
43.612 ok
42.849 ok
43.689 ok
44.221 ok
43.683 ok
44.536 ok
43.717 ok
43.730 ok
44.345 ok
43.013 ok
43.695 ok
43.366 ok
45.192 ok
Δt(first request, last response) [ms]:4459.76209640503
Test done: test_asyncHttpPut x100
Δt [ms] Status
185.443 ok
191.459 ok
201.072 ok
221.195 ok
187.012 ok
205.121 ok
178.859 ok
246.945 ok
257.044 ok
181.581 ok
219.893 ok
194.378 ok
188.609 ok
178.917 ok
182.463 ok
169.245 ok
175.994 ok
177.923 ok
246.305 ok
190.165 ok
249.939 ok
202.462 ok
275.196 ok
204.111 ok
214.861 ok
215.012 ok
225.477 ok
227.851 ok
227.877 ok
235.308 ok
235.028 ok
235.363 ok
240.830 ok
241.045 ok
252.931 ok
253.264 ok
264.164 ok
251.630 ok
264.210 ok
264.946 ok
268.694 ok
268.884 ok
268.836 ok
268.995 ok
278.279 ok
278.085 ok
278.415 ok
284.881 ok
284.930 ok
294.501 ok
296.750 ok
296.800 ok
306.491 ok
308.735 ok
308.801 ok
309.135 ok
320.370 ok
325.781 ok
326.120 ok
326.314 ok
326.084 ok
333.661 ok
333.682 ok
347.545 ok
351.057 ok
351.113 ok
351.412 ok
351.306 ok
361.578 ok
361.647 ok
361.514 ok
372.521 ok
379.151 ok
379.177 ok
379.186 ok
379.282 ok
387.910 ok
388.281 ok
400.641 ok
401.511 ok
401.538 ok
401.624 ok
407.318 ok
407.247 ok
415.522 ok
416.501 ok
412.712 ok
424.569 ok
425.786 ok
421.725 ok
429.135 ok
429.425 ok
429.425 ok
435.382 ok
435.375 ok
435.272 ok
440.328 ok
440.509 ok
449.266 ok
445.030 ok
Δt(first request, last response) [ms]:614.4859790802
Test done: test_httpPutGet x100
Δt [ms] Status
11.859 ok
7.048 ok
7.211 ok
9.788 ok
11.135 ok
10.403 ok
7.785 ok
9.382 ok
7.166 ok
8.842 ok
6.582 ok
6.160 ok
6.465 ok
6.742 ok
8.071 ok
10.917 ok
10.531 ok
10.737 ok
8.201 ok
10.415 ok
9.692 ok
8.071 ok
6.992 ok
6.957 ok
6.844 ok
6.566 ok
6.840 ok
8.254 ok
9.334 ok
11.409 ok
11.272 ok
10.171 ok
10.228 ok
7.741 ok
6.934 ok
7.142 ok
7.550 ok
7.407 ok
7.271 ok
7.926 ok
10.437 ok
11.688 ok
10.380 ok
10.542 ok
9.167 ok
8.473 ok
7.551 ok
8.135 ok
6.597 ok
9.872 ok
7.670 ok
8.538 ok
7.655 ok
8.903 ok
6.916 ok
7.630 ok
7.081 ok
7.535 ok
7.603 ok
7.664 ok
7.963 ok
9.147 ok
7.901 ok
9.560 ok
9.389 ok
8.864 ok
9.031 ok
8.059 ok
8.642 ok
7.848 ok
6.666 ok
7.521 ok
7.673 ok
8.364 ok
7.833 ok
8.387 ok
7.689 ok
7.118 ok
7.430 ok
7.879 ok
6.372 ok
6.626 ok
6.913 ok
7.868 ok
7.384 ok
6.419 ok
6.748 ok
6.946 ok
9.163 ok
6.563 ok
6.359 ok
6.919 ok
6.378 ok
8.019 ok
6.800 ok
7.265 ok
6.797 ok
6.162 ok
6.020 ok
7.469 ok
Δt(first request, last response) [ms]:816.987991333008
Test done: test_httpPut x100
Δt [ms] Status
4.036 ok
3.946 ok
5.649 ok
4.883 ok
5.595 ok
4.293 ok
3.833 ok
3.463 ok
3.654 ok
3.495 ok
3.680 ok
3.933 ok
4.545 ok
3.957 ok
3.593 ok
3.836 ok
4.294 ok
3.802 ok
4.214 ok
3.886 ok
4.521 ok
4.457 ok
4.654 ok
4.037 ok
3.611 ok
3.416 ok
4.349 ok
4.150 ok
3.959 ok
3.804 ok
4.607 ok
4.252 ok
4.793 ok
4.873 ok
4.478 ok
4.228 ok
3.959 ok
4.011 ok
4.468 ok
4.016 ok
5.247 ok
4.439 ok
5.329 ok
4.024 ok
4.226 ok
4.701 ok
3.864 ok
4.965 ok
5.096 ok
5.906 ok
6.072 ok
5.689 ok
5.220 ok
5.013 ok
5.228 ok
5.906 ok
5.826 ok
5.724 ok
6.818 ok
5.752 ok
5.781 ok
5.000 ok
5.852 ok
3.692 ok
4.520 ok
3.853 ok
3.784 ok
3.764 ok
4.327 ok
4.451 ok
5.337 ok
4.830 ok
4.080 ok
4.225 ok
3.801 ok
4.396 ok
4.072 ok
4.506 ok
4.512 ok
4.481 ok
4.670 ok
4.886 ok
4.579 ok
4.542 ok
3.994 ok
5.031 ok
3.955 ok
3.690 ok
4.189 ok
3.803 ok
4.168 ok
4.399 ok
4.927 ok
4.630 ok
3.554 ok
3.525 ok
3.510 ok
3.791 ok
4.782 ok
4.244 ok
Δt(first request, last response) [ms]:450.075149536133
Index: modules/droeschl/lonhttptest.pm
+++ modules/droeschl/lonhttptest.pm
package Apache::lonhttptest;
use strict;
use Apache::Constants qw(:common :http);
use Apache::loncommon;
use Apache::lonnet;
use LONCAPA;
use GDBM_File;
use LWP::UserAgent;
use HTTP::Async;
use HTTP::Request;
use Time::HiRes qw(time);
use List::Util qw(min max);
use vars qw($VERSION);
$VERSION = "0.01";
my $server = 'http://lonvm.home.local/adm/httptest';
my $dispatch = {};
sub handler {
my $r = shift;
Apache::loncommon::no_cache($r);
Apache::loncommon::content_type($r, 'text');
my %args = split /[=&]/, $r->args();
$args{count} //= 1;
# handler will send header
return $dispatch->{'handler_'.$args{handler}}->($r)
if exists $dispatch->{'handler_'.$args{handler}};
# no handler was invoked
$r->send_http_header;
return OK if $r->header_only;
# single tests
testreport( $r, $args{test}, $args{count}, $dispatch->{'test_'.$args{test}}->($r, $args{count}) )
if exists $dispatch->{'test_'.$args{test}};
# all tests
if($args{all}) {
testreport( $r, $_, $args{count}, $dispatch->{$_}->($r, $args{count}) ) for (grep { /^test_/ } keys(%$dispatch)) ;
}
debuginfo($r,\%args) if exists $args{debug};
# a handler was requested but not found -> error
return HTTP_INTERNAL_SERVER_ERROR if exists $args{handler};
return OK;
}
sub testreport {
my ($r, $test, $count, $result) = @_;
$r->print("Test done: $test x$count\n");
$r->print("Δt [ms]\tStatus\n");
$r->print(sprintf("%.3f\t%s\n", ($$_[1]-$$_[0])*10**3, $$_[2] ? 'ok' : 'failed')) for @$result;
$r->print("Δt(first request, last response) [ms]:" . (max(map { $$_[1] } @$result) - min(map { $$_[0] } @$result))*10**3 . "\n");
}
sub debuginfo{
my ($r, $args) = @_;
$r->print("DEBUG INFO:\n");
$r->print("\nQuery String:\n");
$r->print("$_ = $$args{$_}\n") for keys %$args;
$r->print("\nModule Versions:\n");
$r->print("Apache::lonhttptest::VERSION: ". $Apache::lonhttptest::VERSION . "\n");
$r->print("LWP::UserAgent::VERSION: ". $LWP::UserAgent::VERSION . "\n");
$r->print("HTTP::Async::VERSION: ". $HTTP::Async::VERSION . "\n");
$r->print("HTTP::Request::VERSION: ". $HTTP::Request::VERSION . "\n");
$r->print("\nRegistered tests:\n");
$r->print("$_\n") for grep { /^test_/ } keys %$dispatch;
$r->print("\nRegistered handler:\n");
$r->print($_) for grep { /^handler_/ } keys %$dispatch;
};
# Test template
# change: >name<, >outcome<
#$dispatch->{test_>name<} =
#sub {
# my ($r, $count) = @_;
# my ($t0, $t1, @ret);
#
# #set up test
#
# for(1..$count){
# $t0 = time;
#
# #run test
#
# $t1 = time;
# push @ret, [$t0, $t1, >outcome<];
# }
#
# return \@ret;
#};
$dispatch->{handler_http} =
sub {
my ($r) = @_;
#TODO remove
## echo X-Count header for async test
#$r->headers_out->set('X-Count'=>$r->headers_in->{'X-Count'} );
$r->send_http_header;
#return 0 unless $r->method eq 'PUT';
my ($user, $dom) = qw(stefan stefan);
if($r->method eq 'PUT'){
return put_user_profile_entry('put', "$dom:$user:test:".readbody($r)) ? OK : HTTP_INTERNAL_SERVER_ERROR;
}elsif($r->method eq 'GET'){
my $ret = get_profile_entry('get', "$dom:$user:test:test_http", undef);
$r->print($$ret);
return $ret ? OK : HTTP_INTERNAL_SERVER_ERROR;
}
};
$dispatch->{test_httpPut} =
sub {
my ($r, $count) = @_;
my ($t0, $t1, @ret);
my $ua = LWP::UserAgent->new();
my $req = HTTP::Request->new( 'PUT', "$server?handler=http", undef, 'test_http='.int(rand(1000)));
for(1..$count) {
my $response;
$t0 = time;
$response = $ua->request($req);
$t1 = time;
push @ret, [$t0, $t1, $response->is_success];
$req->content('test_http='.int(rand(1000)));
}
return \@ret;
};
$dispatch->{test_httpPutGet} =
sub {
my ($r, $count) = @_;
my ($t0, $t1, @ret);
my $ua = LWP::UserAgent->new();
my $data = int(rand(1000));
my $reqput = HTTP::Request->new( 'PUT', "$server?handler=http", undef, "test_http=$data");
my $reqget = HTTP::Request->new( 'GET', "$server?handler=http");
for(1..$count) {
my ($responseput, $responseget);
$t0 = time;
$responseput = $ua->request($reqput);
$responseget = $ua->request($reqget);
$t1 = time;
push @ret, [$t0, $t1, $responseput->is_success && $responseget->is_success && ($responseget->content == $data)];
$data = int(rand(1000));
$reqput->content("test_http=$data");
}
return \@ret;
};
$dispatch->{test_asyncHttpPut} =
sub {
my ($r, $count) = @_;
my ($t0, $t1, @ret);
my $async = HTTP::Async->new;
$async->poll_interval(0.003);
my $req = HTTP::Request->new( 'PUT', "$server?handler=http", undef, 'test_asyncHttp='.int(rand(1000)));
my %reqcounter;
for(1..$count){
#TODO remove
#$req->header('X-Count' => $_);
$t0 = time;
my $id = $async->add( $req );
$reqcounter{$id} = $t0;
$req->content('test_asyncHttp='.int(rand(1000)));
}
while ($async->not_empty) {
my ($response, $id) = $async->wait_for_next_response;
push @ret, [$reqcounter{$id}, time, $response->is_success];
}
return \@ret;
};
$dispatch->{test_lonnetPutGet} =
sub {
my ($r, $count) = @_;
my ($t0, $t1, @ret);
my ($user, $dom) = qw(stefan stefan);
my $data = { test => int(rand(1000))};
for (1..$count) {
my (%responseget, $responseput);
$t0 = time;
$responseput = Apache::lonnet::put('test', $data, $dom, $user);
%responseget = Apache::lonnet::get('test', [ qw(test) ], $dom, $user);
$t1 = time;
push @ret, [$t0, $t1, ($responseput eq 'ok') && ($responseget{test} == $$data{test}) ];
$data = { test => int(rand(1000)) };
}
return \@ret;
};
$dispatch->{test_lonnetPut} =
sub {
my ($r, $count) = @_;
my ($t0, $t1, @ret);
my ($user, $dom) = qw(stefan stefan);
my $data = { test => int(rand(1000))};
for (1..$count) {
my $response;
$t0 = time;
$response = Apache::lonnet::put('test', $data, $dom, $user);
$t1 = time;
push @ret, [$t0, $t1, $response eq 'ok' ];
$data = { test => int(rand(1000)) };
}
return \@ret;
};
sub readbody {
my ($r) = @_;
my $buf;
my $ret;
while($r->read($buf,512)) {
$ret .= $buf;
}
return $ret;
}
# copied from lond
sub put_user_profile_entry {
my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail";
my ($udom,$uname,$namespace,$what) =split(/:/,$tail,4);
if ($namespace ne 'roles') {
chomp($what);
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_WRCREAT(),"P",$what);
if($hashref) {
my @pairs=split(/\&/,$what);
foreach my $pair (@pairs) {
my ($key,$value)=split(/=/,$pair);
$hashref->{$key}=$value;
}
if (&untie_user_hash($hashref)) {
#&Reply( $client, "ok\n", $userinput);
} else {
return 0;
#&Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
# "while attempting put\n",
# $userinput);
}
} else {
return 0;
#&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
#"while attempting put\n", $userinput);
}
} else {
return 0;
#&Failure( $client, "refused\n", $userinput);
}
return 1;
}
sub get_profile_entry {
my ($cmd, $tail, $client) = @_;
my $userinput= "$cmd:$tail";
my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
chomp($what);
my $replystring = read_profile($udom, $uname, $namespace, $what);
my ($first) = split(/:/,$replystring);
if($first ne "error") {
#&Reply($client, \$replystring, $userinput);
return \$replystring;
} else {
#&Failure($client, $replystring." while attempting get\n", $userinput);
return 0;
}
return 1;
}
sub read_profile {
my ($udom, $uname, $namespace, $what) = @_;
my $hashref = &tie_user_hash($udom, $uname, $namespace,
&GDBM_READER());
if ($hashref) {
my @queries=split(/\&/,$what);
if ($namespace eq 'roles') {
@queries = map { &unescape($_); } @queries;
}
my $qresult='';
for (my $i=0;$i<=$#queries;$i++) {
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string.
}
$qresult=~s/\&$//; # Remove trailing & from last lookup.
if (&untie_user_hash($hashref)) {
return $qresult;
} else {
return "error: ".($!+0)." untie (GDBM) Failed";
}
} else {
if ($!+0 == 2) {
return "error:No such file or GDBM reported bad block error";
} else {
return "error: ".($!+0)." tie (GDBM) Failed";
}
}
}
1;
More information about the LON-CAPA-cvs
mailing list