3 # This is part of CGI::Auth::Flexible, a perl CGI authentication module.
5 # Copyright 2012,2013,2015 Ian Jackson.
6 # Copyright 2012,2013,2015 Citrix.
8 # This program is free software: you can redistribute it and/or modify
9 # it under the terms of the GNU Affero General Public License as published by
10 # the Free Software Foundation, either version 3 of the License, or
11 # (at your option) any later version, with the "CAF Login Exception"
12 # as published by Ian Jackson (version 1, or at your option any
13 # later version) as an Additional Permission.
15 # This program is distributed in the hope that it will be useful,
16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 # GNU Affero General Public License for more details.
23 use CGI qw/escapeHTML/;;
24 use CGI::Auth::Flexible;
29 $SIG{__DIE__} = sub { Carp::confess(@_) };
31 my $dump = $ENV{'CAFTEST_TMP'} // 'tests/tmp';
37 $url =~ s{^\Qhttp://localhost/\E}{$ENV{CAFTEST_URLBASE}}
38 if $ENV{'CAFTEST_URLBASE'};
40 my @verifier_params =(
41 username_password_error => sub {
43 return $p eq 'sesame' ? undef : 'wrong password'
46 promise_check_mutate => 1,
48 srcdump_filter_cwd => 0,
49 debug => sub { print STDERR "DEBUG ", @_[2..@_-1]; },
50 get_url => sub { return $url },
53 push @verifier_params, (
54 srcdump_prepare => sub { },
56 if $ENV{'CAFTEST_NOSRCDUMP'};
58 my $verifier = CGI::Auth::Flexible->new_verifier(@verifier_params);
60 END { $verifier->disconnect() if $verifier; }
62 my $authreq = $verifier->new_request($q);
64 $authreq->check_ok() or exit;
66 my $cookie = $authreq->secret_cookie();
67 my $hiddenhtml = $authreq->secret_hidden_html();
70 Content-Type: text/html
73 <html><head><title>TITLE</title></head>
74 <body><h1>ACCESSGRANTED</h1>
77 my $newurl = $authreq->url_with_query_params($authreq->chain_params());
78 my $newurl_esc = escapeHTML($newurl);
80 my $incrurl = $authreq->url_with_query_params
81 ({ counter => [ ($q->param('counter')//0) + 1 ]});
82 my $incrurl_esc = escapeHTML($incrurl);
84 my @critters = qw(sponges worms);
86 foreach my $make (@critters) {
87 my $param = $q->param("test_cgi_$make");
91 $authreq->check_mutate();
92 print "MAKING-$make\n";
101 my $txt = Data::Dumper->Dump([$authreq->get_username(),
103 $authreq->chain_params(),
106 authreq->chain_params() cgi->params())]);
107 foreach my $l (split /\n/, $txt) {
108 print escapeHTML($l),"\n";
113 self=<a href="$newurl_esc">$newurl_esc</a>
114 increment=<a href="$incrurl_esc">$incrurl_esc</a>
115 <form method="POST" action="$url">
119 print <<END foreach @critters;
120 <input type="submit" name="test_cgi_$_" value="Make $_">
124 <input type="submit" name="caf_logout" value="Logout">
126 <form method="POST" action="$url/extra">
128 <input type="submit" name="test_cgi_append" value="Append">