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 srcdump_needlogin => !!$ENV{CAFTEST_SRCDUMP_NEEDLOGIN},
50 debug => sub { print STDERR "DEBUG ", @_[2..@_-1]; },
51 get_url => sub { return $url },
54 push @verifier_params, (
55 srcdump_prepare => sub { },
57 if $ENV{'CAFTEST_NOSRCDUMP'};
59 my $verifier = CGI::Auth::Flexible->new_verifier(@verifier_params);
61 END { $verifier->disconnect() if $verifier; }
63 my $authreq = $verifier->new_request($q);
65 $authreq->check_ok() or exit;
67 my $cookie = $authreq->secret_cookie();
68 my $hiddenhtml = $authreq->secret_hidden_html();
71 Content-Type: text/html
74 <html><head><title>TITLE</title></head>
75 <body><h1>ACCESSGRANTED</h1>
78 my $newurl = $authreq->url_with_query_params($authreq->chain_params());
79 my $newurl_esc = escapeHTML($newurl);
81 my $incrurl = $authreq->url_with_query_params
82 ({ counter => [ ($q->param('counter')//0) + 1 ]});
83 my $incrurl_esc = escapeHTML($incrurl);
85 my @critters = qw(sponges worms);
87 foreach my $make (@critters) {
88 my $param = $q->param("test_cgi_$make");
92 $authreq->check_mutate();
93 print "MAKING-$make\n";
102 my $txt = Data::Dumper->Dump([$authreq->get_username(),
104 $authreq->chain_params(),
107 authreq->chain_params() cgi->params())]);
108 foreach my $l (split /\n/, $txt) {
109 print escapeHTML($l),"\n";
114 self=<a href="$newurl_esc">$newurl_esc</a>
115 increment=<a href="$incrurl_esc">$incrurl_esc</a>
116 <form method="POST" action="$url">
120 print <<END foreach @critters;
121 <input type="submit" name="test_cgi_$_" value="Make $_">
125 <input type="submit" name="caf_logout" value="Logout">
127 <form method="POST" action="$url/extra">
129 <input type="submit" name="test_cgi_append" value="Append">