chiark / gitweb /
wip before oop
[cgi-auth-flexible.git] / cgi-auth-hybrid.pm
1 # -*- perl -*-
2
3 BEGIN {
4     use Exporter   ();
5     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
6
7     $VERSION     = 1.00;
8     @ISA         = qw(Exporter);
9     @EXPORT      = qw();
10     %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
11
12     @EXPORT_OK   = qw(setup);
13 }
14 our @EXPORT_OK;
15
16 our %_s = (
17     assocdb_path => 'cah-assocs.db';
18     assocdb_dsn => undef,
19     assocdb_user => '',
20     assocdb_password => '',
21     assocdb_table => 'assocs',
22     random_source => '/dev/urandom',
23     associdlen => 128, # bits
24     param_name => 'cah_associd',
25     cookie_name => 'cah_associd', # make undef to disable cookie
26     param_get => sub { _c()->param($s_{param_name}) },
27     cookie_get => sub { $_s{cookie_name} ? _c()->param($s_{cookie_name}) : '' },
28     );
29
30 use DBI;
31
32 our $dbh;
33
34 sub new {
35     my ($k,$v);
36     while (($k,$v,@_) = @_) {
37         die "unknown setting $k" unless %_s{$k};
38         $_s{$k} = $v;
39     }
40 }
41
42 sub _dbopen () {
43     return if $dbh;
44
45     $_s{assocdb_dsn}="dbi:SQLite:dbname=$s_{assocdb_path}" 
46         if !$_s{assocdb_dsn};
47
48     my $u = umask 077;
49     $dbh = DBI->open($_s{assocdb_dsn}, $s_{assocdb_user}, 
50                      $s_{assocdb_password}, { 
51                          AutoCommit => 0, RaiseError => 1,
52                      });
53     die "${assocdb_dsn} $! ?" unless $dbh;
54
55     $dbh->do("BEGIN");
56
57     eval {
58         $dbh->do("CREATE TABLE $_s{assocdb_table} (".
59                  " associd VARCHAR PRIMARY KEY,".
60                  " username VARCHAR".
61                  ")");
62     };
63 }
64
65 sub record_login ($) {
66     my ($nusername) = @_;
67     my $rs = new IO::File $_s{random_source}, '<'
68         or die "$_s{random_source} $!";
69     my $bytes = ($_s{associdlen} + 7) >> 3;
70     my $nassocbin;
71     $!=0;
72     read($rs,$nassocbin,$bytes) == $bytes or die "$s_{random_source} $!";
73     my $nassoc = unpack "H*", $nassocbin;
74     _dbopen();
75     $dbh->do("INSERT INTO $_s{assocdb_table}".
76              " (associd, username) VALUES (?,?)", {},
77              $nassoc, $nusername);
78     $dbh->do("COMMIT");
79     $username = $nusername;
80     $assoc =    $nassoc;
81 }
82
83 sub check () {
84     my $passocid = $_s{param_get}();
85     my $cassocid = $_s{cookie_get}();
86     if (