#!/usr/bin/perl -w 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_CAF'}/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, debug => sub { print STDERR "DEBUG ", @_[2..@_-1]; }, get_url => sub { return $url }, ); 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); print <info

END

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

print <
$newurl_esc


$hiddenhtml







$hiddenhtml



END