t/live_app.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4 use FindBin;
   5 use IO::Socket;
   6 use Test::More;
   7 use Test::WWW::Mechanize;
   8
   9 # plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
  10 eval "use Catalyst::Devel";
  11 plan skip_all => 'Catalyst::Devel required' if $@;
  12
  13 plan tests => 20;
  14
  15 # How long to wait for test server to start and timeout for UA.
  16 my $seconds = 30;
  17
  18 # Spawn the standalone HTTP server.
  19 my $port = 3000 + int rand(1 + 1000);
  20
  21  my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -f -p $port |";
  22
  23 # my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -f -port $port 2>&1 |";
  24
  25 my $pid = open my $server, $pipe
  26     or die "Unable to spawn standalone HTTP server: $!";
  27
  28 diag("Waiting (up to $seconds seconds) for server to start...");
  29
  30 eval {
  31     local $SIG{ALRM} = sub { die "Server took too long to start\n" }; # NB: \n required
  32     alarm($seconds);
  33
  34     while ( check_port( 'localhost', $port ) != 1 ) {
  35         sleep 1;
  36     }
  37     alarm(0)
  38 };
  39
  40 if ( $@ )
  41 {
  42     kill 'INT', $pid;
  43     close $server;
  44     die "Could not run test: $@\n$pipe";
  45 }
  46
  47 my $root = $ENV{CATALYST_SERVER} = "http://localhost:$port";
  48
  49 # Tests start --------------------------------------------
  50 ok("Started");
  51 eval {
  52
  53 my $mech = Test::WWW::Mechanize->new(timeout => $seconds);
  54
  55 $mech->get_ok($root, "GET $root");
  56 $mech->content_contains("not signed in", "Content looks right");
  57
  58 $mech->get_ok("$root/login", "GET $root/login");
  59
  60 # diag($mech->content);
  61
  62 $mech->submit_form_ok({ form_name => "login",
  63                         fields => { username => "paco",
  64                                     password => "l4s4v3n7ur45",
  65                                 },
  66                        },
  67                       "Trying cleartext login, 'memebers' realm");
  68
  69 $mech->content_contains("signed in", "Signed in successfully");
  70 $mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
  71 $mech->content_contains("Sign in with OpenID", "Content looks right");
  72
  73 my $claimed_uri = "$root/provider/paco";
  74
  75 $mech->submit_form_ok({ form_name => "openid",
  76                         fields => { openid_identifier => $claimed_uri,
  77                                   },
  78                       },
  79                       "Trying OpenID login, 'openid' realm");
  80
  81 $mech->content_contains("You did it with OpenID!",
  82                         "Successfully signed in with OpenID");
  83
  84 $mech->get_ok($root, "GET $root");
  85
  86 $mech->content_contains("provider/paco", "OpenID signed in");
  87
  88 # Bad claimed URL.
  89 $mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
  90 my $non_openid_uri = "$root/not_a_valid_openid_uri";
  91 $mech->submit_form_ok({ form_name => "openid",
  92                         fields => { openid_identifier => $non_openid_uri,
  93                                   },
  94                       },
  95                       "FAIL");
  96
  97 # Can't be verified.
  98 $mech->get_ok("$root/logout", "GET $root/logout");
  99 $mech->content_contains("You are not signed in", "Content looks right");
 100 $mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
 101 $mech->content_contains("Sign in with OpenID", "Content looks right");
 102
 103 $mech->submit_form_ok({ form_name => "openid",
 104                         fields => { openid_identifier => $claimed_uri,
 105                                 },
 106                     },
 107                       "Trying OpenID login, 'openid' realm");
 108
 109 $mech->content_contains("can't be verified",
 110                         "Proper failure for unauthenticated memember.")
 111     or diag($mech->content);
 112
 113
 114 };
 115 # Tests end ----------------------------------------------
 116
 117 <>;
 118
 119 # shut it down
 120 kill 'INT', $pid;
 121 close $server;
 122
 123 exit 0;
 124
 125 sub check_port {
 126     my ( $host, $port ) = @_;
 127
 128     my $remote = IO::Socket::INET->new(
 129         Proto    => "tcp",
 130         PeerAddr => $host,
 131         PeerPort => $port
 132     );
 133     if ($remote) {
 134         close $remote;
 135         return 1;
 136     }
 137     else {
 138         return 0;
 139     }
 140 }
 141
 142 __END__
 143
 144 #!perl
 145
 146 use strict;
 147 use warnings;
 148
 149 use FindBin;
 150 use IO::Socket;
 151 use Test::More;
 152 use Test::WWW::Mechanize;
 153
 154 # plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
 155 eval "use Catalyst::Devel 1.0";
 156 plan skip_all => 'Catalyst::Devel required' if $@;
 157
 158 plan tests => 17;
 159
 160 # How long to wait for test server to start and timeout for UA.
 161 my $seconds = 30;
 162
 163 # Spawn the standalone HTTP server.
 164 my $port = 30000 + int rand(1 + 10000);
 165
 166  my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -fork -port $port |";
 167
 168 # my $pipe = "perl -I$FindBin::Bin/../lib -I$FindBin::Bin/TestApp/lib $FindBin::Bin/TestApp/script/testapp_server.pl -f -port $port 2>&1 |";
 169
 170 my $pid = open my $server, $pipe
 171     or die "Unable to spawn standalone HTTP server: $!";
 172
 173 diag("Waiting (up to $seconds seconds) for server to start...");
 174
 175 eval {
 176     local $SIG{ALRM} = sub { die "Server took too long to start\n" }; # NB: \n required
 177     alarm($seconds);
 178
 179     while ( check_port( 'localhost', $port ) != 1 ) {
 180         sleep 1;
 181     }
 182     alarm(0)
 183 };
 184
 185 if ( $@ )
 186 {
 187     kill 'INT', $pid;
 188     close $server;
 189     die "Could not run test: $@\n$pipe";
 190 }
 191
 192 my $root = $ENV{CATALYST_SERVER} = "http://localhost:$port";
 193
 194 # Tests start --------------------------------------------
 195 ok("Started");
 196
 197
 198 my $mech = Test::WWW::Mechanize->new(timeout => $seconds);
 199
 200 $mech->get_ok($root, "GET $root");
 201 $mech->content_contains("not signed in", "Content looks right");
 202
 203 $mech->get_ok("$root/login", "GET $root/login");
 204
 205 # diag($mech->content);
 206
 207 $mech->submit_form_ok({ form_name => "login",
 208                         fields => { username => "paco",
 209                                     password => "l4s4v3n7ur45",
 210                                 },
 211                        },
 212                       "Trying cleartext login, 'memebers' realm");
 213
 214 $mech->content_contains("signed in", "Signed in successfully");
 215
 216 $mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
 217
 218 $mech->content_contains("Sign in with OpenID", "Content looks right");
 219
 220 my $claimed_uri = "$root/provider/paco";
 221
 222 $mech->submit_form_ok({ form_name => "openid",
 223                         fields => { openid_identifier => $claimed_uri,
 224                                 },
 225                     },
 226                       "Trying OpenID login, 'openid' realm");
 227
 228 $mech->content_contains("You did it with OpenID!",
 229                         "Successfully signed in with OpenID");
 230
 231 $mech->get_ok($root, "GET $root");
 232
 233 $mech->content_contains("provider/paco", "OpenID signed in");
 234 #$mech->content_contains("paco", "OpenID signed in as paco");
 235
 236 # can't be verified
 237
 238 $mech->get_ok("$root/logout", "GET $root/logout");
 239
 240 $mech->get_ok("$root/signin_openid", "GET $root/signin_openid");
 241
 242 $mech->content_contains("Sign in with OpenID", "Content looks right");
 243
 244 $mech->submit_form_ok({ form_name => "openid",
 245                         fields => { openid_identifier => $claimed_uri,
 246                                 },
 247                     },
 248                       "Trying OpenID login, 'openid' realm");
 249
 250 $mech->content_contains("can't be verified",
 251                         "Proper failure for unauthenticated memember.");
 252
 253 # Tests end ----------------------------------------------
 254
 255 # shut it down
 256 kill 'INT', $pid;
 257 close $server;
 258
 259 exit 0;
 260
 261 sub check_port {
 262     my ( $host, $port ) = @_;
 263
 264     my $remote = IO::Socket::INET->new(
 265         Proto    => "tcp",
 266         PeerAddr => $host,
 267         PeerPort => $port
 268     );
 269     if ($remote) {
 270         close $remote;
 271         return 1;
 272     }
 273     else {
 274         return 0;
 275     }
 276 }
 277
 278 __END__
 279