@ISA = qw(Exporter);
@EXPORT = qw();
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
-
- @EXPORT_OK = qw();
}
our @EXPORT_OK;
};
my %dirsdone;
foreach my $item ($v->_ch('srcdump_listitems')) {
+ next unless defined $item;
if ($item eq '.' && $v->{S}{srcdump_filter_cwd}) {
my @bad = grep { !m#^/# } values %INC;
die "filtering . from srcdump items and \@INC but already".
my $verifier = {
S => {
dir => undef,
- assocdb_dbh => undef, # must have AutoCommit=0, RaiseError=1
- assocdb_path => 'caf-assocs.db',
+ db_dbh => undef, # must have AutoCommit=0, RaiseError=1
+ db_path => 'caf.db',
keys_path => 'caf-keys',
srcdump_path => 'caf-srcdump',
- assocdb_dsn => undef,
- assocdb_user => '',
- assocdb_password => '',
- assocdb_table => 'caf_assocs',
+ db_dsn => undef,
+ db_user => '',
+ db_password => '',
+ db_prefix => 'caf',
random_source => '/dev/urandom',
secretbits => 128, # bits
hash_algorithm => "SHA-256",
},
srcdump_process_item => \&srcdump_process_item,
srcdump_vcs_dirs => [qw(.git .hg .bzr .svn)],
- srcdump_vcsscript => [git => "
+ srcdump_vcsscript => {git => "
git ls-files -z
git ls-files -z --others --exclude-from=.gitignore
find .git -print0
- "],
+ "},
srcdump_byvcs => \&srcdump_byvcs,
srcdump_novcs => \&srcdump_novcs,
srcdump_excludes => [qw(*~ *.bak *.tmp), '#*#'],
exists $verifier->{S}{$k};
$verifier->{S}{$k} = $v;
}
+ $verifier->{S}{db_setup_stmts} //=
+ ["CREATE TABLE $verifier->{S}{db_prefix}_assocs (".
+ " assochash VARCHAR PRIMARY KEY,".
+ " username VARCHAR NOT NULL,".
+ " last INTEGER NOT NULL".
+ ")"
+ ,
+ "CREATE INDEX $verifier->{S}{db_prefix}_assocs_timeout_index".
+ " ON $verifier->{S}{db_prefix}_assocs".
+ " (last)"
+ ];
bless $verifier, $class;
$verifier->_dbopen();
$verifier->_ch('srcdump_prepare');
my $dbh = $v->{Dbh};
return $dbh if $dbh;
- $dbh = $v->{S}{assocdb_dbh};
+ $dbh = $v->{S}{db_dbh};
if ($dbh) {
die if $dbh->{AutoCommit};
die unless $dbh->{RaiseError};
} else {
- $v->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=".$v->_get_path('assocdb');
- my $dsn = $v->{S}{assocdb_dsn};
+ $v->{S}{db_dsn} ||= "dbi:SQLite:dbname=".$v->_get_path('db');
+ my $dsn = $v->{S}{db_dsn};
my $u = umask 077;
- $dbh = DBI->connect($dsn, $v->{S}{assocdb_user},
- $v->{S}{assocdb_password}, {
+ $dbh = DBI->connect($dsn, $v->{S}{db_user},
+ $v->{S}{db_password}, {
AutoCommit => 0,
RaiseError => 1,
ShowErrorStatement => 1,
}
$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 (@{ $v->{S}{db_setup_stmts} }) {
+ $v->_db_setup_do($stmt);
+ }
return $dbh;
}
my ($r, $cooks) = @_;
return undef unless $cooks;
my $c = $r->{Cgi};
-my @ca = (-name => $r->{S}{cookie_name},
- -value => $cooks,
- -path => $r->{S}{cookie_path},
- -domain => $r->_ch('get_cookie_domain'),
- -expires => '+'.$r->{S}{login_timeout}.'s',
- -secure => $r->{S}{encrypted_only});
+ my @ca = (
+ -name => $r->{S}{cookie_name},
+ -value => $cooks,
+ -path => $r->{S}{cookie_path},
+ -domain => $r->_ch('get_cookie_domain'),
+ -expires => '+'.$r->{S}{login_timeout}.'s',
+ -secure => $r->{S}{encrypted_only}
+ );
my $cookie = $c->cookie(@ca);
#print STDERR "CC $r $c $cooks $cookie (@ca).\n";
return $cookie;
die if $srcdump =~ m/\W/;
return ({ Kind => 'SRCDUMP-'.uc $srcdump,
Message => undef,
- CookieSecret => undef,
+ _CookieRaw => undef,
Params => { } });
}
if ($r->{S}{encrypted_only} && !$r->_ch('is_https')) {
return ({ Kind => 'REDIRECT-HTTPS',
Message => $r->_gt("Redirecting to secure server..."),
- CookieSecret => undef,
+ _CookieRaw => undef,
Params => { } });
}
$r->_db_revoke($parmh);
return ({ Kind => 'REDIRECT-LOGGEDOUT',
Message => $r->_gt("Logging out..."),
- CookieSecret => '',
+ _CookieRaw => '',
Params => { } });
}
if ($r->_ch('is_loggedout')) {
die if $parmt;
return ({ Kind => 'SMALLPAGE-LOGGEDOUT',
Message => $r->_gt("You have been logged out."),
- CookieSecret => '',
+ _CookieRaw => '',
Params => { } });
}
if ($r->_ch('is_login')) {
Message => $r->_gt("You do not seem to have cookies".
" enabled. You must enable cookies".
" as we use them for login."),
- CookieSecret => $r->_fresh_secret(),
+ _CookieRaw => $r->_fresh_secret(),
Params => $r->_chain_params() })
}
if (!$cookt || $cookt eq 'n' || $cookh ne $parmh) {
return ({ Kind => 'LOGIN-STALE',
Message => $r->_gt("Stale session;".
" you need to log in again."),
- CookieSecret => $r->_fresh_secret(),
+ _CookieRaw => $r->_fresh_secret(),
Params => { } })
}
die unless $parmt eq 't' || $parmt eq 'y';
if !$login_errormessage;
return ({ Kind => 'LOGIN-BAD',
Message => $login_errormessage,
- CookieSecret => $cooks,
+ _CookieRaw => $cooks,
Params => $r->_chain_params() })
}
$r->_db_record_login_ok($parmh,$username);
return ({ Kind => 'REDIRECT-LOGGEDIN',
Message => $r->_gt("Logging in..."),
- CookieSecret => $cooks,
+ _CookieRaw => $cooks,
Params => $r->_chain_params() });
}
if ($cookt eq 't') {
if ($meth eq 'GET') {
return ({ Kind => 'LOGIN-INCOMINGLINK',
Message => $r->_gt("You need to log in."),
- CookieSecret => $news,
+ _CookieRaw => $news,
Params => $r->_chain_params() });
} else {
$r->_db_revoke($parmh);
return ({ Kind => 'LOGIN-FRESH',
Message => $r->_gt("You need to log in."),
- CookieSecret => $news,
+ _CookieRaw => $news,
Params => { } });
}
}
if ($meth ne 'POST') {
return ({ Kind => 'MAINPAGEONLY',
Message => $r->_gt('Entering via cross-site link.'),
- CookieSecret => $cooks,
+ _CookieRaw => $cooks,
Params => { } });
# NB caller must then ignore params & path!
# if this is too hard they can spit out a small form
my $dbh = $r->{Dbh};
- $dbh->do("DELETE FROM $r->{S}{assocdb_table}".
+ $dbh->do("DELETE FROM $r->{S}{db_prefix}_assocs".
" WHERE last < ?", {},
time - $r->{S}{login_timeout});
my $row = $dbh->selectrow_arrayref("SELECT username, last".
- " FROM $r->{S}{assocdb_table}".
+ " FROM $r->{S}{db_prefix}_assocs".
" WHERE assochash = ?", {}, $h);
if (defined $row) {
#print STDERR "_identify h=$h s=$s YES @$row\n";
my $dbh = $r->{Dbh};
- $dbh->do("DELETE FROM $r->{S}{assocdb_table}".
+ $dbh->do("DELETE FROM $r->{S}{db_prefix}_assocs".
" WHERE assochash = ?", {}, $h);
}
my ($r,$h,$user) = @_;
$r->_db_revoke($h);
my $dbh = $r->{Dbh};
- $dbh->do("INSERT INTO $r->{S}{assocdb_table}".
+ $dbh->do("INSERT INTO $r->{S}{db_prefix}_assocs".
" (assochash, username, last) VALUES (?,?,?)", {},
$h, $user, time);
}
my $dbh = $r->{Dbh};
$r->{Divert} = $r->_db_transaction(sub { $r->_check_divert_core(); });
$dbh->commit();
+
+ my $cookraw = $r->{_CookieRaw};
+ $r->{CookieSecret} = $$cookraw;
+ if ($cookraw) {
+ $r->{Params}{$r->{S}{assoc_param_name}} = [
+ $r->hash($cookraw)
+ ];
+ }
+
$r->_debug(Data::Dumper->Dump([$r->{Divert}],[qw(divert)]));
return $r->{Divert};
}
return 0;
}
- if (defined $cookiesecret) {
- $params->{$r->{S}{assoc_param_name}} = [ $r->hash($cookiesecret) ];
- }
-
my ($title, @body);
if ($kind =~ m/^LOGIN-/) {
$title = $r->_gt('Login');
sub check_nonpage ($$) {
my ($r, $reqtype) = @_;
$r->_assert_checked();
- return unless $r->resource_get_needs_secret_hidden($nonpagetype);
+ return unless $r->resource_get_needs_secret_hidden($reqtype);
return if $r->{ParmT};
- die "missing hidden secret parameter on nonpage request $nonpagetype";
+ die "missing hidden secret parameter on nonpage request $reqtype";
}
#---------- output ----------
~ian / cgi-auth-flexible.git / blobdiff