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) = @_;
sub srcdump_byvcs ($$$$$$) {
my ($c, $v, $dumpdir, $dir, $outfn, $vcs) = @_;
#print STDERR "BYVCS GIT $dir\n";
- return srcdump_dir_cpio($c,$v,$dumpdir,$dir,$outfn,$vcs,
- $v->{S}{"srcdump_vcsscript_$vcs"});
+ my $script = $v->{S}{"srcdump_vcsscript"}{$vcs};
+ die "no script for vcs $vcs" unless defined $script;
+ return srcdump_dir_cpio($c,$v,$dumpdir,$dir,$outfn,$vcs,$script);
}
sub srcdump_file ($$$$) {
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,
username_password_error => sub { die },
is_logout => sub { $_[1]->has_a_param('logout_param_names') },
is_loggedout => sub { $_[1]->has_a_param('loggedout_param_names') },
- is_page => sub { return 1 },
handle_divert => sub { return 0 },
do_redirect => \&do_redirect_cgi, # this hook is allowed to throw
cookie_path => "/",
$_[2] =~ m#^/etc/|^/usr/(?!local/)(?!lib/cgi)#;
},
srcdump_process_item => \&srcdump_process_item,
- srcdump_vcs_dirs => [qw(.git .hg .bzr .svn CVS)],
- srcdump_vcsscript_git => "
+ srcdump_vcs_dirs => [qw(.git .hg .bzr .svn)],
+ srcdump_vcsscript => [git => "
git ls-files -z
git ls-files -z --others --exclude-from=.gitignore
find .git -print0
- ",
- srcdump_vcsscript_hg => "false hg",
- srcdump_vcsscript_bzr => "false bzr",
- srcdump_vcsscript_svn => "false svn",
- srcdump_vcsscript_cvs => "false cvs",
+ "],
srcdump_byvcs => \&srcdump_byvcs,
srcdump_novcs => \&srcdump_novcs,
srcdump_excludes => [qw(*~ *.bak *.tmp), '#*#'],
};
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,
" enabled. You must enable cookies".
" as we use them for login."),
CookieSecret => $r->_fresh_secret(),
- Params => $r->chain_params() })
+ Params => $r->_chain_params() })
}
if (!$cookt || $cookt eq 'n' || $cookh ne $parmh) {
$r->_db_revoke($cookh);
return ({ Kind => 'LOGIN-BAD',
Message => $login_errormessage,
CookieSecret => $cooks,
- Params => $r->chain_params() })
+ Params => $r->_chain_params() })
}
$r->_db_record_login_ok($parmh,$username);
return ({ Kind => 'REDIRECT-LOGGEDIN',
Message => $r->_gt("Logging in..."),
CookieSecret => $cooks,
- Params => $r->chain_params() });
+ Params => $r->_chain_params() });
}
if ($cookt eq 't') {
$cookt = '';
return ({ Kind => 'LOGIN-INCOMINGLINK',
Message => $r->_gt("You need to log in."),
CookieSecret => $news,
- Params => $r->chain_params() });
+ Params => $r->_chain_params() });
} else {
$r->_db_revoke($parmh);
return ({ Kind => 'LOGIN-FRESH',
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 undef;
}
-sub chain_params ($) {
+sub _chain_params ($) {
+# =item C<< $authreq->_chain_params() >>
+#
+# Returns a hash of the "relevant" parameters to this request, in a form
+# used by C<url_with_query_params>. This is all of the query parameters
+# which are not related to CGI::Auth::Flexible. The PATH_INFO from the
+# request is returned as the parameter C<< '' >>.
+
my ($r) = @_;
my %p = %{ $r->_ch('get_params') };
foreach my $pncn (keys %{ $r->{S} }) {
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.
-
-=head1 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) >>.
-
-=head1 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.
-
-=head1 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.
-
-=head1 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.
-
-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, 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.
-
-=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 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.
-
-=back
~ian / cgi-auth-flexible.git / blobdiff