Dogcows Code - chaz/p5-CGI-Ex/blob - samples/benchmark/bench_auth.pl

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 bench_auth.pl - Test relative performance of CGI::Ex::Auth
   6
   7 =head1 SAMPLE OUTPUT
   8
   9   Benchmark: running cookie_bad, cookie_good, cookie_good2, form_bad, form_good, form_good2, form_good3, form_good4 for at least 2 CPU seconds...
  10   cookie_bad:  3 wallclock secs ( 2.15 usr +  0.00 sys =  2.15 CPU) @ 6819.07/s (n=14661)
  11   cookie_good:  3 wallclock secs ( 2.01 usr +  0.08 sys =  2.09 CPU) @ 6047.85/s (n=12640)
  12   cookie_good2:  2 wallclock secs ( 1.95 usr +  0.10 sys =  2.05 CPU) @ 5087.80/s (n=10430)
  13     form_bad:  3 wallclock secs ( 2.19 usr +  0.00 sys =  2.19 CPU) @ 6542.92/s (n=14329)
  14    form_good:  3 wallclock secs ( 2.08 usr +  0.05 sys =  2.13 CPU) @ 6108.45/s (n=13011)
  15   form_good2:  3 wallclock secs ( 2.05 usr +  0.09 sys =  2.14 CPU) @ 5023.36/s (n=10750)
  16   form_good3:  3 wallclock secs ( 2.17 usr +  0.01 sys =  2.18 CPU) @ 7040.83/s (n=15349)
  17   form_good4:  3 wallclock secs ( 2.12 usr +  0.00 sys =  2.12 CPU) @ 1947.64/s (n=4129)
  18                  Rate form_good4 form_good2 cookie_good2 cookie_good form_good form_bad cookie_bad form_good3
  19   form_good4   1948/s         --       -61%         -62%        -68%      -68%     -70%       -71%       -72%
  20   form_good2   5023/s       158%         --          -1%        -17%      -18%     -23%       -26%       -29%
  21   cookie_good2 5088/s       161%         1%           --        -16%      -17%     -22%       -25%       -28%
  22   cookie_good  6048/s       211%        20%          19%          --       -1%      -8%       -11%       -14%
  23   form_good    6108/s       214%        22%          20%          1%        --      -7%       -10%       -13%
  24   form_bad     6543/s       236%        30%          29%          8%        7%       --        -4%        -7%
  25   cookie_bad   6819/s       250%        36%          34%         13%       12%       4%         --        -3%
  26   form_good3   7041/s       262%        40%          38%         16%       15%       8%         3%         --
  27
  28 =cut
  29
  30 use strict;
  31 use Benchmark qw(cmpthese timethese);
  32 use CGI::Ex::Auth;
  33 use CGI::Ex::Dump qw(debug);
  34
  35 {
  36     package Auth;
  37     use base qw(CGI::Ex::Auth);
  38     use strict;
  39     use vars qw($printed $set_cookie $deleted_cookie);
  40
  41     sub login_print      { $printed = 1 }
  42     sub set_cookie       { $set_cookie = 1 }
  43     sub delete_cookie    { $deleted_cookie = 1 }
  44     sub get_pass_by_user { '123qwe' }
  45     sub script_name      { $0 }
  46     sub no_cookie_verify { 1 }
  47     sub secure_hash_keys { ['aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa', 'bbbbbbbbbbbbbbbbbbbbbbbbbbb', 'ccc'] }
  48     sub failed_sleep     { 0 }
  49 }
  50
  51 {
  52     package Aut2;
  53     use base qw(Auth);
  54     use vars qw($crypt);
  55     BEGIN { $crypt = crypt('123qwe', 'SS') };
  56     sub use_crypt { 1 }
  57     sub get_pass_by_user { $crypt }
  58 }
  59
  60 {
  61     package Aut3;
  62     use base qw(Auth);
  63     sub use_blowfish  { "This_is_my_key" }
  64     sub use_base64    { 0 }
  65     sub use_plaintext { 1 }
  66 }
  67
  68 my $token  = Auth->new->generate_token({user => 'test', real_pass => '123qwe', use_base64 => 1});
  69 my $token2 = Aut3->new->generate_token({user => 'test', real_pass => '123qwe'});
  70
  71 my $form_bad     = { cea_user => 'test',   cea_pass => '123qw'  };
  72 my $form_good    = { cea_user => 'test',   cea_pass => '123qwe' };
  73 my $form_good2   = { cea_user => $token };
  74 my $form_good3   = { cea_user => 'test/123qwe' };
  75 my $form_good4   = { cea_user => $token2 };
  76 my $cookie_bad   = { cea_user => 'test/123qw'  };
  77 my $cookie_good  = { cea_user => 'test/123qwe' };
  78 my $cookie_good2 = { cea_user => $token };
  79
  80 sub form_good    { Auth->get_valid_auth({form => {%$form_good},  cookies => {}              }) }
  81 sub form_good2   { Auth->get_valid_auth({form => {%$form_good2}, cookies => {}              }) }
  82 sub form_good3   { Aut2->get_valid_auth({form => {%$form_good3}, cookies => {}              }) }
  83 sub form_good4   { Aut3->get_valid_auth({form => {%$form_good4}, cookies => {}              }) }
  84 sub form_bad     { Auth->get_valid_auth({form => {%$form_bad},   cookies => {}              }) }
  85 sub cookie_good  { Auth->get_valid_auth({form => {},             cookies => {%$cookie_good} }) }
  86 sub cookie_good2 { Auth->get_valid_auth({form => {},             cookies => {%$cookie_good2}}) }
  87 sub cookie_bad   { Auth->get_valid_auth({form => {},             cookies => {%$cookie_bad}  }) }
  88
  89 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
  90 die "Didn't get good auth"         if ! form_good();
  91 die "printed was set"              if $Auth::printed;
  92 die "set_cookie not called"        if ! $Auth::set_cookie;
  93 die "delete_cookie was called"     if $Auth::deleted_cookie;
  94
  95 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
  96 debug form_good2(), (my $e = $@);
  97 die "Didn't get good auth"         if ! form_good2();
  98 die "printed was set"              if $Auth::printed;
  99 die "set_cookie not called"        if ! $Auth::set_cookie;
 100 die "delete_cookie was called"     if $Auth::deleted_cookie;
 101
 102 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 103 die "Didn't get good auth"         if ! form_good3();
 104 die "printed was set"              if $Auth::printed;
 105 die "set_cookie not called"        if ! $Auth::set_cookie;
 106 die "delete_cookie was called"     if $Auth::deleted_cookie;
 107
 108 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 109 debug form_good4(), (my $e = $@);
 110 die "Didn't get good auth"         if ! form_good4();
 111 die "printed was set"              if $Auth::printed;
 112 die "set_cookie not called"        if ! $Auth::set_cookie;
 113 die "delete_cookie was called"     if $Auth::deleted_cookie;
 114
 115 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 116 die "Didn't get bad auth"          if form_bad();
 117 die "printed was not set"          if ! $Auth::printed;
 118 die "set_cookie called"            if $Auth::set_cookie;
 119 die "delete_cookie was called"     if $Auth::deleted_cookie;
 120
 121 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 122 die "Didn't get good auth"         if ! cookie_good();
 123 die "printed was set"              if $Auth::printed;
 124 die "set_cookie not called"        if ! $Auth::set_cookie;
 125 die "delete_cookie was called"     if $Auth::deleted_cookie;
 126
 127 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 128 die "Didn't get good auth"         if ! cookie_good2();
 129 die "printed was set"              if $Auth::printed;
 130 die "set_cookie not called"        if ! $Auth::set_cookie;
 131 die "delete_cookie was called"     if $Auth::deleted_cookie;
 132
 133 $Auth::printed = $Auth::set_cookie = $Auth::delete_cookie = 0;
 134 die "Didn't get bad auth"          if cookie_bad();
 135 die "printed was not set"          if ! $Auth::printed;
 136 die "set_cookie called"            if $Auth::set_cookie;
 137 die "delete_cookie was not called" if ! $Auth::deleted_cookie;
 138
 139 print "Ready\n";
 140
 141 my $r = eval { timethese (-2, {
 142     form_good    => \&form_good,
 143     form_good2   => \&form_good2,
 144     form_good3   => \&form_good3,
 145     form_good4   => \&form_good4,
 146     form_bad     => \&form_bad,
 147     cookie_good  => \&cookie_good,
 148     cookie_good2 => \&cookie_good2,
 149     cookie_bad   => \&cookie_bad,
 150 }) };
 151 if (! $r) {
 152     debug "$@";
 153     next;
 154 }
 155 eval { cmpthese $r };