chiark / gitweb /
Add caf-srcdump to .gitignore
[cgi-auth-flexible.git] / cgi-auth-flexible.pm
index 01d7df3555fe939f23293c5fcfcaebe2d6ec0f90..284a23dcee5a9bd1c179dac330d9461bfd0dd38b 100644 (file)
@@ -31,8 +31,6 @@ BEGIN {
     @ISA         = qw(Exporter);
     @EXPORT      = qw();
     %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
-
-    @EXPORT_OK   = qw();
 }
 our @EXPORT_OK;
 
@@ -282,8 +280,9 @@ sub srcdump_novcs ($$$$$) {
 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 ($$$$) {
@@ -418,14 +417,14 @@ sub new_verifier {
     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",
@@ -478,14 +477,11 @@ sub new_verifier {
            },
            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_vcsscript_hg => "false hg",
-           srcdump_vcsscript_bzr => "false bzr",
-           srcdump_vcsscript_svn => "false svn",
+                            "],
            srcdump_byvcs => \&srcdump_byvcs,
            srcdump_novcs => \&srcdump_novcs,
            srcdump_excludes => [qw(*~ *.bak *.tmp), '#*#'],
@@ -503,6 +499,17 @@ sub new_verifier {
            exists $verifier->{S}{$k};
        $verifier->{S}{$k} = $v;
     }
+    $verifier->{S}{db_setup_stmts} //=
+       ["CREATE TABLE $v->{S}{db_prefix}_assocs (".
+        " assochash VARCHAR PRIMARY KEY,".
+        " username VARCHAR NOT NULL,".
+        " last INTEGER NOT NULL".
+        ")"
+        ,
+        "CREATE INDEX $v->{S}{db_prefix}_assocs_timeout_index".
+        " ON $v->{S}{db_prefix}_assocs".
+        " (last)"
+       ];
     bless $verifier, $class;
     $verifier->_dbopen();
     $verifier->_ch('srcdump_prepare');
@@ -525,17 +532,17 @@ sub _dbopen ($) {
     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,
@@ -545,14 +552,9 @@ sub _dbopen ($) {
     }
     $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;
 }
 
@@ -653,12 +655,14 @@ sub construct_cookie ($$$) {
     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;
@@ -834,7 +838,7 @@ sub _check_divert_core ($) {
                                          " 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);
@@ -852,13 +856,13 @@ sub _check_divert_core ($) {
             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 = '';
@@ -878,7 +882,7 @@ sub _check_divert_core ($) {
            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',
@@ -912,7 +916,14 @@ sub _check_divert_core ($) {
     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} }) {
@@ -951,12 +962,12 @@ sub _identify ($$) {
 
     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";
@@ -997,7 +1008,7 @@ sub _db_revoke ($$) {
 
     my $dbh = $r->{Dbh};
 
-    $dbh->do("DELETE FROM $r->{S}{assocdb_table}".
+    $dbh->do("DELETE FROM $r->{S}{db_prefix}_assocs".
             " WHERE assochash = ?", {}, $h);
 }
 
@@ -1005,7 +1016,7 @@ sub _db_record_login_ok ($$$) {
     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);
 }
@@ -1314,9 +1325,9 @@ sub need_add_hidden ($$) {
 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 ----------