tests/cgi

   1 #!/usr/bin/perl -w
   2
   3 # This is part of CGI::Auth::Flexible, a perl CGI authentication module.
   4 #
   5 # Copyright 2012,2013,2015 Ian Jackson.
   6 # Copyright 2012,2013,2015 Citrix.
   7 #
   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.
  14 #
  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.
  19
  20
  21 use strict;
  22 use warnings;
  23 use CGI qw/escapeHTML/;;
  24 use CGI::Auth::Flexible;
  25 use URI;
  26 use Data::Dumper;
  27
  28 #use Carp::Always;
  29 $SIG{__DIE__} = sub { Carp::confess(@_) };
  30
  31 my $dump = $ENV{'CAFTEST_TMP'} // 'tests/tmp';
  32
  33 my $q = CGI->new;
  34
  35 my $url = $q->url();
  36
  37 $url =~ s{^\Qhttp://localhost/\E}{$ENV{CAFTEST_URLBASE}}
  38     if $ENV{'CAFTEST_URLBASE'};
  39
  40 my @verifier_params =(
  41     username_password_error => sub {
  42         my ($c,$r,$u,$p)=@_;
  43         return $p eq 'sesame' ? undef : 'wrong password'
  44     },
  45     encrypted_only => 0,
  46     promise_check_mutate => 1,
  47     dir => $dump,
  48     srcdump_filter_cwd => 0,
  49     srcdump_needlogin => 1,
  50     debug => sub { print STDERR "DEBUG ", @_[2..@_-1]; },
  51     get_url => sub { return $url },
  52 );
  53
  54 push @verifier_params, (
  55     srcdump_prepare => sub { },
  56     )
  57     if $ENV{'CAFTEST_NOSRCDUMP'};
  58
  59 my $verifier = CGI::Auth::Flexible->new_verifier(@verifier_params);
  60
  61 END { $verifier->disconnect() if $verifier; }
  62
  63 my $authreq = $verifier->new_request($q);
  64
  65 $authreq->check_ok() or exit;
  66
  67 my $cookie = $authreq->secret_cookie();
  68 my $hiddenhtml = $authreq->secret_hidden_html();
  69
  70 print <<END;
  71 Content-Type: text/html
  72 Set-Cookie: $cookie
  73
  74 <html><head><title>TITLE</title></head>
  75 <body><h1>ACCESSGRANTED</h1>
  76 END
  77
  78 my $newurl = $authreq->url_with_query_params($authreq->chain_params());
  79 my $newurl_esc = escapeHTML($newurl);
  80
  81 my $incrurl = $authreq->url_with_query_params
  82     ({ counter => [ ($q->param('counter')//0) + 1 ]});
  83 my $incrurl_esc = escapeHTML($incrurl);
  84
  85 my @critters = qw(sponges worms);
  86
  87 foreach my $make (@critters) {
  88     my $param = $q->param("test_cgi_$make");
  89     if (!$param) {
  90         print "NO-$make\n";
  91     } else {
  92         $authreq->check_mutate();
  93         print "MAKING-$make\n";
  94     }
  95 }
  96
  97 print <<END;
  98 <h1>info<h1>
  99 <pre>
 100 END
 101
 102 my $txt = Data::Dumper->Dump([$authreq->get_username(),
 103                               $q->path_info(),
 104                               $authreq->chain_params(),
 105                               scalar $q->Vars()],
 106                              [qw(username path
 107                                  authreq->chain_params() cgi->params())]);
 108 foreach my $l (split /\n/, $txt) {
 109     print escapeHTML($l),"\n";
 110 }
 111
 112 print <<END;
 113 </pre>
 114 self=<a href="$newurl_esc">$newurl_esc</a>
 115 increment=<a href="$incrurl_esc">$incrurl_esc</a>
 116 <form method="POST" action="$url">
 117 $hiddenhtml
 118 END
 119
 120 print <<END foreach @critters;
 121 <input type="submit" name="test_cgi_$_" value="Make $_">
 122 END
 123
 124 print <<END
 125 <input type="submit" name="caf_logout" value="Logout">
 126 </form>
 127 <form method="POST" action="$url/extra">
 128 $hiddenhtml
 129 <input type="submit" name="test_cgi_append" value="Append">
 130 </form>
 131 END