61 # ACCESS |
64 # ACCESS |
62 # Here we generate a link URL (sent via Mail) containing the |
65 # Here we generate a link URL (sent via Mail) containing the |
63 # encrypted current timestamp. Accessing the form is only possible |
66 # encrypted current timestamp. Accessing the form is only possible |
64 # using this link. Note: These links may not be unique! |
67 # using this link. Note: These links may not be unique! |
65 if (!path_info()) { |
68 if (!path_info()) { |
66 my %warn; |
69 do_invite($tt); |
67 my $sent; |
|
68 |
|
69 if (param("mail")) { |
|
70 if (not valid param("mail")) { |
|
71 $warn{mail} = "INVALID"; |
|
72 } |
|
73 else { |
|
74 my $xxx = encrypt(time); |
|
75 $xxx =~ s/\+/-/g; |
|
76 $xxx =~ s/\//_/g; |
|
77 |
|
78 # send mail |
|
79 open(my $sendmail => "|$SENDMAIL") |
|
80 or die "Can't open sendmail: $!\n"; |
|
81 |
|
82 $tt->process("mail.invitation.tpl", { |
|
83 to => scalar(param("mail")), |
|
84 url => "$SELF/$xxx.tmp"}, $sendmail) |
|
85 or die $tt->error(); |
|
86 close($sendmail) |
|
87 or die "problem sending mail to " |
|
88 . param("mail"); |
|
89 |
|
90 $sent = param("mail"); |
|
91 } |
|
92 } |
|
93 $tt->process("html.invitation.tpl", { |
|
94 sent => $sent, |
|
95 warn => %warn ? \%warn : undef, |
|
96 expires => $EXPIRATION, |
|
97 value => { mail => scalar param("mail") }, |
|
98 }); |
|
99 exit 0; |
70 exit 0; |
100 } |
71 } |
101 |
72 |
102 # /<uuid>.tmp |
73 # /show/(…) |
103 # /<uuid>.user |
74 if (path_info() =~ /^\/?show\/(.*)$/) { |
104 |
75 if ($1 ~~ [qw(info)]) { |
105 # No access without correct path_info |
76 do_show($tt, $1); |
106 if (path_info() =~ /^\/?(.*)\.tmp$/) { |
|
107 my $_ = $1; |
|
108 s/_/\//g; |
|
109 s/-/+/g; |
|
110 eval { |
|
111 my $time = decrypt($_) or die "DECRYPTION ERROR"; |
|
112 $time =~ /^\d+$/ or die "FORMAT ERROR"; |
|
113 time() - $time < (60 * $EXPIRATION) or die "EXPIRED"; |
|
114 }; |
|
115 if ($@) { |
|
116 $tt->process("html.denied.tpl", { |
|
117 url => $SELF, |
|
118 }) or die $tt->error(); |
|
119 exit 0; |
77 exit 0; |
120 } |
78 } |
121 } |
79 $tt->process("html.denied.tpl"); |
122 |
80 exit 0; |
123 if (path_info() =~ /^\/?(.*)\.user$/) { |
81 } |
|
82 |
|
83 # /user.<uuid> |
|
84 if (path_info() =~ /^\/?user\.(.*)$/) { |
124 my $uuid = $1; |
85 my $uuid = $1; |
125 my $confirmed = param("confirm") eq "yes"; |
86 my $confirmed = param("confirm") eq "yes"; |
126 my %data = confirm($uuid => $confirmed); |
87 my %data = confirm($uuid => $confirmed); |
127 |
88 |
128 open(my $sendmail, "|$SENDMAIL") or die "Can't open $SENDMAIL: $!\n"; |
89 open(my $sendmail, "|$SENDMAIL") or die "Can't open $SENDMAIL: $!\n"; |
139 error => delete $data{error}, |
100 error => delete $data{error}, |
140 value => \%data}) or die $tt->error(); |
101 value => \%data}) or die $tt->error(); |
141 exit 0; |
102 exit 0; |
142 } |
103 } |
143 |
104 |
144 ### all went fine, we start processing |
105 # /tmp.<uuid> |
145 ### the form |
106 if (path_info() =~ /^\/?tmp\.(.*)$/) { |
146 |
107 my $_ = $1; |
147 my %warn; |
108 s/_/\//g; |
148 my %value; |
109 s/-/+/g; |
149 |
110 |
150 ## Input |
111 eval { |
151 if (param("clear")) { |
112 my $time = decrypt($_) or die "DECRYPTION ERROR"; |
152 Delete_all(); |
113 $time =~ /^\d+$/ or die "FORMAT ERROR"; |
153 } |
114 time() - $time < (60 * $EXPIRATION) or die "EXPIRED"; |
154 |
115 }; if ($@) { |
155 # Submission |
116 $tt->process("html.denied.tpl"); |
156 if (param("submit")) { |
117 exit 0; |
157 foreach my $param (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}) { |
118 } |
158 |
119 |
159 # strip away spaces to "untaint" the variables, additionally |
120 my %warn; |
160 # limit the length |
121 my %value; |
161 my $_ = param($param); |
122 |
162 /^\s*(.*)\s*$/; |
123 if (param("clear")) { |
163 |
124 Delete_all(); |
164 if (!length $1 and $param ~~ @{$FIELDS{MAN}}) { |
125 } |
165 push @{$warn{$param}}, "Leer!?"; |
126 |
166 } |
127 # Submission |
167 |
128 if (param("submit")) { |
168 if (length $1 > 200) { |
129 foreach my $param (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}) { |
169 push @{$warn{$param}}, "Zu lang (bitte weniger als 200 Zeichen)."; |
130 |
170 } |
131 # strip away spaces to "untaint" the variables, additionally |
171 |
132 # limit the length |
172 param(-name => $param, value => $1); |
133 my $_ = param($param); |
173 $value{$param} = $1; |
134 /^\s*(.*)\s*$/; |
174 } |
135 |
175 |
136 if (!length $1 and $param ~~ @{$FIELDS{MAN}}) { |
176 # Mail needs extra check |
137 push @{$warn{$param}}, "Leer!?"; |
177 if ($value{mail} and not valid($value{mail})) { |
|
178 push @{$warn{mail}}, "Keine gültig erscheinende Mail-Adresse."; |
|
179 } |
|
180 |
|
181 foreach (keys %warn) { |
|
182 $warn{$_} = join " ", @{$warn{$_}}; |
|
183 } |
|
184 |
|
185 if (!%warn) { |
|
186 my %r = insert(%value); |
|
187 |
|
188 open(my $sendmail => "|$SENDMAIL") |
|
189 or die "Can't open $SENDMAIL: $!\n"; |
|
190 |
|
191 $tt->process("mail.form-ack.tpl", { |
|
192 to => $value{mail}, |
|
193 url => { |
|
194 yes => "$SELF/$r{uuid}.user?confirm=yes", |
|
195 no => "$SELF/$r{uuid}.user?confirm=no", |
|
196 } |
138 } |
197 }, $sendmail) |
139 |
198 or die $tt->error(); |
140 if (length $1 > 200) { |
199 |
141 push @{$warn{$param}}, "Zu lang (bitte weniger als 200 Zeichen)."; |
200 close($sendmail); |
142 } |
201 |
143 |
202 $tt->process("html.form-ack.tpl", { |
144 param(-name => $param, value => $1); |
203 value => \%value, |
145 $value{$param} = $1; |
204 timestamp => $r{timestamp}, |
146 } |
205 uuid => $r{uuid}, |
147 |
206 }) or die $tt->error(); |
148 # Mail needs extra check |
207 exit 0; |
149 if ($value{mail} and not valid($value{mail})) { |
208 } |
150 push @{$warn{mail}}, "Keine gültig erscheinende Mail-Adresse."; |
209 } |
151 } |
210 |
152 |
211 |
153 foreach (keys %warn) { |
212 ## Formular |
154 $warn{$_} = join " ", @{$warn{$_}}; |
213 $tt->process("html.form.tpl", { |
155 } |
214 warn => %warn ? \%warn : undef, |
156 |
215 value => { |
157 if (!%warn) { |
216 givenname => scalar param("givenname"), |
158 my %r = insert(%value); |
217 surname => scalar param("surname"), |
159 |
218 mail => scalar param("mail"), |
160 open(my $sendmail => "|$SENDMAIL") |
219 }, |
161 or die "Can't open $SENDMAIL: $!\n"; |
220 } ) or die $tt->error(); |
162 |
|
163 $tt->process("mail.form-ack.tpl", { |
|
164 to => $value{mail}, |
|
165 url => { |
|
166 yes => "$SELF/user.$r{uuid}?confirm=yes", |
|
167 no => "$SELF/user.$r{uuid}?confirm=no", |
|
168 } |
|
169 }, $sendmail) |
|
170 or die $tt->error(); |
|
171 |
|
172 close($sendmail); |
|
173 |
|
174 $tt->process("html.form-ack.tpl", { |
|
175 value => \%value, |
|
176 created => $r{created}, |
|
177 uuid => $r{uuid}, |
|
178 }) or die $tt->error(); |
|
179 exit 0; |
|
180 } |
|
181 } |
|
182 |
|
183 $tt->process("html.form.tpl", { |
|
184 warn => %warn ? \%warn : undef, |
|
185 value => { |
|
186 givenname => scalar param("givenname"), |
|
187 surname => scalar param("surname"), |
|
188 mail => scalar param("mail"), |
|
189 }, |
|
190 } ) or die $tt->error(); |
|
191 exit 0; |
|
192 } |
|
193 |
|
194 $tt->process("html.denied.tpl", { |
|
195 url => $SELF, |
|
196 }) or die $tt->error(); |
221 exit 0; |
197 exit 0; |
222 } |
198 } |
223 |
199 |
224 sub insert(\%) { |
200 sub insert(\%) { |
225 my %value = %{$_[0]}; |
201 my %value = %{$_[0]}; |
226 my $uuid = sha1_hex($SECRET . |
202 my $uuid = sha1_hex($SECRET . |
227 join "\0" => @value{@{$FIELDS{MAN}}}); |
203 join "\0" => @value{@{$FIELDS{MAN}}}); |
228 |
204 |
229 $DBH->begin_work; |
205 $DBH->begin_work; |
230 my $sth; |
206 my $sth; |
231 $sth = $DBH->prepare("SELECT timestamp FROM db WHERE uuid = ?"); |
207 $sth = $DBH->prepare("SELECT created FROM db WHERE uuid = ?"); |
232 $sth->execute($uuid); |
208 $sth->execute($uuid); |
233 |
209 |
234 if (my $r = $sth->fetchrow_hashref) { |
210 if (my $r = $sth->fetchrow_hashref) { |
235 my $timestamp = $r->{timestamp}; |
211 my $created = $r->{created}; |
236 $DBH->rollback; |
212 $DBH->rollback; |
237 return (uuid => $uuid, |
213 return (uuid => $uuid, |
238 timestamp => $r->{timestamp}); |
214 created => $r->{created}); |
239 } |
215 } |
240 local $" = ", "; |
216 local $" = ", "; |
241 $sth = $DBH->prepare("INSERT INTO db (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}, uuid, timestamp) |
217 $sth = $DBH->prepare("INSERT INTO db (@{$FIELDS{MAN}}, @{$FIELDS{OPT}}, uuid, created) |
242 VALUES(?, ?, ?, ?, ?, ?)"); |
218 VALUES(?, ?, ?, ?, ?, datetime('now'))"); |
243 $sth->execute(@value{@{$FIELDS{MAN}}, @{$FIELDS{OPT}}}, $uuid, time); |
219 $sth->execute(@value{@{$FIELDS{MAN}}, @{$FIELDS{OPT}}}, $uuid); |
244 $DBH->commit; |
220 $DBH->commit; |
245 |
221 |
246 return (uuid => $uuid, |
222 return (uuid => $uuid, |
247 timestamp => undef); |
223 timestamp => undef); |
248 |
|
249 } |
224 } |
250 |
225 |
251 sub confirm($$) { |
226 sub confirm($$) { |
252 my ($uuid, $confirmed) = @_; |
227 my ($uuid, $confirmed) = @_; |
253 my %data; |
228 my %data; |
254 $DBH->begin_work; |
229 $DBH->begin_work; |
255 |
230 |
256 local $" = ", "; |
231 local $" = ", "; |
257 my $sth = $DBH->prepare("SELECT @{$FIELDS{MAN}}, @{$FIELDS{OPT}} FROM db WHERE uuid = ?"); |
232 my $sth = $DBH->prepare("SELECT @{$FIELDS{MAN}}, @{$FIELDS{OPT}}, confirmed FROM db WHERE uuid = ?"); |
258 $sth->execute($uuid); |
233 $sth->execute($uuid); |
259 my $r = $sth->fetchrow_hashref; |
234 my $r = $sth->fetchrow_hashref; |
260 if (!$r) { |
235 if (!$r) { |
261 $DBH->rollback; |
236 $DBH->rollback; |
262 return (error => "NOT FOUND"); |
237 return (error => "NOT FOUND"); |