+# -*- perl -*-
+
+BEGIN {
+ use Exporter ();
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+ $VERSION = 1.00;
+ @ISA = qw(Exporter);
+ @EXPORT = qw();
+ %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
+
+ @EXPORT_OK = qw(setup);
+}
+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
+ );
+
+use DBI;
+
+our $dbh;
+
+sub setup {
+ my ($k,$v);
+ while (($k,$v,@_) = @_) {
+ die "unknown setting $k" unless %_s{$k};
+ $_s{$k} = $v;
+ }
+}
+
+sub _dbopen () {
+ return if $dbh;
+
+ $_s{assocdb_dsn}="dbi:SQLite:dbname=$s_{assocdb_path}"
+ if !$_s{assocdb_dsn};
+
+ my $u = umask 077;
+ $dbh = DBI->open($_s{assocdb_dsn}, $s_{assocdb_user},
+ $s_{assocdb_password}, {
+ AutoCommit => 0, RaiseError => 1,
+ });
+ die "${assocdb_dsn} $! ?" unless $dbh;
+
+ $dbh->do("BEGIN");
+
+ eval {
+ $dbh->do("CREATE TABLE $_s{assocdb_table} (".
+ " associd VARCHAR PRIMARY KEY,".
+ " username VARCHAR".
+ ")");
+ };
+}
+
+sub record_login ($) {
+ my ($nusername) = @_;
+ my $rs = new IO::File $_s{random_source}, '<'
+ or die "$_s{random_source} $!";
+ my $bytes = ($_s{associdlen} + 7) >> 3;
+ my $nassocbin;
+ $!=0;
+ read($rs,$nassocbin,$bytes) == $bytes or die "$s_{random_source} $!";
+ my $nassoc = unpack "H*", $nassocbin;
+ _dbopen();
+ $dbh->do("INSERT INTO $_s{assocdb_table}".
+ " (associd, username) VALUES (?,?)", {},
+ $nassoc, $nusername);
+ $dbh->do("COMMIT");
+ $username = $nusername;
+ $assoc = $nassoc;
+}