Implement confirmation hash expiration

* lib/App/Sourceyard/Config/Node.pm (order, default): Fix argument
recognition.
* lib/App/Sourceyard/Config/Node/Value.pm (value): Likewise.
* lib/App/Sourceyard/ParseInterval.pm: New file.
* lib/Sourceyard/Config.pm (register.confirmation-ttl): New setting.
(_check_interval): New checker.
* lib/Sourceyard/Controller.pm (user_for_hash): New method.
* lib/Sourceyard/Controller/Account.pm: Use user_for_hash and
confirm_hash for manipulating hashes.
* lib/Sourceyard/Schema/Result/ConfirmHash.pm: Add date column (record
creation date).
* lib/Sourceyard/User.pm (confirm_hash): New method.

* lib/Sourceyard/Controller/User.pm (admin): Handle delete_hash parameter.
* templates/mail/account/recover.txt.ep: Mention the way of removing
existing password change requests.
* templates/user/admin.html.ep: List existing password request along with
a button for its deletion.

11 files changed, 205 insertions, 41 deletions

diff --git a/lib/App/Sourceyard/Config/Node.pm b/lib/App/Sourceyard/Config/Node.pm
index 3fa11e4..5a52924 100644
--- a/lib/App/Sourceyard/Config/Node.pm
+++ b/lib/App/Sourceyard/Config/Node.pm
@@ -49,7 +49,7 @@ sub locus {
 
 sub order {
     my ($self, $val) = @_;
-    if ($val) {
+    if (defined($val)) {
 	$self->{_order} = $val;
     }
     return $self->{_order} // 0;
@@ -57,7 +57,7 @@ sub order {
 
 sub default {
     my ($self, $val) = @_;
-    if ($val) {
+    if (defined($val)) {
 	$self->{_default} = $val;
     }
     return $self->{_default};
diff --git a/lib/App/Sourceyard/Config/Node/Value.pm b/lib/App/Sourceyard/Config/Node/Value.pm
index 0501704..235d835 100644
--- a/lib/App/Sourceyard/Config/Node/Value.pm
+++ b/lib/App/Sourceyard/Config/Node/Value.pm
@@ -15,7 +15,7 @@ sub new {
 sub value {
     my ($self, $val) = @_;
 
-    if ($val) {
+    if (defined($val)) {
 	$self->{_value} = $val;
 	return; # Avoid evaluatig value too early
     } else {
diff --git a/lib/App/Sourceyard/ParseInterval.pm b/lib/App/Sourceyard/ParseInterval.pm
new file mode 100644
index 0000000..b8e5458
--- /dev/null
+++ b/lib/App/Sourceyard/ParseInterval.pm
@@ -0,0 +1,93 @@
+package App::Sourceyard::ParseInterval;
+use parent 'Exporter';
+use Carp;
+
+our @EXPORT = qw(parse_interval);
+
+sub getkey {
+    my ($key, $tab) = @_;
+    return delete $tab->{$key} if exists $tab->{$key};
+    if (my @match = grep { /^$key/ } keys %$tab) {
+	getkey($match[0], $tab);
+    }
+}   
+
+=head1 NAME
+
+App::Sourceyard::ParseInterval - parse textual time interval specification    
+
+=head1 SYNOPSIS
+
+    use App::Sourceyard::ParseInterval;
+
+    $t = parse_interval($text, \$err);
+    
+=head1 DESCRIPTION
+
+Time interval specification is a string that defines an interval, much the
+same way we do this in English: it consists of one or more pairs 
+B<I<NUMBER> I<TIME_UNIT>> with optional word B<and> between them. For
+example, the following are valid interval specifications:
+
+    1 hour
+    2 hours and 35 minutes
+    1 year and 7 months 2 weeks 2 days 11 hours and 12 seconds"
+
+The pairs can occur in any order, however unusual it may sound to a human
+ear, e.g. I<2 days and 1 year>. Time units can be abbreviated. Last
+I<TIME_UNIT> can be omitted, in which case "seconds" are supposed.
+    
+The module provides a single function for parsing such specification:
+
+    parse_interval($text, \$err)
+
+The interval specification to be parsed is B<$text>. On success, the function
+returns the interval in seconds. On error, it returns B<undef> and sets
+B<$err> to the part of the input string which caused the error.    
+    
+=cut
+
+sub parse_interval {
+    my %spec = (
+	seconds => 1,
+	minutes => 60,
+	hours => 60 * 60,
+	days => 24 * 60 * 60,
+	weeks => 7 * 24 * 60 * 60,
+	months => 31 * 7 * 24 * 60 * 60,
+	years => 356 * 31 * 7 * 24 * 60 * 60
+    );
+
+    my @input = split /\s+/, shift;
+    my $err = shift;
+    my $result;
+    while (@input) {
+	my $word = lc shift @input;
+	if ($word =~ /^\d+$/) {
+	    my $term = $word;
+	    if ($word = lc shift @input) {
+		if (my $n = getkey($word, \%spec)) {
+		    $term *= $n;
+		} else {
+		    if ($err) {
+			$$err = join(' ', $word, @input);
+		    } else {
+			croak "bad time interval near "
+			      . join(' ', $word, @input);
+		    }
+		}
+	    }
+	    $result += $term;
+	    shift @input if (defined($result) && lc($input[0]) eq 'and');
+	} else {
+	    if ($err) {
+		$$err = join(' ', $word, @input);
+	    } else {
+		croak "bad time interval near " . join(' ', $word, @input);
+	    }
+	}
+    }
+    return $result;
+}
+
+1;
diff --git a/lib/Sourceyard/Config.pm b/lib/Sourceyard/Config.pm
index b4f44da..6cc024a 100644
--- a/lib/Sourceyard/Config.pm
+++ b/lib/Sourceyard/Config.pm
@@ -77,7 +77,9 @@ my %syntax = (
 		    },
 		    ptsize => { default => 20 }
 		}
-	    }
+	    },
+	    'confirmation-ttl' => { default => 2*86400,
+				    check => \&_check_interval }
         }
     },
     mail => {
@@ -229,4 +231,17 @@ sub __check_enum {
     return 1;
 }
 
+sub _check_interval {
+    my ($self, $vref, $prev, $loc) = @_;
+    require App::Sourceyard::ParseInterval;
+    my $err;
+    if (my $val = parse_interval($$vref, \$err)) {
+	$$vref = $val;
+	return 1;
+    } else {
+	$self->error("bad time interval: $err", locus => $loc);
+	return 0;
+    }
+}
+
 1;
diff --git a/lib/Sourceyard/Controller.pm b/lib/Sourceyard/Controller.pm
index ea0067f..c6dcad1 100644
--- a/lib/Sourceyard/Controller.pm
+++ b/lib/Sourceyard/Controller.pm
@@ -6,6 +6,7 @@ use Mojo::Base 'Mojolicious::Controller';
 
 use Sourceyard::User;
 use Sourceyard::Statistics;
+use DateTime;
 
 sub new {
     my $class = shift;
@@ -52,4 +53,29 @@ sub statistics {
     return $self->{_sy_stat} ||= new Sourceyard::Statistics($self);
 }
 
+sub user_for_hash {
+    my ($self, $hash) = @_;
+    my $dt = DateTime->from_epoch(
+	       epoch =>
+	        time - $self->config->get(qw(register confirmation-ttl)));
+
+    # DBI 1.622 claims that:
+    #   DBIx::Class::Storage::DBI::_gen_sql_bind(): DateTime objects passed to
+    #   search() are not supported properly (InflateColumn::DateTime formats
+    #   and settings are not respected.) See ".. format a DateTime object for
+    #   searching?" in DBIx::Class::Manual::FAQ.
+    # with the cited article proposing a Ruby Goldbergs work out. However,
+    # my tests have shown that it does work properly for the conditiion below.
+    # I preferred to silent the warning. If, however, it is discovered that the
+    # code below malfunctions, then replace the $dt below with:
+    #    $self->db->storage->datetime_parser->format_datetime($dt);
+    $ENV{DBIC_DT_SEARCH_OK} = 1;
+    my $ch = $self->db->resultset('ConfirmHash')
+	          ->search({ confirm_hash => $hash,
+			     date => { '>=', $dt } })->first;
+    $ENV{DBIC_DT_SEARCH_OK} = 0;
+    return $ch->user_id
+	if ($ch);
+}
+
 1;
diff --git a/lib/Sourceyard/Controller/Account.pm b/lib/Sourceyard/Controller/Account.pm
index 88cf3e8..349cc85 100644
--- a/lib/Sourceyard/Controller/Account.pm
+++ b/lib/Sourceyard/Controller/Account.pm
@@ -106,16 +106,12 @@ sub register {
 sub confirm {
     my $self = shift;
     my $hash = $self->stash('confirmhash');
-    my $ch = $self->db->resultset('ConfirmHash')
-	          ->search({ confirm_hash => $hash })->first;
-    if ($ch) {
-	my $user = $ch->user_id;
-	if ($user->status eq 'P') {
-	    $user->update({ status => 'A' });
-	    $ch->delete;
-	    $self->render('account/confirmed', user_name => $user->user_name);
-	    return;
-	}
+    my $user = $self->user_for_hash($hash);
+    if ($user && $user->status eq 'P') {
+	$user->update({ status => 'A' });
+	$user->confirm_hash->delete;
+	$self->render('account/confirmed', user_name => $user->user_name);
+	return;
     }
     $self->render('account/badconfirm');
 }    
@@ -130,10 +126,7 @@ sub lostpw {
 	}
 	my $user = new Sourceyard::User($self, $username);
 	if ($user) {
-	    my $hash = $user->create_hash;
-	    my $ch = $self->db->resultset('ConfirmHash')
-		          ->update_or_create({ confirm_hash => $hash },
-					     { user_id => $user->user_id });
+	    my $hash = $user->confirm_hash(1)->confirm_hash;
 	    Sourceyard::Mailer
 		->new($self,
 		      to => $user->email,
@@ -152,16 +145,12 @@ sub lostpw {
 sub recoverpw {
     my $self = shift;
     my $hash = $self->stash('confirmhash');
-    my $ch = $self->db->resultset('ConfirmHash')
-	          ->search({ confirm_hash => $hash })->first;
-    if ($ch) {
-	my $user = $ch->user_id;
-	if ($user->status eq 'A') {
-	    $self->render('account/changepw',
-			  user_name => $user->user_name,
-			  confirm_hash => $hash);
-	    return;
-	}
+    my $user = $self->user_for_hash($hash);
+    if ($user && $user->status eq 'A') {
+	$self->render('account/changepw',
+		      user_name => $user->user_name,
+		      confirm_hash => $hash);
+	return;
     }
     $self->render('account/badconfirm');
 }
@@ -183,12 +172,10 @@ sub changepw {
 
     if ($t->validate_password) {
 	if (keys(%err) == 0) {
-	    my $ch = $self->db->resultset('ConfirmHash')
-		          ->search({ confirm_hash => $hash })->first;
-	    my $user = $ch->user_id;
+	    my $user = $self->user_for_hash($hash);
 	    $user->user_pw($t->password);
 	    $user->update;
-	    $ch->delete;
+	    $user->confirm_hash->delete;
 	    $self->render('account/recovered');
 	    return;
 	}
diff --git a/lib/Sourceyard/Controller/User.pm b/lib/Sourceyard/Controller/User.pm
index 14e3fb1..fd5e282 100644
--- a/lib/Sourceyard/Controller/User.pm
+++ b/lib/Sourceyard/Controller/User.pm
@@ -81,6 +81,12 @@ sub admin {
 	    my $user = $self->stash('user');
 	    $user->update;
 	}
+	if ($self->param('delete_hash')) {
+	    my $user = $self->stash('user');
+	    $user->confirm_hash->delete;
+	    # Re-read user from the storage
+	    $user->discard_changes;
+	}
     }
     $self->render;
 }
diff --git a/lib/Sourceyard/Schema/Result/ConfirmHash.pm b/lib/Sourceyard/Schema/Result/ConfirmHash.pm
index ace5749..e173811 100644
--- a/lib/Sourceyard/Schema/Result/ConfirmHash.pm
+++ b/lib/Sourceyard/Schema/Result/ConfirmHash.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use base 'DBIx::Class::Core';
 
+__PACKAGE__->load_components(qw/ InflateColumn::DateTime Core /);
 __PACKAGE__->table('confirm_hash');
 __PACKAGE__->add_columns(
     hash_id => {
@@ -17,7 +18,11 @@ __PACKAGE__->add_columns(
     confirm_hash => {
 	data_type => 'varchar',
 	size => 128,
-    }
+    },
+    date => {
+	data_type => 'timestamp',
+	default_value => \ 'CURRENT_TIMESTAMP'
+    }    
 );
 
 __PACKAGE__->set_primary_key('hash_id');
diff --git a/lib/Sourceyard/User.pm b/lib/Sourceyard/User.pm
index 6107f0f..ce4b5ff 100644
--- a/lib/Sourceyard/User.pm
+++ b/lib/Sourceyard/User.pm
@@ -12,6 +12,7 @@ use App::Sourceyard::GPG::PublicKeySet;
 use Net::SSH::Perl::Key;
 use Try::Tiny;
 use Data::Rand::Obscure;
+use DateTime;
 
 # new(controller, username, [status])
 # new(controller, template)
@@ -68,14 +69,27 @@ sub controller {
     return $self->{_controller};
 }
 
-sub create_hash {
-    my $self = shift;
-    my $hash = Data::Rand::Obscure->new->create_hex(length => 64); 
-    $self->controller->db->resultset('ConfirmHash')
-	 ->update_or_create({ user_id => $self->user_id ,
-			      confirm_hash => $hash },
-			    { user_id => $self->user_id });
-    return $hash;
+sub confirm_hash {
+    my ($self, $create) = @_;
+    if ($create) {
+	my $hash = Data::Rand::Obscure->new->create_hex(length => 64); 
+	return $self->controller->db->resultset('ConfirmHash')
+	            ->update_or_create({ user_id => $self->user_id,
+					 confirm_hash => $hash,
+				         date => DateTime->now },
+				       { user_id => $self->user_id });
+    } else {
+	my $confirm_hash = $self->SUPER::confirm_hash;
+	if ($confirm_hash &&
+	    (DateTime->now->epoch - $confirm_hash->date->epoch) >
+	        $self->controller
+	             ->config->get(qw(register confirmation-ttl))) {
+	    $confirm_hash->delete;
+	    $self->discard_changes;
+	    return undef;
+	}
+	return $confirm_hash;
+    }
 }
 
 sub validate_real_name {
diff --git a/templates/mail/account/recover.txt.ep b/templates/mail/account/recover.txt.ep
index e5ac41d..e7d0fdb 100644
--- a/templates/mail/account/recover.txt.ep
+++ b/templates/mail/account/recover.txt.ep
@@ -13,4 +13,9 @@ Otherwise, please notify <<%= config->get(qw(mail admin_address)) %>> about the
 In any case make sure that you do not disclose this URL to somebody else. In
 particular, do not forward this mail this to a public mailing list.
 
+You can delete this password change request from your account administration
+page at <%= $self->url_for('/user/admin')->to_abs %>.
+
+
+
 
diff --git a/templates/user/admin.html.ep b/templates/user/admin.html.ep
index c1577e5..893430d 100644
--- a/templates/user/admin.html.ep
+++ b/templates/user/admin.html.ep
@@ -46,7 +46,20 @@
        will upload to your projects download area, you should add your
        ASCII GPG key here.
      </p>
+% end
+% if ($user->confirm_hash) {
+%= alt_tag div => (class => 'boxitem') => begin
+     <div class="input">
+     Password change request filed on
+      <strong>
+       <%= $user->confirm_hash->date->strftime('%a %d %b %Y %I:%M:%S %p %z') %>
+      </strong>	
+      <button class="btn" name="delete_hash" value="1">
+        Delete
+      </button>
+     </div>
 % end     
+% }     
    </div><!-- end box -->
  </div> <!-- end splitright -->