--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,1 @@
+db.sqlite3
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/.htaccess Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,2 @@
+Options +ExecCGI
+AddHandler cgi-script .cgi
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/db.schema Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,7 @@
+DROP TABLE IF EXISTS db;
+CREATE TABLE db (
+ id INTEGER PRIMARY KEY,
+ givenname TEXT, surname TEXT, mail TEXT, tel TEXT,
+ uuid TEXT UNIQUE,
+ timestamp BIGINT,
+ ack bool DEFAULT NULL);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/index.cgi Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,237 @@
+#! /usr/bin/perl -T
+
+use 5.010;
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+use CGI qw(:all);
+use CGI::Carp qw(fatalsToBrowser);
+use Crypt::Simple;
+use Digest::SHA1 qw(sha1_hex);
+use Mail::Sendmail;
+use DBI;
+use Template;
+use File::Basename;
+use Mail::RFC822::Address qw(valid);
+
+delete @ENV{grep /PATH$/ => keys %ENV};
+$ENV{PATH} = "/usr/bin:/usr/sbin:/bin:/sbin";
+
+my $DSN = "DBI:SQLite:db.sqlite3";
+my $SECRET = "iexaephuwe"; # used for generating the hash
+my $EXPIRATION = 3600; # the link is valid for 1 hour only
+my $SUBJECT = "Retter packen"; # ASCII only! *used for mail subject*
+my %FIELDS = (
+ MAN => [qw[givenname surname mail]],
+ OPT => [qw[tel]]
+);
+
+my %ttconfig = (
+ INCLUDE_PATH => "templates",
+ DEBUG => 1,
+ VARIABLES => {
+ MAILTO => "hs+retter\@schlittermann.de"
+ },
+);
+
+my $DBH = DBI->connect($DSN, undef, undef, {RaiseError=>1});
+END { $DBH and $DBH->disconnect }
+
+sub insert(\%);
+sub confirm($);
+
+MAIN: {
+
+ # Redirect if called without the script name, this avoids
+ # other problems later
+ if (basename($ENV{SCRIPT_NAME}) ne basename(url(-path_info => 0, -relative => 1))) {
+ print redirect(basename($ENV{SCRIPT_NAME}));
+ }
+
+ # OK, let's start
+ print header(-charset => "UTF-8");
+ my $tt = Template->new(\%ttconfig);
+
+ # ACCESS
+ # Here we generate a link URL (sent via Mail) containing the
+ # 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
+ sendmail(To => scalar(param("mail")),
+ From => "hs+retter\@schlittermann.de",
+ Sender => "hs\@schlittermann.de",
+ Subject => "[$SUBJECT] Link zur Online-Anmeldung",
+ Message => "Bitte benutze den folgenden Link, um zum Anmeldeformular zu gelangen:\n"
+ . url(-query => 0) . "/$xxx\n"
+ . "\n-- \nHeiko Schlittermann\n");
+
+ $sent = param("mail");
+ }
+ }
+ $tt->process("access.tpl", {
+ sent => $sent,
+ warn => %warn ? \%warn : undef,
+ value => { mail => scalar param("mail") },
+ });
+ exit 0;
+ }
+
+ # No access without correct path_info
+ if (my $_ = basename(path_info())) {
+ s/_/\//g;
+ s/-/+/g;
+ eval {
+ my $time = decrypt($_) or die "DECRYPTION ERROR";
+ $time =~ /^\d+$/ or die "FORMAT ERROR";
+ time() - $time < $EXPIRATION or die "EXPIRED";
+ };
+ if ($@) {
+ $tt->process("denied.tpl", {
+ url => url(-path => 0),
+ }) or die $tt->error();
+ 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}}) {
+
+ # 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);
+ sendmail(To => $value{mail},
+ From => "hs\@schlittermann.de",
+ "Content-Type" => "text/plain; charset=\"UTF-8\"",
+ Subject => "Bitte die Anmeldung bestaetigen.",
+ Message => "Bitte bestätige Deine Anmeldung, in dem Du folgende Webseite aufrufst:\n"
+ . url(-path_info => 1, -query => 0) . "?confirm=$r{uuid}\n");
+
+ $tt->process("ack.tpl", {
+ value => \%value,
+ timestamp => $r{timestamp},
+ uuid => $r{uuid},
+ }) or die $tt->error();
+ exit 0;
+ }
+ }
+
+ if (param("confirm") =~ /^\s*(.+)\s*/) {
+ my %data = confirm($1);
+ $tt->process("confirm.tpl", {
+ value => \%data}) or die $tt->error();
+ exit 0;
+ }
+
+ ## Formular
+ $tt->process("entry.tpl", {
+ warn => %warn ? \%warn : undef,
+ value => {
+ givenname => scalar param("givenname"),
+ surname => scalar param("surname"),
+ mail => scalar param("mail"),
+ },
+ } ) or die $tt->error();
+ exit 0;
+}
+
+sub insert(\%) {
+ my %value = %{$_[0]};
+ my $uuid = sha1_hex($SECRET . values %value);
+
+ $DBH->begin_work;
+ my $sth;
+ $sth = $DBH->prepare("SELECT timestamp FROM db WHERE uuid = ?");
+ $sth->execute($uuid);
+
+ if (my $r = $sth->fetchrow_hashref) {
+ my $timestamp = $r->{timestamp};
+ $DBH->rollback;
+ return (uuid => $uuid,
+ timestamp => $r->{timestamp});
+ }
+ $sth = $DBH->prepare("INSERT INTO db
+ (givenname, surname, mail, uuid, timestamp)
+ VALUES(?, ?, ?, ?, ?)");
+ $sth->execute(@value{qw/givenname surname mail/}, $uuid, time);
+ $DBH->commit;
+
+ return (uuid => $uuid,
+ timestamp => undef);
+
+}
+
+sub confirm($) {
+ my $uuid = shift;
+ my %data;
+ $DBH->begin_work;
+ my $sth = $DBH->prepare("SELECT givenname, surname, mail FROM db WHERE uuid = ?");
+ $sth->execute($uuid);
+ my $r = $sth->fetchrow_hashref;
+ if (!$r) {
+ $DBH->rollback;
+ return (error => "NOT FOUND");
+ }
+ %data = (
+ givenname => $r->{givenname},
+ surname => $r->{surname},
+ mail => $r->{mail}
+ );
+
+ $sth = $DBH->prepare("UPDATE db SET ack = ? WHERE uuid = ?");
+ $sth->execute(1, $uuid);
+ $DBH->commit;
+
+ return %data;
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/access.tpl Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,30 @@
+[%INCLUDE "head"%]
+
+[%IF !sent%]
+
+ Schön, daß Du Dich anmelden möchtest. Um Mißbrauch zu erschweren…
+ Bitte gib eine Mailadresse an, an die wir einen Anmeldelink senden
+ können. Diese Adresse wird nirgendwo gespeichert.
+ <form>
+ [%IF warn.mail%]
+ <div class="warn">
+ Die Mailadresse sieht nicht gut aus.
+ </div>
+ [%END%]
+
+ <label for="mail">Mail-Adresse</label>
+ <input type="text" id="mail" name="mail"
+ value="[%value.mail%]" class="[%warn.mail ? "warn" : "" %]" />
+ <br>
+ <input type="submit" name="submit" value="Los">
+ </form>
+
+[%ELSE%]
+
+ Vielen Dank. Eine Mail mit einem Anmeldelink wurde an Deine
+ Mailadresse <u>[%sent%]</u> geschickt. Der Link ist 24 Stunden
+ gültig. Deine Adresse wurde von uns nicht gespeichert.
+
+[%END%]
+
+[%INCLUDE "foot"%]
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/ack.tpl Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,30 @@
+[%INCLUDE "head"%]
+[%USE date%]
+
+[%IF timestamp %]
+
+ Deine Daten stehen bereits in unserer Datenbank. Wir haben Dir den
+ Link zur Bestätigung noch einmal an die hinterlegte
+ Mailadresse (<u>[%value.mail%]</u>) geschickt.
+
+ (Zeitstempel der Eintragung: [%date.format(timestamp, locale = "de_DE")%])
+
+[%ELSE%]
+
+ <p>
+ Vielen Dank für Deine Anmeldung, [%value.givenname%].
+ Folgende Daten haben wir jetzt gespeichert:
+
+ <p>
+ Vorname: [%value.givenname%]<br/>
+ Name: [%value.surname%]</br>
+ Mail: [%value.mail%]</br>
+
+ <p>
+ Du erhälst jetzt per Mail an [%value.mail%] einen
+ Link, mit dem Du bitte die Anmeldung bestätigst. Bevor Du damit die
+ Anmeldung nicht bestätigst, wird sie nicht weiter bearbeitet.
+
+[%END%]
+
+[%INCLUDE "foot"%]
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/confirm.tpl Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,26 @@
+[%INCLUDE "head"%]
+
+[%IF error%]
+
+ <div class="warn">
+ Leider konnte die Anmeldung nicht bestätigt werden. Bitte überprüfe den
+ verwendeten Link oder kontaktiere bitte
+ <a href="mailto:[%MAILTO%]">[%MAILTO%]</a>
+ </div>
+
+[%ELSE%]
+
+Danke, Deine Anmeldung ist jetzt bestätigt. Folgende Daten haben wir von
+Dir gespeichert:
+
+<table>
+<tr><td>Vorname</td><td>[%value.givenname%]</td></tr>
+<tr><td>Name</td> <td>[%value.surname%]</td></tr>
+<tr><td>Mail</td> <td>[%value.mail%]</td></tr>
+</table>
+
+Solltest Du weitere Fragen haben, kontaktiere bitte
+<a href="mailto:[%MAILTO%]">[%MAILTO%]</a>.
+
+[%END%]
+[%INCLUDE "foot"%]
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/denied.tpl Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,11 @@
+[%INCLUDE "head"%]
+
+<p>
+Tut uns leid, die angegebene URL oder Session existiert nicht oder nicht
+mehr. Bitte versuche es über
+<a href="[%url%]">[%url%]</a> noch einmal.
+
+<p>
+Danke für Dein Verständnis.
+
+[%INCLUDE "foot"%]
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/entry.tpl Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,38 @@
+[%INCLUDE "head"%]
+<!-- hier eine Beschreibung des Events… -->
+
+Alle Felder sind Pflicht. Ohne diese Angaben wird die Anmeldung nicht
+bearbeitet.
+
+[%IF warn%]
+<div class="warn">
+Bitte überprüfen Sie die markierten Felder noch einmal.
+</div>
+[%END%]
+
+<form accept-charset="UTF-8">
+
+ <label for="givenname">Vorname</label>
+ <input id="givenname" name="givenname" type="text"
+ value="[%value.givenname%]" class="[%warn.givenname ? "warn" :"" %]" />
+ <font class="warn">[%warn.givenname%]</font>
+ <br/>
+
+ <label for="surname">Name</label>
+ <input id="surname" name="surname" type="text"
+ value="[%value.surname%]" class="[%warn.surname ? "warn" : ""%]"/>
+ <font class="warn">[%warn.surname%]</font>
+ <br/>
+
+ <label for="mail">Mail-Adresse</label>
+ <input id="mail" name="mail" type="text"
+ value="[%value.mail%]" class="[%warn.mail ? "warn" : "" %]"/>
+ <font class="warn">[%warn.mail%]</font>
+ <br/>
+
+ <label>[und los]</label>
+ <input type="submit" name="submit" value="Anmelden"/>
+ <input type="submit" name="clear" value="Löschen"/>
+
+</form>
+[%INCLUDE "foot"%]
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/foot Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,7 @@
+<hr/>
+<div align="right">
+ <a href="https://ssl.schlittermann.de/hg/oa">Scripting</a>
+ © 2011
+ <a href="mailto:hs@schlittermann.de">Heiko Schlittermann</a>
+</body>
+</html>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/templates/head Fri Jul 01 16:20:17 2011 +0200
@@ -0,0 +1,11 @@
+<html>
+<head>
+<meta http-equiv="Content-Type" content="text/html;charset=UTF8">
+<style type="text/css">
+<!--
+ .warn { color:red; border-color:red; }
+ form > label { display:block; float:left; width:12ex; }
+-->
+</style>
+</head>
+<body>