--- a/index.cgi Tue Jul 05 00:52:20 2011 +0200
+++ b/index.cgi Wed Jul 06 00:20:32 2011 +0200
@@ -20,6 +20,9 @@
sub confirm($$);
sub read_conf($);
+sub do_invite($);
+sub do_show($$);
+
delete @ENV{grep /PATH$/ => keys %ENV};
$ENV{PATH} = "/usr/bin:/usr/sbin:/bin:/sbin";
@@ -63,64 +66,22 @@
# encrypted current timestamp. Accessing the form is only possible
# using this link. Note: These links may not be unique!
if (!path_info()) {
- my %warn;
- my $sent;
-
- if (param("mail")) {
- if (not valid param("mail")) {
- $warn{mail} = "INVALID";
- }
- else {
- my $xxx = encrypt(time);
- $xxx =~ s/\+/-/g;
- $xxx =~ s/\//_/g;
-
- # send mail
- open(my $sendmail => "|$SENDMAIL")
- or die "Can't open sendmail: $!\n";
-
- $tt->process("mail.invitation.tpl", {
- to => scalar(param("mail")),
- url => "$SELF/$xxx.tmp"}, $sendmail)
- or die $tt->error();
- close($sendmail)
- or die "problem sending mail to "
- . param("mail");
-
- $sent = param("mail");
- }
- }
- $tt->process("html.invitation.tpl", {
- sent => $sent,
- warn => %warn ? \%warn : undef,
- expires => $EXPIRATION,
- value => { mail => scalar param("mail") },
- });
+ do_invite($tt);
exit 0;
}
- # /<uuid>.tmp
- # /<uuid>.user
-
- # No access without correct path_info
- if (path_info() =~ /^\/?(.*)\.tmp$/) {
- my $_ = $1;
- s/_/\//g;
- s/-/+/g;
- eval {
- my $time = decrypt($_) or die "DECRYPTION ERROR";
- $time =~ /^\d+$/ or die "FORMAT ERROR";
- time() - $time < (60 * $EXPIRATION) or die "EXPIRED";
- };
- if ($@) {
- $tt->process("html.denied.tpl", {
- url => $SELF,
- }) or die $tt->error();
+ # /show/(…)
+ if (path_info() =~ /^\/?show\/(.*)$/) {
+ if ($1 ~~ [qw(info)]) {
+ do_show($tt, $1);
exit 0;
}
+ $tt->process("html.denied.tpl");
+ exit 0;
}
- if (path_info() =~ /^\/?(.*)\.user$/) {
+ # /user.<uuid>
+ if (path_info() =~ /^\/?user\.(.*)$/) {
my $uuid = $1;
my $confirmed = param("confirm") eq "yes";
my %data = confirm($uuid => $confirmed);
@@ -141,83 +102,98 @@
exit 0;
}
- ### all went fine, we start processing
- ### the form
-
- my %warn;
- my %value;
-
- ## Input
- if (param("clear")) {
- Delete_all();
- }
-
- # Submission
- if (param("submit")) {
- foreach my $param (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}) {
+ # /tmp.<uuid>
+ if (path_info() =~ /^\/?tmp\.(.*)$/) {
+ my $_ = $1;
+ s/_/\//g;
+ s/-/+/g;
- # strip away spaces to "untaint" the variables, additionally
- # limit the length
- my $_ = param($param);
- /^\s*(.*)\s*$/;
-
- if (!length $1 and $param ~~ @{$FIELDS{MAN}}) {
- push @{$warn{$param}}, "Leer!?";
- }
-
- if (length $1 > 200) {
- push @{$warn{$param}}, "Zu lang (bitte weniger als 200 Zeichen).";
- }
-
- param(-name => $param, value => $1);
- $value{$param} = $1;
+ eval {
+ my $time = decrypt($_) or die "DECRYPTION ERROR";
+ $time =~ /^\d+$/ or die "FORMAT ERROR";
+ time() - $time < (60 * $EXPIRATION) or die "EXPIRED";
+ }; if ($@) {
+ $tt->process("html.denied.tpl");
+ exit 0;
}
- # Mail needs extra check
- if ($value{mail} and not valid($value{mail})) {
- push @{$warn{mail}}, "Keine gültig erscheinende Mail-Adresse.";
+ my %warn;
+ my %value;
+
+ if (param("clear")) {
+ Delete_all();
}
- foreach (keys %warn) {
- $warn{$_} = join " ", @{$warn{$_}};
+ # Submission
+ if (param("submit")) {
+ foreach my $param (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}) {
+
+ # strip away spaces to "untaint" the variables, additionally
+ # limit the length
+ my $_ = param($param);
+ /^\s*(.*)\s*$/;
+
+ if (!length $1 and $param ~~ @{$FIELDS{MAN}}) {
+ push @{$warn{$param}}, "Leer!?";
+ }
+
+ if (length $1 > 200) {
+ push @{$warn{$param}}, "Zu lang (bitte weniger als 200 Zeichen).";
+ }
+
+ param(-name => $param, value => $1);
+ $value{$param} = $1;
+ }
+
+ # Mail needs extra check
+ if ($value{mail} and not valid($value{mail})) {
+ push @{$warn{mail}}, "Keine gültig erscheinende Mail-Adresse.";
+ }
+
+ foreach (keys %warn) {
+ $warn{$_} = join " ", @{$warn{$_}};
+ }
+
+ if (!%warn) {
+ my %r = insert(%value);
+
+ open(my $sendmail => "|$SENDMAIL")
+ or die "Can't open $SENDMAIL: $!\n";
+
+ $tt->process("mail.form-ack.tpl", {
+ to => $value{mail},
+ url => {
+ yes => "$SELF/user.$r{uuid}?confirm=yes",
+ no => "$SELF/user.$r{uuid}?confirm=no",
+ }
+ }, $sendmail)
+ or die $tt->error();
+
+ close($sendmail);
+
+ $tt->process("html.form-ack.tpl", {
+ value => \%value,
+ created => $r{created},
+ uuid => $r{uuid},
+ }) or die $tt->error();
+ exit 0;
+ }
}
- if (!%warn) {
- my %r = insert(%value);
-
- open(my $sendmail => "|$SENDMAIL")
- or die "Can't open $SENDMAIL: $!\n";
-
- $tt->process("mail.form-ack.tpl", {
- to => $value{mail},
- url => {
- yes => "$SELF/$r{uuid}.user?confirm=yes",
- no => "$SELF/$r{uuid}.user?confirm=no",
- }
- }, $sendmail)
- or die $tt->error();
-
- close($sendmail);
-
- $tt->process("html.form-ack.tpl", {
- value => \%value,
- timestamp => $r{timestamp},
- uuid => $r{uuid},
- }) or die $tt->error();
- exit 0;
- }
+ $tt->process("html.form.tpl", {
+ warn => %warn ? \%warn : undef,
+ value => {
+ givenname => scalar param("givenname"),
+ surname => scalar param("surname"),
+ mail => scalar param("mail"),
+ },
+ } ) or die $tt->error();
+ exit 0;
}
-
- ## Formular
- $tt->process("html.form.tpl", {
- warn => %warn ? \%warn : undef,
- value => {
- givenname => scalar param("givenname"),
- surname => scalar param("surname"),
- mail => scalar param("mail"),
- },
- } ) or die $tt->error();
+ $tt->process("html.denied.tpl", {
+ url => $SELF,
+ }) or die $tt->error();
exit 0;
}
@@ -228,24 +204,23 @@
$DBH->begin_work;
my $sth;
- $sth = $DBH->prepare("SELECT timestamp FROM db WHERE uuid = ?");
+ $sth = $DBH->prepare("SELECT created FROM db WHERE uuid = ?");
$sth->execute($uuid);
if (my $r = $sth->fetchrow_hashref) {
- my $timestamp = $r->{timestamp};
+ my $created = $r->{created};
$DBH->rollback;
return (uuid => $uuid,
- timestamp => $r->{timestamp});
+ created => $r->{created});
}
local $" = ", ";
- $sth = $DBH->prepare("INSERT INTO db (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}, uuid, timestamp)
- VALUES(?, ?, ?, ?, ?, ?)");
- $sth->execute(@value{@{$FIELDS{MAN}}, @{$FIELDS{OPT}}}, $uuid, time);
+ $sth = $DBH->prepare("INSERT INTO db (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}, uuid, created)
+ VALUES(?, ?, ?, ?, ?, datetime('now'))");
+ $sth->execute(@value{@{$FIELDS{MAN}}, @{$FIELDS{OPT}}}, $uuid);
$DBH->commit;
return (uuid => $uuid,
timestamp => undef);
-
}
sub confirm($$) {
@@ -254,7 +229,7 @@
$DBH->begin_work;
local $" = ", ";
- my $sth = $DBH->prepare("SELECT @{$FIELDS{MAN}}, @{$FIELDS{OPT}} FROM db WHERE uuid = ?");
+ my $sth = $DBH->prepare("SELECT @{$FIELDS{MAN}}, @{$FIELDS{OPT}}, confirmed FROM db WHERE uuid = ?");
$sth->execute($uuid);
my $r = $sth->fetchrow_hashref;
if (!$r) {
@@ -266,7 +241,7 @@
if ($confirmed) {
- $sth = $DBH->prepare("UPDATE db SET ack = 1 WHERE uuid = ?");
+ $sth = $DBH->prepare("UPDATE db SET confirmed = datetime('now') WHERE uuid = ?");
}
else {
$sth = $DBH->prepare("DELETE FROM db WHERE uuid = ?");
@@ -286,3 +261,45 @@
/^\s*(.*?)\s*$/s;
return $1;
}
+
+sub do_invite() {
+ my ($tt) = @_;
+ my %warn;
+ my $sent;
+
+ if (param("mail")) {
+ if (not valid param("mail")) {
+ $warn{mail} = "INVALID";
+ }
+ else {
+ my $xxx = encrypt(time);
+ $xxx =~ s/\+/-/g;
+ $xxx =~ s/\//_/g;
+
+ # send mail
+ open(my $sendmail => "|$SENDMAIL")
+ or die "Can't open sendmail: $!\n";
+
+ $tt->process("mail.invitation.tpl", {
+ to => scalar(param("mail")),
+ url => "$SELF/tmp.$xxx"}, $sendmail)
+ or die $tt->error();
+ close($sendmail)
+ or die "problem sending mail to "
+ . param("mail");
+
+ $sent = param("mail");
+ }
+ }
+ $tt->process("html.invitation.tpl", {
+ sent => $sent,
+ warn => %warn ? \%warn : undef,
+ expires => $EXPIRATION,
+ value => { mail => scalar param("mail") },
+ });
+}
+
+sub do_show($$) {
+ my ($tt, $object) = @_;
+ $tt->process("$object.tpl");
+}