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"), |
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($) { |