# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1309530017 -7200 # Node ID 00dbdef7621f0724957c92af3f90f53f30110da0 initial diff -r 000000000000 -r 00dbdef7621f .hgignore --- /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 diff -r 000000000000 -r 00dbdef7621f .htaccess --- /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 diff -r 000000000000 -r 00dbdef7621f db.schema --- /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); diff -r 000000000000 -r 00dbdef7621f index.cgi --- /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; +} diff -r 000000000000 -r 00dbdef7621f templates/access.tpl --- /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. +
+ [%IF warn.mail%] +
+ Die Mailadresse sieht nicht gut aus. +
+ [%END%] + + + +
+ +
+ +[%ELSE%] + + Vielen Dank. Eine Mail mit einem Anmeldelink wurde an Deine + Mailadresse [%sent%] geschickt. Der Link ist 24 Stunden + gültig. Deine Adresse wurde von uns nicht gespeichert. + +[%END%] + +[%INCLUDE "foot"%] diff -r 000000000000 -r 00dbdef7621f templates/ack.tpl --- /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 ([%value.mail%]) geschickt. + + (Zeitstempel der Eintragung: [%date.format(timestamp, locale = "de_DE")%]) + +[%ELSE%] + +

+ Vielen Dank für Deine Anmeldung, [%value.givenname%]. + Folgende Daten haben wir jetzt gespeichert: + +

+ Vorname: [%value.givenname%]
+ Name: [%value.surname%]
+ Mail: [%value.mail%]
+ +

+ 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"%] diff -r 000000000000 -r 00dbdef7621f templates/confirm.tpl --- /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%] + +

+ Leider konnte die Anmeldung nicht bestätigt werden. Bitte überprüfe den + verwendeten Link oder kontaktiere bitte + [%MAILTO%] +
+ +[%ELSE%] + +Danke, Deine Anmeldung ist jetzt bestätigt. Folgende Daten haben wir von +Dir gespeichert: + + + + + +
Vorname[%value.givenname%]
Name [%value.surname%]
Mail [%value.mail%]
+ +Solltest Du weitere Fragen haben, kontaktiere bitte +[%MAILTO%]. + +[%END%] +[%INCLUDE "foot"%] diff -r 000000000000 -r 00dbdef7621f templates/denied.tpl --- /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"%] + +

+Tut uns leid, die angegebene URL oder Session existiert nicht oder nicht +mehr. Bitte versuche es über +[%url%] noch einmal. + +

+Danke für Dein Verständnis. + +[%INCLUDE "foot"%] diff -r 000000000000 -r 00dbdef7621f templates/entry.tpl --- /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"%] + + +Alle Felder sind Pflicht. Ohne diese Angaben wird die Anmeldung nicht +bearbeitet. + +[%IF warn%] +

+Bitte überprüfen Sie die markierten Felder noch einmal. +
+[%END%] + +
+ + + + [%warn.givenname%] +
+ + + + [%warn.surname%] +
+ + + + [%warn.mail%] +
+ + + + + +
+[%INCLUDE "foot"%] diff -r 000000000000 -r 00dbdef7621f templates/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 @@ +
+
+ Scripting + © 2011 + Heiko Schlittermann + + diff -r 000000000000 -r 00dbdef7621f templates/head --- /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 @@ + + + + + +