}
our @EXPORT_OK;
-our %_s = (
- assocdb_path => 'cah-assocs.db';
- assocdb_dsn => undef,
- assocdb_user => '',
- assocdb_password => '',
- assocdb_table => 'assocs',
- random_source => '/dev/urandom',
- associdlen => 128, # bits
- param_name => 'cah_associd',
- cookie_name => 'cah_associd', # make undef to disable cookie
- param_get => sub { _c()->param($s_{param_name}) },
- cookie_get => sub { $_s{cookie_name} ? _c()->param($s_{cookie_name}) : '' },
- );
-
use DBI;
-our $dbh;
-
sub new {
+ my $class = shift;
+ my $s = {
+ S => {
+ assocdb_path => 'cah-assocs.db';
+ assocdb_dsn => undef,
+ assocdb_user => '',
+ assocdb_password => '',
+ assocdb_table => 'assocs',
+ random_source => '/dev/urandom',
+ associdlen => 128, # bits
+ param_name => 'cah_associd',
+ cookie_name => 'cah_associd', # make undef to disable cookie
+ cgi => undef,
+ param_get => sub { $s->_c()->param($s->{S}{param_name}) },
+ cookie_get => sub { $s->_c()->cookie($s->{S}{cookie_name}) : '' },
+ },
+ D => undef,
+ };
my ($k,$v);
while (($k,$v,@_) = @_) {
- die "unknown setting $k" unless %_s{$k};
- $_s{$k} = $v;
+ die "unknown setting $k" unless exists $s->{S}{$k};
+ $s->{S}{$k} = $v;
}
+ bless $s, $class;
+ return $s;
+}
+
+sub _c ($) {
+ my ($s) = @_;
+ return $s->{S}{cgi};
}
-sub _dbopen () {
- return if $dbh;
+sub _dbopen ($) {
+ my ($s) = @_;
+ my $dbh = $s->{D};
+ return $dbh if $dbh;
- $_s{assocdb_dsn}="dbi:SQLite:dbname=$s_{assocdb_path}"
- if !$_s{assocdb_dsn};
+ $s->{S}{assocdb_dsn} ||= "dbi:SQLite:dbname=$s->{S}{assocdb_path}";
my $u = umask 077;
- $dbh = DBI->open($_s{assocdb_dsn}, $s_{assocdb_user},
- $s_{assocdb_password}, {
+ $dbh = DBI->open($s->{S}{assocdb_dsn}, $s->{S}{assocdb_user},
+ $s->{S}{assocdb_password}, {
AutoCommit => 0, RaiseError => 1,
});
die "${assocdb_dsn} $! ?" unless $dbh;
+ $s->{D} = $dbh;
$dbh->do("BEGIN");
eval {
- $dbh->do("CREATE TABLE $_s{assocdb_table} (".
+ $dbh->do("CREATE TABLE $s->{S}{assocdb_table} (".
" associd VARCHAR PRIMARY KEY,".
" username VARCHAR".
")");
};
+ return $dbh;
}
-sub record_login ($) {
- my ($nusername) = @_;
- my $rs = new IO::File $_s{random_source}, '<'
- or die "$_s{random_source} $!";
- my $bytes = ($_s{associdlen} + 7) >> 3;
+sub record_login ($$) {
+ my ($s,$nusername) = @_;
+ my $rsp = $s->{S}{random_source};
+ my $rsf = new IO::File $rsp, '<' or die "$rsp $!";
+ my $bytes = ($s->{S}{associdlen} + 7) >> 3;
my $nassocbin;
$!=0;
- read($rs,$nassocbin,$bytes) == $bytes or die "$s_{random_source} $!";
+ read($rsf,$nassocbin,$bytes) == $bytes or die "$rsp $!";
+ close $rsf;
my $nassoc = unpack "H*", $nassocbin;
- _dbopen();
- $dbh->do("INSERT INTO $_s{assocdb_table}".
+ my $dbh = $s->_dbopen();
+ $dbh->do("INSERT INTO $s->{S}{assocdb_table}".
" (associd, username) VALUES (?,?)", {},
$nassoc, $nusername);
$dbh->do("COMMIT");
}
sub check () {
- my $passocid = $_s{param_get}();
- my $cassocid = $_s{cookie_get}();
+ my $passocid = $s->{S}{param_get}();
+ my $cassocid = $s->{S}{cookie_get}();
if (