56 # other problems later |
71 # other problems later |
57 if (basename($ENV{SCRIPT_NAME}) ne basename(url(-path_info => 0, -relative => 1))) { |
72 if (basename($ENV{SCRIPT_NAME}) ne basename(url(-path_info => 0, -relative => 1))) { |
58 print redirect(basename($ENV{SCRIPT_NAME})); |
73 print redirect(basename($ENV{SCRIPT_NAME})); |
59 } |
74 } |
60 |
75 |
61 |
|
62 # ACCESS |
76 # ACCESS |
63 # Here we generate a link URL (sent via Mail) containing the |
|
64 # encrypted current timestamp. Accessing the form is only possible |
|
65 # using this link. Note: These links may not be unique! |
|
66 if (!path_info()) { |
77 if (!path_info()) { |
67 do_invite(); |
78 do_invite(); |
68 exit 0; |
79 exit 0; |
|
80 } |
|
81 |
|
82 # /done.<uuid>/ filled forms etc |
|
83 # /done/ |
|
84 if (path_info() =~ /^\/?done(?:\.(?<uuid>.*?))?\/(?<step>.*)$/) { |
|
85 my %x = %+; |
|
86 if ($x{step} ~~ [qw(invitation form confirmation)]) { |
|
87 eval { |
|
88 page("html.$x{step}.done.tpl", { |
|
89 done => { |
|
90 map({ ($_, _decrypt(param($_))) } param()), |
|
91 }, |
|
92 uuid => UUID->new($x{uuid}, map { @$_ } values %FIELDS), |
|
93 }); |
|
94 exit 0; |
|
95 }; |
|
96 die $@ if $@; |
|
97 if ($@) { |
|
98 page("html.denied.tpl"); |
|
99 exit 0; |
|
100 } |
|
101 } |
69 } |
102 } |
70 |
103 |
71 # /show/(…) |
104 # /show/(…) |
72 if (path_info() =~ /^\/?show\/(.*)$/) { |
105 if (path_info() =~ /^\/?show\/(.*)$/) { |
73 if ($1 ~~ [qw(info)]) { |
106 if ($1 ~~ [qw(info)]) { |
77 page("html.denied.tpl"); |
110 page("html.denied.tpl"); |
78 exit 0; |
111 exit 0; |
79 } |
112 } |
80 |
113 |
81 # /user.<uuid> |
114 # /user.<uuid> |
82 if (path_info() =~ /^\/?user\.(.*)$/) { |
115 if (path_info() =~ /^\/?user\.(.*)(?:\/(.*))?$/) { |
83 my $uuid = $1; |
116 my $uuid = $1; |
84 |
117 |
85 my $confirmed = param("confirm") eq "yes"; |
118 if (param("confirm")) { |
|
119 |
|
120 my $confirmed = param("confirm") eq "yes" ? 1 : 0; |
86 my %data = confirm($uuid => $confirmed); |
121 my %data = confirm($uuid => $confirmed); |
87 |
122 |
88 if ($data{error}) { |
123 if ($data{error}) { |
89 page("html.denied.tpl"); |
124 page("html.denied.tpl"); |
90 exit 0; |
125 exit 0; |
93 mail("mail.confirmed.tpl", { |
128 mail("mail.confirmed.tpl", { |
94 to => $data{email}, |
129 to => $data{email}, |
95 confirmed => $confirmed, |
130 confirmed => $confirmed, |
96 }); |
131 }); |
97 |
132 |
98 page("html.confirmed.tpl", { |
133 print redirect("$SELF/done.$uuid/confirmation?" |
99 confirmed => $confirmed, |
134 . "confirmed=" . _encrypt($confirmed)); |
100 error => delete $data{error}, |
135 |
101 value => \%data}); |
|
102 exit 0; |
136 exit 0; |
|
137 } |
|
138 |
103 } |
139 } |
104 |
140 |
105 # /tmp.<uuid> |
141 # /tmp.<uuid> |
106 if (path_info() =~ /^\/?tmp\.(.*)$/) { |
142 if (path_info() =~ /^\/?tmp\.(.*)$/) { |
107 my $_ = $1; |
143 my $_ = $1; |
108 s/_/\//g; |
|
109 s/-/+/g; |
|
110 |
144 |
111 eval { |
145 eval { |
112 my $time = decrypt($_) or die "DECRYPTION ERROR"; |
146 my $time = _decrypt($_) or die "DECRYPTION ERROR"; |
113 $time =~ /^\d+$/ or die "FORMAT ERROR"; |
147 $time =~ /^\d+$/ or die "FORMAT ERROR"; |
114 time() - $time < (60 * $EXPIRATION) or die "EXPIRED"; |
148 time() - $time < (60 * $EXPIRATION) or die "EXPIRED"; |
115 }; if ($@) { |
149 }; if ($@) { |
116 page("html.denied.tpl"); |
150 page("html.denied.tpl"); |
117 exit 0; |
151 exit 0; |
152 |
186 |
153 foreach (keys %warn) { |
187 foreach (keys %warn) { |
154 $warn{$_} = join " ", @{$warn{$_}}; |
188 $warn{$_} = join " ", @{$warn{$_}}; |
155 } |
189 } |
156 |
190 |
157 if (!%warn) { |
191 if (%warn) { |
158 my %r = insert(%value); |
192 page("html.form.tpl", { |
159 |
193 warn => %warn ? \%warn : undef, |
160 mail("mail.form-ack.tpl", { |
194 value => { |
161 to => $value{email}, |
195 givenname => scalar param("givenname"), |
162 url => { |
196 surname => scalar param("surname"), |
163 yes => "$SELF/user.$r{uuid}?confirm=yes", |
197 email => scalar param("email"), |
164 no => "$SELF/user.$r{uuid}?confirm=no", |
|
165 } |
198 } |
166 }); |
199 }); |
167 |
|
168 page("html.form-ack.tpl", { |
|
169 value => \%value, |
|
170 created => $r{created}, |
|
171 uuid => $r{uuid}, |
|
172 }); |
|
173 exit 0; |
200 exit 0; |
174 } |
201 } |
175 } |
202 |
176 |
203 my %r = insert(%value); |
177 page("html.form.tpl", { |
204 |
178 warn => %warn ? \%warn : undef, |
205 mail("mail.form.done.tpl", { |
179 value => { |
206 to => $value{email}, |
180 givenname => scalar param("givenname"), |
207 url => { |
181 surname => scalar param("surname"), |
208 yes => "$SELF/user.$r{uuid}?confirm=yes", |
182 email => scalar param("email"), |
209 no => "$SELF/user.$r{uuid}?confirm=no", |
183 }, |
210 } |
184 } ); |
211 }); |
|
212 |
|
213 print redirect("$SELF/done.$r{uuid}/form"); |
|
214 exit 0; |
|
215 } |
|
216 |
|
217 page("html.form.tpl"); |
185 exit 0; |
218 exit 0; |
186 } |
219 } |
187 |
220 |
188 page("html.denied.tpl", { |
221 page("html.denied.tpl", { |
189 url => $SELF, |
222 url => $SELF, |
203 |
236 |
204 if (my $r = $sth->fetchrow_hashref) { |
237 if (my $r = $sth->fetchrow_hashref) { |
205 my $created = $r->{created}; |
238 my $created = $r->{created}; |
206 $DBH->rollback; |
239 $DBH->rollback; |
207 return (uuid => $uuid, |
240 return (uuid => $uuid, |
208 created => $r->{created}); |
241 exists => $created); |
209 } |
242 } |
|
243 |
210 local $" = ", "; |
244 local $" = ", "; |
211 $sth = $DBH->prepare("INSERT INTO db (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}, uuid, created) |
245 $sth = $DBH->prepare("INSERT INTO db (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}, uuid, created) |
212 VALUES(?, ?, ?, ?, ?, datetime('now'))"); |
246 VALUES(?, ?, ?, ?, ?, datetime('now'))"); |
213 $sth->execute(@value{@{$FIELDS{MAN}}, @{$FIELDS{OPT}}}, $uuid); |
247 $sth->execute(@value{@{$FIELDS{MAN}}, @{$FIELDS{OPT}}}, $uuid); |
214 $DBH->commit; |
248 $DBH->commit; |
215 |
249 |
216 return (uuid => $uuid, |
250 return (uuid => $uuid); |
217 timestamp => undef); |
|
218 } |
251 } |
219 |
252 |
220 sub confirm($$) { |
253 sub confirm($$) { |
221 my ($uuid, $confirmed) = @_; |
254 my ($uuid, $confirmed) = @_; |
222 my %data; |
255 my %data; |
264 if (param("email")) { |
297 if (param("email")) { |
265 if (not valid param("email")) { |
298 if (not valid param("email")) { |
266 $warn{email} = "INVALID"; |
299 $warn{email} = "INVALID"; |
267 } |
300 } |
268 else { |
301 else { |
269 my $xxx = encrypt(time); |
302 my $xxx = _encrypt(time); |
270 $xxx =~ s/\+/-/g; |
|
271 $xxx =~ s/\//_/g; |
|
272 |
303 |
273 mail("mail.invitation.tpl", { |
304 mail("mail.invitation.tpl", { |
274 to => scalar(param("email")), |
305 to => scalar(param("email")), |
275 url => "$SELF/tmp.$xxx"}); |
306 url => "$SELF/tmp.$xxx"}); |
276 |
307 |
277 $sent = param("email"); |
308 $sent = param("email"); |
278 } |
309 } |
279 } |
310 print redirect("$SELF/done/invitation?email=" . _encrypt($sent)); |
|
311 exit 0; |
|
312 } |
|
313 |
280 page("html.invitation.tpl", { |
314 page("html.invitation.tpl", { |
281 sent => $sent, |
315 sent => $sent, |
282 warn => %warn ? \%warn : undef, |
316 warn => %warn ? \%warn : undef, |
283 expires => $EXPIRATION, |
317 expires => $EXPIRATION, |
284 value => { email => scalar param("email") }, |
318 value => { email => scalar param("email") }, |
300 or die $tt->error(); |
334 or die $tt->error(); |
301 close($sendmail) |
335 close($sendmail) |
302 or die "SENDMAIL: $!\n"; |
336 or die "SENDMAIL: $!\n"; |
303 } |
337 } |
304 |
338 |
|
339 { package UUID; |
|
340 use strict; |
|
341 use warnings; |
|
342 |
|
343 sub new { |
|
344 my $self = bless {} => shift; |
|
345 $self->{uuid} = shift; |
|
346 $self->{fields} = [@_]; |
|
347 my $sth = $DBH->prepare("SELECT " |
|
348 . join(", " => @{$self->{fields}}) |
|
349 . " FROM db WHERE uuid = ?"); |
|
350 $sth->execute($self->{uuid}); |
|
351 $self->{r} = $sth->fetchrow_hashref; |
|
352 $sth->finish; |
|
353 return undef if not $self->{r}; |
|
354 return $self; |
|
355 } |
|
356 |
|
357 sub AUTOLOAD { |
|
358 my $self = shift; |
|
359 my ($f) = ($UUID::AUTOLOAD =~ /.*::(.*)/); |
|
360 return $self->{r}{$f}; |
|
361 } |
|
362 } |
|
363 |