index.cgi
changeset 2 687f53554299
parent 1 5d275133868b
child 3 17ddf9a1e376
equal deleted inserted replaced
1:5d275133868b 2:687f53554299
    15 use Template;
    15 use Template;
    16 use File::Basename;
    16 use File::Basename;
    17 use Mail::RFC822::Address qw(valid);
    17 use Mail::RFC822::Address qw(valid);
    18 
    18 
    19 sub insert(\%);
    19 sub insert(\%);
    20 sub confirm($);
    20 sub confirm($$);
    21 sub slurp($);
    21 sub slurp($);
    22 
    22 
    23 
    23 
    24 delete @ENV{grep /PATH$/ => keys %ENV};
    24 delete @ENV{grep /PATH$/ => keys %ENV};
    25 $ENV{PATH} = "/usr/bin:/usr/sbin:/bin:/sbin";
    25 $ENV{PATH} = "/usr/bin:/usr/sbin:/bin:/sbin";
    26 
    26 
    27 my $DSN = "DBI:SQLite:db.sqlite3";
    27 my $DSN = "DBI:SQLite:db.sqlite3";
    28 my $SECRET = slurp "./secret"; chomp($SECRET);
    28 my $SECRET = slurp "./secret"; chomp($SECRET);
    29 my $EXPIRATION = 3600;		    # the link is valid for 1 hour only
    29 my $EXPIRATION = 60;		    # the link is valid for XX minutes only
    30 my $SUBJECT = "Retter packen";	    # ASCII only! *used for mail subject*
    30 my $SUBJECT = "Retter packen";	    # ASCII only! *used for mail subject*
    31 my %FIELDS = (
    31 my %FIELDS = (
    32     MAN => [qw[givenname surname mail]],
    32     MAN => [qw[givenname surname mail]],
    33     OPT => [qw[tel]]
    33     OPT => [qw[tel]]
    34 );
    34 );
    77 		sendmail(To => scalar(param("mail")),
    77 		sendmail(To => scalar(param("mail")),
    78 		         From => "hs+retter\@schlittermann.de",
    78 		         From => "hs+retter\@schlittermann.de",
    79 			 Sender => "hs\@schlittermann.de",
    79 			 Sender => "hs\@schlittermann.de",
    80 			 Subject => "[$SUBJECT] Link zur Online-Anmeldung",
    80 			 Subject => "[$SUBJECT] Link zur Online-Anmeldung",
    81 			 Message => "Bitte benutze den folgenden Link, um zum Anmeldeformular zu gelangen:\n"
    81 			 Message => "Bitte benutze den folgenden Link, um zum Anmeldeformular zu gelangen:\n"
    82 			    . url(-query => 0) . "/$xxx\n"
    82 			    . url(-query => 0) . "/$xxx.tmp\n"
    83 			    . "\n-- \nHeiko Schlittermann\n");
    83 			    . "\n-- \nHeiko Schlittermann\n");
    84 		    
    84 		    
    85 		$sent = param("mail");
    85 		$sent = param("mail");
    86 	    }
    86 	    }
    87 	}
    87 	}
    88 	$tt->process("access.tpl", {
    88 	$tt->process("access.tpl", {
    89 	    sent => $sent,
    89 	    sent => $sent,
    90 	    warn => %warn ? \%warn : undef,
    90 	    warn => %warn ? \%warn : undef,
       
    91 	    expires => $EXPIRATION,
    91 	    value => { mail => scalar param("mail") },
    92 	    value => { mail => scalar param("mail") },
    92 	});
    93 	});
    93 	exit 0;
    94 	exit 0;
    94     }
    95     }
    95 
    96 
       
    97     # /<uuid>.tmp
       
    98     # /<uuid>.user
       
    99 
    96     # No access without correct path_info
   100     # No access without correct path_info
    97     if (my $_ = basename(path_info())) {
   101     if (path_info() =~ /^\/?(.*)\.tmp$/) {
       
   102 	my $_ = $1;
    98 	s/_/\//g;
   103 	s/_/\//g;
    99 	s/-/+/g;
   104 	s/-/+/g;
   100 	eval {
   105 	eval {
   101 	    my $time = decrypt($_) or die "DECRYPTION ERROR";
   106 	    my $time = decrypt($_) or die "DECRYPTION ERROR";
   102 	    $time =~ /^\d+$/ or die "FORMAT ERROR";
   107 	    $time =~ /^\d+$/ or die "FORMAT ERROR";
   103 	    time() - $time < $EXPIRATION or die "EXPIRED";
   108 	    time() - $time < (60 * $EXPIRATION) or die "EXPIRED";
   104 	};
   109 	};
   105 	if ($@) {
   110 	if ($@) {
   106 	    $tt->process("denied.tpl", {
   111 	    $tt->process("denied.tpl", {
   107 		url => url(-path => 0),
   112 		url => url(-path => 0),
   108 	    }) or die $tt->error();
   113 	    }) or die $tt->error();
   109 	    exit 0;
   114 	    exit 0;
   110 	}
   115 	}
   111     }
   116     }
   112 
   117 
       
   118     if (path_info() =~ /^\/?(.*)\.user$/) {
       
   119 	my $uuid = $1;
       
   120 	my $confirmed = param("confirm") eq "yes";
       
   121 	my %data = confirm($uuid => $confirmed);
       
   122 
       
   123 	$tt->process("confirm.tpl", {
       
   124 	    confirmed => $confirmed,
       
   125 	    error => delete $data{error},
       
   126 	    value => \%data}) or die $tt->error();
       
   127 	exit 0;
       
   128     }
       
   129 
   113     ### all went fine, we start processing
   130     ### all went fine, we start processing
   114     ### the form
   131     ### the form
   115 
   132 
   116     my %warn;
   133     my %warn;
   117     my %value;
   134     my %value;
   154 	if (!%warn) {
   171 	if (!%warn) {
   155 	    my %r = insert(%value);
   172 	    my %r = insert(%value);
   156 	    sendmail(To => $value{mail},
   173 	    sendmail(To => $value{mail},
   157 		     From => "hs\@schlittermann.de",
   174 		     From => "hs\@schlittermann.de",
   158 		     "Content-Type" => "text/plain; charset=\"UTF-8\"",
   175 		     "Content-Type" => "text/plain; charset=\"UTF-8\"",
   159 		     Subject => "Bitte die Anmeldung bestaetigen.",
   176 		     Subject => "[$SUBJECT] Bitte die Anmeldung bestaetigen.",
   160 		     Message => "Bitte bestätige Deine Anmeldung, in dem Du folgende Webseite aufrufst:\n"
   177 		     Message => <<_EOF);
   161 		               . url(-path_info => 1, -query => 0) .  "?confirm=$r{uuid}\n");
   178 
   162 
   179 Bitte bestätige Deine Anmeldung. Dazu mußt Du folgenden Link in Deinem
       
   180 Browser öffnen:
       
   181 
       
   182 @{[url(-path_info => 0, -query => 0)]}/$r{uuid}.user?confirm=yes
       
   183 
       
   184 Wenn alles nur ein Irrtum war, dann kannst Du Deine Daten wieder
       
   185 AUSTRAGEN und wir vergessen Deine Anmeldung. Hier ist der Link zum
       
   186 AUSTRAGEN:
       
   187 
       
   188 @{[url(-path_info => 0, -query => 0)]}/$r{uuid}.user?confirm=no
       
   189 
       
   190 _EOF
   163 	    $tt->process("ack.tpl", {
   191 	    $tt->process("ack.tpl", {
   164 		value => \%value,
   192 		value => \%value,
   165 		timestamp => $r{timestamp},
   193 		timestamp => $r{timestamp},
   166 		uuid => $r{uuid},
   194 		uuid => $r{uuid},
   167 	    }) or die $tt->error();
   195 	    }) or die $tt->error();
   168 	    exit 0;
   196 	    exit 0;
   169 	}
   197 	}
   170     }
   198     }
   171 
   199 
   172     if (param("confirm") =~ /^\s*(.+)\s*/) {
       
   173 	my %data = confirm($1);
       
   174 	$tt->process("confirm.tpl", {
       
   175 	    value => \%data}) or die $tt->error();
       
   176 	exit 0;
       
   177     }
       
   178 
   200 
   179     ## Formular
   201     ## Formular
   180     $tt->process("entry.tpl", {
   202     $tt->process("form.tpl", {
   181 	warn => %warn ? \%warn : undef,
   203 	warn => %warn ? \%warn : undef,
   182 	value => {
   204 	value => {
   183 	    givenname => scalar param("givenname"),
   205 	    givenname => scalar param("givenname"),
   184 	    surname => scalar param("surname"),
   206 	    surname => scalar param("surname"),
   185 	    mail => scalar param("mail"),
   207 	    mail => scalar param("mail"),
   188     exit 0;
   210     exit 0;
   189 }
   211 }
   190 
   212 
   191 sub insert(\%) {
   213 sub insert(\%) {
   192     my %value = %{$_[0]};
   214     my %value = %{$_[0]};
   193     my $uuid = sha1_hex($SECRET . values %value);
   215     my $uuid = sha1_hex($SECRET . 
       
   216 	join "\0" => @value{@FIELDS{MAN}});
   194 
   217 
   195     $DBH->begin_work;
   218     $DBH->begin_work;
   196 	my $sth;
   219 	my $sth;
   197 	$sth = $DBH->prepare("SELECT timestamp FROM db WHERE uuid = ?");
   220 	$sth = $DBH->prepare("SELECT timestamp FROM db WHERE uuid = ?");
   198 	$sth->execute($uuid);
   221 	$sth->execute($uuid);
   201 	    my $timestamp = $r->{timestamp};
   224 	    my $timestamp = $r->{timestamp};
   202 	    $DBH->rollback;
   225 	    $DBH->rollback;
   203 	    return (uuid => $uuid,
   226 	    return (uuid => $uuid,
   204 	            timestamp => $r->{timestamp});
   227 	            timestamp => $r->{timestamp});
   205 	}
   228 	}
   206 	$sth = $DBH->prepare("INSERT INTO db 
   229 	local $" = ", ";
   207 		(givenname, surname, mail, uuid, timestamp) 
   230 	$sth = $DBH->prepare("INSERT INTO db (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}, uuid, timestamp)
   208 		VALUES(?, ?, ?, ?, ?)");
   231 		VALUES(?, ?, ?, ?, ?, ?)");
   209 	$sth->execute(@value{qw/givenname surname mail/}, $uuid, time);
   232 	$sth->execute(@value{@{$FIELDS{MAN}}, @{$FIELDS{OPT}}}, $uuid, time);
   210     $DBH->commit;
   233     $DBH->commit;
   211 
   234 
   212     return (uuid => $uuid,
   235     return (uuid => $uuid,
   213 	    timestamp => undef);
   236 	    timestamp => undef);
   214 
   237 
   215 }
   238 }
   216 
   239 
   217 sub confirm($) {
   240 sub confirm($$) {
   218     my $uuid = shift;
   241     my ($uuid, $confirmed) = @_;
   219     my %data;
   242     my %data;
   220     $DBH->begin_work;
   243     $DBH->begin_work;
   221 	my $sth = $DBH->prepare("SELECT givenname, surname, mail FROM db WHERE uuid = ?");
   244 	
       
   245 	local $" = ", ";
       
   246 	my $sth = $DBH->prepare("SELECT @{$FIELDS{MAN}}, @{$FIELDS{OPT}} FROM db WHERE uuid = ?");
   222 	$sth->execute($uuid);
   247 	$sth->execute($uuid);
   223 	my $r = $sth->fetchrow_hashref;
   248 	my $r = $sth->fetchrow_hashref;
   224 	if (!$r) {
   249 	if (!$r) {
   225 	    $DBH->rollback;
   250 	    $DBH->rollback;
   226 	    return (error => "NOT FOUND");
   251 	    return (error => "NOT FOUND");
   227 	}
   252 	}
   228 	%data = (
   253 	@data{@{$FIELDS{MAN}}} = @{$r}{@{$FIELDS{MAN}}};
   229 	    givenname => $r->{givenname},
   254 	@data{@{$FIELDS{OPT}}} = @{$r}{@{$FIELDS{OPT}}};
   230 	    surname => $r->{surname},
   255 
   231 	    mail => $r->{mail}
   256 
   232 	);
   257 	if ($confirmed) {
   233 
   258 	    $sth = $DBH->prepare("UPDATE db SET ack = 1 WHERE uuid = ?");
   234 	$sth = $DBH->prepare("UPDATE db SET ack = ? WHERE uuid = ?");
   259 	}
   235 	$sth->execute(1, $uuid);
   260 	else {
       
   261 	    $sth = $DBH->prepare("DELETE FROM db WHERE uuid = ?");
       
   262 	}
       
   263 	$sth->execute($uuid);
       
   264 	
   236     $DBH->commit;
   265     $DBH->commit;
       
   266 
       
   267     if ($confirmed) {
       
   268 	sendmail(
       
   269 	    To => $data{mail},
       
   270 	    From => "hs+retter\@schlittermann.de",
       
   271 	    Subject => "[$SUBJECT] Bestaetigung der Anmeldung",
       
   272 	    Message => <<_EOF);
       
   273 Du bist erfolgreich angemeldet. Für weitere Fragen kontaktiere bitte
       
   274 hs+retter\@schlittermann.de.
       
   275 _EOF
       
   276     }
       
   277     else {
       
   278 	sendmail(
       
   279 	    To => $data{mail},
       
   280 	    From => "hs+retter\@schlittermann.de",
       
   281 	    Subject => "[$SUBJECT] Bestaetigung der NICHT-Anmeldung",
       
   282 	    Message => <<_EOF);
       
   283 Wir vergessen Deine Anmeldung. Fuer weitere Fragen kontaktiere bitte
       
   284 hs+retter\@schlittermann.de.
       
   285 _EOF
       
   286     }
   237 
   287 
   238     return %data;
   288     return %data;
   239 }
   289 }
   240 
   290 
   241 sub slurp($) {
   291 sub slurp($) {