sub get_params ($) {
my ($r) = @_;
- my %p;
my $c = $r->{Cgi};
- foreach my $name ($c->param()) {
- $p{$name} = [ $c->param($name) ];
+ my $vars = $c->Vars();
+ my %p;
+ foreach my $name (keys %$vars) {
+ $p{$name} = [ split "\0", $vars->{$name} ];
}
return \%p;
}
sub gen_srcdump_link_html ($$$$) {
my ($c,$r,$anchor,$specval) = @_;
my %params = ($r->{S}{srcdump_param_name} => [ $specval ]);
- return '<a href="'.escapeHTML($r->url_with_query_params(\%params)).'">'.
- $anchor."</a>";
+ return '<a href="'.
+ escapeHTML($r->url_with_query_params(\%params,'SRCDUMP')).
+ '">'.$anchor."</a>";
}
sub gen_plain_licence_link_html ($$) {
my ($c,$r) = @_;
get_path_info => sub { $_[0]->path_info() },
get_cookie => sub { $_[0]->cookie($_[1]->{S}{cookie_name}) },
get_method => sub { $_[0]->request_method() },
- check_https => sub { !!$_[0]->https() },
+ is_https => sub { !!$_[0]->https() },
get_url => sub { $_[0]->url(); },
is_login => sub { defined $_[1]->_rp('password_param_name') },
login_ok => \&login_ok_password,
};
my ($k,$v);
while (($k,$v,@_) = @_) {
- die "unknown setting $k" unless exists $verifier->{S}{$k};
+ die "unknown setting $k" unless
+ $k =~ m/^promise_/ or
+ exists $verifier->{S}{$k};
$verifier->{S}{$k} = $v;
}
bless $verifier, $class;
# pages/param-sets are
# n normal non-mutating page
-# r retrieval of information for JS, non-mutating
+# r retrieval of information for JS etc., non-mutating
# m mutating page
-# u update of information by JS, mutating
+# u update of information by JS etc., mutating
# i login
# o logout
# O "you have just logged out" page load
my $cooks = $r->_ch('get_cookie');
- if ($r->{S}{encrypted_only} && !$r->_ch('check_https')) {
+ if ($r->{S}{encrypted_only} && !$r->_ch('is_https')) {
return ({ Kind => 'REDIRECT-HTTPS',
Message => $r->_gt("Redirecting to secure server..."),
CookieSecret => undef,
die unless $parmt eq 'y';
die unless $cookh eq $parmh;
}
+ $r->{ParmT} = $parmt;
$r->{AssocSecret} = $cooks;
$r->{UserOK} = $cooku;
#print STDERR "C-D-C OK\n";
return $r->{UserOK};
}
-sub url_with_query_params ($$) {
- my ($r, $params) = @_;
+sub url_with_query_params ($$;$) {
+ my ($r, $params, $nonpagetype) = @_;
#print STDERR "PARAMS ",Dumper($params);
my $uri = URI->new($r->_ch('get_url'));
$uri->path($uri->path() . $params->{''}[0]) if $params->{''};
- $uri->query_form(flatten_params($params));
+ my @flatparams = flatten_params($params);
+ if (defined $nonpagetype && $r->need_add_hidden('GET',$nonpagetype)) {
+ push @flatparams, $r->{S}{assoc_param_name}, $r->secret_hidden_val();
+ }
+ $uri->query_form(@flatparams);
return $uri->as_string();
}
}
if ($kind =~ m/^REDIRECT-/) {
- # for redirects, we honour stored NextParams and SetCookie,
+ # for redirects, we honour stored Params and Cookie,
# as we would for non-divert
if ($kind eq 'REDIRECT-LOGGEDOUT') {
$params->{$r->{S}{loggedout_param_names}[0]} = [ 1 ];
$r->_must_be_post();
}
-sub mutate_ok ($) {
- my ($r) = @_;
+our %_resource_get_needs_secret_hidden =
+ (map { $_ => 0 } qw(PAGE FRAME IFRAME SRCDUMP STYLESHEET FAVICON ROBOTS),
+ map { $_ => 1 } qw(IMAGE SCRIPT AJAX-XML AJAX-JSON AJAX-OTHER));
+
+sub update_get_need_add_hidden ($$;$) {
+ my ($r, $reqtype, $value, $force) = @_;
+ my $hash = ref $r
+ ? ($r->{GetNeedsSecretHidden} ||= { })
+ : \%_resource_get_needs_secret_hidden;
+ return if !$force &&
+ (exists $_resource_get_needs_secret_hidden{$reqtype} ||
+ exists $hash->{$reqtype});
+ $hash->{$reqtype} = $value;
+}
+
+sub need_add_hidden ($$) {
+ my ($r, $method, $reqtype) = @_;
+ return 1 if $method ne 'GET';
+ if (ref $r) {
+ my $ent = $r->{GetNeedsSecretHidden}{$reqtype};
+ return $ent if defined $ent;
+ }
+ my $ent = $_resource_get_needs_secret_hidden{$reqtype};
+ return $ent if defined $ent;
+ die "unsupported nonpage GET type $reqtype";
+}
+
+sub check_nonpage ($$) {
+ my ($r, $reqtype) = @_;
$r->_assert_checked();
- die if $r->{Divert};
- return $r->_is_post();
+ return unless $r->resource_get_needs_secret_hidden($nonpagetype);
+ return if $r->{ParmT};
+ die "missing hidden secret parameter on nonpage request $nonpagetype";
}
#---------- output ----------
}
1;
-
-__END__
-
-=head1 NAME
-
-CGI::Auth::Flexible - web authentication optionally using cookies
-
-=head1 SYNOPSYS
-
- my $verifier = CGI::Auth::Flexible->new_verifier(setting => value,...);
- my $authreq = $verifier->new_request($cgi_query_object);
-
- # simple applications
- $authreq->check_ok() or return;
-
- # sophisticated applications
- my $divert_kind = $authreq->check_divert();
- if ($divert_kind) { ... print diversion page and quit ... }
-
- # while handling the request
- $user = $authreq->get_username();
- $authreq->check_mutate();
-
-=head1 DESCRIPTION
-
-CGI::Auth::Flexible is a library which you can use to add a
-forms/cookie-based login facility to a Perl web application.
-
-CGI::Auth::Flexible doesn't interfere with your application's URL path
-namespace and just needs a few (configurable) form parameter and
-cookie name(s) for its own use. It tries to avoid making assumptions
-about the implementation structure of your application.
-
-Because CGI::Auth::Flexible is licenced under the AGPLv3, you will
-probably need to provide a facility to allow users (even ones not
-logged in) to download the source code for your web app. Conveniently
-by default CGI::Auth::Flexible provides (for pure Perl webapps) a
-mechanism for users to get the source.
-
-CGI::Auth::Flexible is designed to try to stop you accidentally
-granting access by misunderstanding the API. (Also it, of course,
-guards against cross-site scripting.) You do need to make sure to
-call CGI::Auth::Flexible before answering AJAX requests as well as
-before generating HTML pages, of course, and to call it in every
-entrypoint to your system.
-
-=head2 INITIALISATION
-
-Your application should, on startup (eg, when it is loaded by
-mod_perl) do
-C<< $verifier = CGI::Auth::Flexible->new_verifier(settings...) >>.
-This call can be expensive and is best amortised.
-
-The resulting verifier object can be used to process individual
-requests, in each case with
-C<< $authreq = CGI::Auth::Flexible->new_request($cgi_query) >>.
-
-=head2 SIMPLE APPLICATIONS
-
-The simplist usage is to call C<< $request->check_ok() >> which will
-check the user's authentication. If the user is not logged in it will
-generate a login form (or redirection or other appropriate page) and
-return false; your application should not then processing that request
-any further. If the user is logged in it will return true.
-
-After calling C<check_ok> you can use C<< $request->get_username >>
-to find out which user the request came from.
-
-=head2 SOPHISTICATED APPLICATIONS
-
-If you want to handle the flow control and to generate login forms,
-redirections, etc., yourself, you can say
-C<< $divert = $request->check_divert >>. This returns undef if
-the user is logged in, or I<divert spec> if some kind of login
-page or diversion should be generated.
-
-=head2 GENERATING (MUTATING) FORMS AND AJAX QUERIES
-
-When you generate a C<POST> form or AJAX request you need to include a
-special secret hidden form parameter for the benefit of
-CGI::Auth::Generic. This form parameter will be checked by
-C<check_ok>/C<check_divert> and should be ignored by your application.
-
-By default its name is C<caf_assochash>. After calling C<check_ok> or
-C<check_divert> the value to put in your form can be obtained from
-C<secret_hidden_val>; C<secret_hidden_html> will generate the whole
-HTML C<< <input...> >> element.
-
-Do not put the secret value in URLs for C<GET> requests.
-
-=head2 MUTATING OPERATIONS AND EXTERNAL LINKS INTO YOUR SITE
-
-By default CGI::Auth::Flexible does not permit external links into
-your site. All GET requests give a "click to continue" page which
-submits a form. In this configuration all your application's forms
-and AJAX requests should use C<POST>.
-
-This is because the alternative (for complicated reasons relating to
-the web security architecture) is to require your application to make
-a special and different check when the incoming request is going to do
-some kind of action (such as modifying the user's setup, purchasing
-goods, or whatever) rather than just display HTML pages.
-
-To support external links, and C<GET> requests, pass C<<
-promise_check_mutate => 1 >> in I<settings>, and then call C<<
-$authreq->check_mutate() >> before taking any actions. If the
-incoming request is not suitable then C<< $authreq->check_mutate() >>
-will call C<die>. If you do this you must make sure that you have no
-mutating C<GET> requests in your application - but you shouldn't have
-any of those anyway.
-
-=head2 DATA STORAGE
-
-CGI::Auth::Flexible needs to store various information in plain files;
-it does this in the directory specified by the C<dir> parameter.
-
-It also needs to record state relating to user sessions in a database.
-There is no particular reason for this
-
-=head1 SOURCE CODE DOWNLOAD
-
-By default, CGI::Auth::Flexible provides a facility for users to
-download the source code for the running version of your web
-application.
-
-This facility makes a number of important assumptions which you need
-to check. Note that if the provided facility is not sufficient
-because your application is more sophisticated than it copes with (or
-if you disable the builtin facility), you may need to implement a
-functioning alternative to avoid violating the AGPLv3 licence.
-
-Here are the most important (default) assumptions:
-
-=over
-
-=item *
-
-Your app's source code is available by looking at @INC, $0 and
-S<$ENV{'SCRIPT_FILENAME'}> (the B<source items>). See
-C<srcdump_listitems>. Where these point to files or directories under
-revision control, the source item is the whole containing vcs tree.
-
-=item *
-
-Specifically, there are no compiled or autogenerated Perl
-files, Javascript resources, etc., which are not contained in one of
-the source item directories. (Files which came with your operating
-system install don't need to be shipped as they fall under the system
-library exceptio.)
-
-=item *
-
-You have not installed any modified versions of system
-libraries (including system-supplied) Perl modules in C</usr> outside
-C</usr/local>. See C<srcdump_system_dir>.
-
-=item *
-
-For each source item in a dvcs, the entire dvcs history does
-not contain anything confidential (or libellous). Also, all files which
-contain secrets are in the dvcs's C<.ignore> file. See
-C<srcdump_vcsscript_git> et al.
-
-=item *
-
-For each source item NOT in a dvcs, there are no confidential
-files with the world-readable bit set (being in a world-inaccessible
-directory is not sufficient). See C<srcdump_excludes>.
-
-=item *
-
-You have none of your app's source code in C</etc>.
-
-=item *
-
-You don't regard pathnames on your server as secret.
-
-=item *
-
-You don't intentionally load Perl code by virtule of C<.>
-being in C<@INC> by default. (See C<srcdump_filter_cwd>.)
-
-=back
-
-=head1 MAIN FUNCTIONS AND METHODS
-
-=over
-
-=item C<< CGI::Auth::Flexible->new_verifier(setting => value, ...) >>
-
-Initialises an instance and returns a verifier object.
-The arguments are setting pairs like a hash initialiser.
-See L</SETTINGS> below.
-
-=item C<< $verifier->new_request($cgi_query) >>
-
-Prepares to process a request. C<$cgi_query> should normally
-be the query object from L<CGI(3perl)>. Most of the default
-hook methods assume that it is; however if you replace enough of
-the hook methods then you can pass any value you like and it
-will be passed to your hooks.
-
-The return value is the authentication request object (C<$authreq>)
-which is used to check the incoming request and will contain
-information about its credentials.
-
-=item C<< $authreq->check_divert() >>
-
-Checks whether the user is logged in. Returns undef if the user is
-logged in and we should service the request. Otherwise returns a
-divert spec (see L</DIVERT SPEC>) saying what should happen instead.
-
-This method may die if it doesn't like the request, in which case
-the request needs to be rejected.
-
-=item C<< $authreq->check_ok() >>
-
-Checks whether the user is logged in. Returns true if the user is
-logged in and we should service the request.
-
-Otherwise it handles the request itself, generating any appropriate
-redirect, login form, or continuation page. It then returns false and
-the application should not process the request further.
-
-=item C<< $authreq->disconnect() >>
-
-Disconnects from the
-
-=back