#!/usr/bin/perl -w # This is part of CGI::Auth::Flexible, a perl CGI authentication module. # # Copyright 2012,2013,2015 Ian Jackson. # Copyright 2012,2013,2015 Citrix. # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version, with the "CAF Login Exception" # as published by Ian Jackson (version 1, or at your option any # later version) as an Additional Permission. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Affero General Public License for more details. use strict; use warnings; use CGI qw/escapeHTML/;; use CGI::Auth::Flexible; use URI; use Data::Dumper; #use Carp::Always; $SIG{__DIE__} = sub { Carp::confess(@_) }; my $dump = $ENV{'CAFTEST_TMP'} // 'tests/tmp'; my $q = CGI->new; my $url = $q->url(); $url =~ s{^\Qhttp://localhost/\E}{$ENV{CAFTEST_URLBASE}} if $ENV{'CAFTEST_URLBASE'}; my @verifier_params =( username_password_error => sub { my ($c,$r,$u,$p)=@_; return $p eq 'sesame' ? undef : 'wrong password' }, encrypted_only => 0, promise_check_mutate => 1, dir => $dump, srcdump_filter_cwd => 0, srcdump_needlogin => !!$ENV{CAFTEST_SRCDUMP_NEEDLOGIN}, debug => sub { print STDERR "DEBUG ", @_[2..@_-1]; }, get_url => sub { return $url }, ); push @verifier_params, ( srcdump_prepare => sub { }, ) if $ENV{'CAFTEST_NOSRCDUMP'}; my $verifier = CGI::Auth::Flexible->new_verifier(@verifier_params); END { $verifier->disconnect() if $verifier; } my $authreq = $verifier->new_request($q); $authreq->check_ok() or exit; my $cookie = $authreq->secret_cookie(); my $hiddenhtml = $authreq->secret_hidden_html(); print <TITLE

ACCESSGRANTED

END my $newurl = $authreq->url_with_query_params($authreq->chain_params()); my $newurl_esc = escapeHTML($newurl); my $incrurl = $authreq->url_with_query_params ({ counter => [ ($q->param('counter')//0) + 1 ]}); my $incrurl_esc = escapeHTML($incrurl); my @critters = qw(sponges worms); foreach my $make (@critters) { my $param = $q->param("test_cgi_$make"); if (!$param) { print "NO-$make\n"; } else { $authreq->check_mutate(); print "MAKING-$make\n"; } } print <info

END

my $txt = Data::Dumper->Dump([$authreq->get_username(),
                              $q->path_info(),
                              $authreq->chain_params(),
                              scalar $q->Vars()],
                             [qw(username path
                                 authreq->chain_params() cgi->params())]);
foreach my $l (split /\n/, $txt) {
    print escapeHTML($l),"\n";
}

print <
self=$newurl_esc
increment=$incrurl_esc


$hiddenhtml
END

print <
END

print <



$hiddenhtml



END