@EXPORT = qw();
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
- @EXPORT_OK = qw();
+ @EXPORT_OK = qw(@default_db_setup_stmts);
}
our @EXPORT_OK;
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;
}
'</address>');
}
+our @default_db_setup_stmts =
+ ("CREATE TABLE $v->{S}{assocdb_table} (".
+ " assochash VARCHAR PRIMARY KEY,".
+ " username VARCHAR NOT NULL,".
+ " last INTEGER NOT NULL".
+ ")"
+ ,
+ "CREATE INDEX $v->{S}{assocdb_table}_timeout_index".
+ " ON $v->{S}{assocdb_table}".
+ " (last)"
+ );
+
#---------- licence and source code ----------
sub srcdump_dump ($$$) {
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 ($$$$) {
assocdb_user => '',
assocdb_password => '',
assocdb_table => 'caf_assocs',
+ assocdb_setup_stmts => [@_default_db_setup_statements],
random_source => '/dev/urandom',
secretbits => 128, # bits
hash_algorithm => "SHA-256",
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), '#*#'],
}
$v->{Dbh} = $dbh;
- $v->_db_setup_do("CREATE TABLE $v->{S}{assocdb_table} (".
- " assochash VARCHAR PRIMARY KEY,".
- " username VARCHAR NOT NULL,".
- " last INTEGER NOT NULL".
- ")");
- $v->_db_setup_do("CREATE INDEX $v->{S}{assocdb_table}_timeout_index".
- " ON $v->{S}{assocdb_table}".
- " (last)");
+ foreach my $stmt (@default_db_setup_stmts) {
+ $v->_db_setup_do($stmt);
+ }
return $dbh;
}
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',
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} }) {
$r->_must_be_post();
}
-sub mutate_ok ($) {
- my ($r) = @_;
- $r->_assert_checked();
- die if $r->{Divert};
- return $r->_is_post();
-}
-
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) = @_;
+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';
- my $ent = $r->{GetNeedsSecretHidden}{$reqtype};
- return $ent if defined $ent;
+ 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";
~ian / cgi-auth-flexible.git / blobdiff