make decode_form_utf8 safe for arrays
[ikiwiki] / IkiWiki / CGI.pm
1 #!/usr/bin/perl
2
3 package IkiWiki;
4
5 use warnings;
6 use strict;
7 use IkiWiki;
8 use IkiWiki::UserInfo;
9 use open qw{:utf8 :std};
10 use Encode;
11
12 sub printheader ($) {
13         my $session=shift;
14         
15         if ($config{sslcookie}) {
16                 print $session->header(-charset => 'utf-8',
17                         -cookie => $session->cookie(-httponly => 1, -secure => 1));
18         } else {
19                 print $session->header(-charset => 'utf-8',
20                         -cookie => $session->cookie(-httponly => 1));
21         }
22 }
23
24 sub showform ($$$$;@) {
25         my $form=shift;
26         my $buttons=shift;
27         my $session=shift;
28         my $cgi=shift;
29
30         if (exists $hooks{formbuilder}) {
31                 run_hooks(formbuilder => sub {
32                         shift->(form => $form, cgi => $cgi, session => $session,
33                                 buttons => $buttons);
34                 });
35         }
36
37         printheader($session);
38         print misctemplate($form->title, $form->render(submit => $buttons), @_);
39 }
40
41 sub redirect ($$) {
42         my $q=shift;
43         eval q{use URI};
44         my $url=URI->new(shift);
45         if (! $config{w3mmode}) {
46                 print $q->redirect($url);
47         }
48         else {
49                 print "Content-type: text/plain\n";
50                 print "W3m-control: GOTO $url\n\n";
51         }
52 }
53
54 sub decode_cgi_utf8 ($) {
55         # decode_form_utf8 method is needed for 5.10
56         if ($] < 5.01) {
57                 my $cgi = shift;
58                 foreach my $f ($cgi->param) {
59                         $cgi->param($f, map { decode_utf8 $_ } $cgi->param($f));
60                 }
61         }
62 }
63
64 sub decode_form_utf8 ($) {
65         if ($] >= 5.01) {
66                 my $form = shift;
67                 foreach my $f ($form->field) {
68                         my @value=map { decode_utf8($_) } $form->field($f);
69                         $form->field(name  => $f,
70                                      value => \@value,
71                                      force => 1,
72                         );
73                 }
74         }
75 }
76
77 # Check if the user is signed in. If not, redirect to the signin form and
78 # save their place to return to later.
79 sub needsignin ($$) {
80         my $q=shift;
81         my $session=shift;
82
83         if (! defined $session->param("name") ||
84             ! userinfo_get($session->param("name"), "regdate")) {
85                 $session->param(postsignin => $ENV{QUERY_STRING});
86                 cgi_signin($q, $session);
87                 cgi_savesession($session);
88                 exit;
89         }
90 }
91
92 sub cgi_signin ($$) {
93         my $q=shift;
94         my $session=shift;
95
96         decode_cgi_utf8($q);
97         eval q{use CGI::FormBuilder};
98         error($@) if $@;
99         my $form = CGI::FormBuilder->new(
100                 title => "signin",
101                 name => "signin",
102                 charset => "utf-8",
103                 method => 'POST',
104                 required => 'NONE',
105                 javascript => 0,
106                 params => $q,
107                 action => $config{cgiurl},
108                 header => 0,
109                 template => {type => 'div'},
110                 stylesheet => baseurl()."style.css",
111         );
112         my $buttons=["Login"];
113         
114         if ($q->param("do") ne "signin" && !$form->submitted) {
115                 $form->text(gettext("You need to log in first."));
116         }
117         $form->field(name => "do", type => "hidden", value => "signin",
118                 force => 1);
119         
120         decode_form_utf8($form);
121         run_hooks(formbuilder_setup => sub {
122                 shift->(form => $form, cgi => $q, session => $session,
123                         buttons => $buttons);
124         });
125         decode_form_utf8($form);
126
127         if ($form->submitted) {
128                 $form->validate;
129         }
130
131         showform($form, $buttons, $session, $q);
132 }
133
134 sub cgi_postsignin ($$) {
135         my $q=shift;
136         my $session=shift;
137         
138         # Continue with whatever was being done before the signin process.
139         if (defined $session->param("postsignin")) {
140                 my $postsignin=CGI->new($session->param("postsignin"));
141                 $session->clear("postsignin");
142                 cgi($postsignin, $session);
143                 cgi_savesession($session);
144                 exit;
145         }
146         else {
147                 if ($config{sslcookie} && ! $q->https()) {
148                         error(gettext("probable misconfiguration: sslcookie is set, but you are attempting to login via http, not https"));
149                 }
150                 else {
151                         error(gettext("login failed, perhaps you need to turn on cookies?"));
152                 }
153         }
154 }
155
156 sub cgi_prefs ($$) {
157         my $q=shift;
158         my $session=shift;
159
160         needsignin($q, $session);
161         decode_cgi_utf8($q);
162         
163         # The session id is stored on the form and checked to
164         # guard against CSRF.
165         my $sid=$q->param('sid');
166         if (! defined $sid) {
167                 $q->delete_all;
168         }
169         elsif ($sid ne $session->id) {
170                 error(gettext("Your login session has expired."));
171         }
172
173         eval q{use CGI::FormBuilder};
174         error($@) if $@;
175         my $form = CGI::FormBuilder->new(
176                 title => "preferences",
177                 name => "preferences",
178                 header => 0,
179                 charset => "utf-8",
180                 method => 'POST',
181                 validate => {
182                         email => 'EMAIL',
183                 },
184                 required => 'NONE',
185                 javascript => 0,
186                 params => $q,
187                 action => $config{cgiurl},
188                 template => {type => 'div'},
189                 stylesheet => baseurl()."style.css",
190                 fieldsets => [
191                         [login => gettext("Login")],
192                         [preferences => gettext("Preferences")],
193                         [admin => gettext("Admin")]
194                 ],
195         );
196         my $buttons=["Save Preferences", "Logout", "Cancel"];
197         
198         decode_form_utf8($form);
199         run_hooks(formbuilder_setup => sub {
200                 shift->(form => $form, cgi => $q, session => $session,
201                         buttons => $buttons);
202         });
203         decode_form_utf8($form);
204         
205         $form->field(name => "do", type => "hidden", value => "prefs",
206                 force => 1);
207         $form->field(name => "sid", type => "hidden", value => $session->id,
208                 force => 1);
209         $form->field(name => "email", size => 50, fieldset => "preferences");
210         
211         my $user_name=$session->param("name");
212
213         if (! $form->submitted) {
214                 $form->field(name => "email", force => 1,
215                         value => userinfo_get($user_name, "email"));
216         }
217         
218         if ($form->submitted eq 'Logout') {
219                 $session->delete();
220                 redirect($q, $config{url});
221                 return;
222         }
223         elsif ($form->submitted eq 'Cancel') {
224                 redirect($q, $config{url});
225                 return;
226         }
227         elsif ($form->submitted eq 'Save Preferences' && $form->validate) {
228                 if (defined $form->field('email')) {
229                         userinfo_set($user_name, 'email', $form->field('email')) ||
230                                 error("failed to set email");
231                 }
232
233                 $form->text(gettext("Preferences saved."));
234         }
235         
236         showform($form, $buttons, $session, $q);
237 }
238
239 sub cgi_custom_failure ($$$) {
240         my $q=shift;
241         my $httpstatus=shift;
242         my $message=shift;
243
244         print $q->header(
245                 -status => $httpstatus,
246                 -charset => 'utf-8',
247         );
248         print $message;
249
250         # Internet Explod^Hrer won't show custom 404 responses
251         # unless they're >= 512 bytes
252         print ' ' x 512;
253
254         exit;
255 }
256
257 sub check_banned ($$) {
258         my $q=shift;
259         my $session=shift;
260
261         my $banned=0;
262         my $name=$session->param("name");
263         if (defined $name && 
264             grep { $name eq $_ } @{$config{banned_users}}) {
265                 $banned=1;
266         }
267
268         foreach my $b (@{$config{banned_users}}) {
269                 if (pagespec_match("", $b,
270                         ip => $ENV{REMOTE_ADDR},
271                         name => defined $name ? $name : "",
272                 )) {
273                         $banned=1;
274                         last;
275                 }
276         }
277
278         if ($banned) {
279                 $session->delete();
280                 cgi_savesession($session);
281                 cgi_custom_failure(
282                         $q, "403 Forbidden",
283                         gettext("You are banned."));
284         }
285 }
286
287 sub cgi_getsession ($) {
288         my $q=shift;
289
290         eval q{use CGI::Session; use HTML::Entities};
291         error($@) if $@;
292         CGI::Session->name("ikiwiki_session_".encode_entities($config{wikiname}));
293         
294         my $oldmask=umask(077);
295         my $session = eval {
296                 CGI::Session->new("driver:DB_File", $q,
297                         { FileName => "$config{wikistatedir}/sessions.db" })
298         };
299         if (! $session || $@) {
300                 error($@." ".CGI::Session->errstr());
301         }
302         
303         umask($oldmask);
304
305         return $session;
306 }
307
308 # To guard against CSRF, the user's session id (sid)
309 # can be stored on a form. This function will check
310 # (for logged in users) that the sid on the form matches
311 # the session id in the cookie.
312 sub checksessionexpiry ($$) {
313         my $q=shift;
314         my $session = shift;
315
316         if (defined $session->param("name")) {
317                 my $sid=$q->param('sid');
318                 if (! defined $sid || $sid ne $session->id) {
319                         error(gettext("Your login session has expired."));
320                 }
321         }
322 }
323
324 sub cgi_savesession ($) {
325         my $session=shift;
326
327         # Force session flush with safe umask.
328         my $oldmask=umask(077);
329         $session->flush;
330         umask($oldmask);
331 }
332
333 sub cgi (;$$) {
334         my $q=shift;
335         my $session=shift;
336
337         eval q{use CGI};
338         error($@) if $@;
339         $CGI::DISABLE_UPLOADS=$config{cgi_disable_uploads};
340
341         if (! $q) {
342                 binmode(STDIN);
343                 $q=CGI->new;
344                 binmode(STDIN, ":utf8");
345         
346                 run_hooks(cgi => sub { shift->($q) });
347         }
348
349         my $do=$q->param('do');
350         if (! defined $do || ! length $do) {
351                 my $error = $q->cgi_error;
352                 if ($error) {
353                         error("Request not processed: $error");
354                 }
355                 else {
356                         error("\"do\" parameter missing");
357                 }
358         }
359
360         # Need to lock the wiki before getting a session.
361         lockwiki();
362         loadindex();
363         
364         if (! $session) {
365                 $session=cgi_getsession($q);
366         }
367         
368         # Auth hooks can sign a user in.
369         if ($do ne 'signin' && ! defined $session->param("name")) {
370                 run_hooks(auth => sub {
371                         shift->($q, $session)
372                 });
373                 if (defined $session->param("name")) {
374                         # Make sure whatever user was authed is in the
375                         # userinfo db.
376                         if (! userinfo_get($session->param("name"), "regdate")) {
377                                 userinfo_setall($session->param("name"), {
378                                         email => "",
379                                         password => "",
380                                         regdate => time,
381                                 }) || error("failed adding user");
382                         }
383                 }
384         }
385         
386         check_banned($q, $session);
387         
388         run_hooks(sessioncgi => sub { shift->($q, $session) });
389
390         if ($do eq 'signin') {
391                 cgi_signin($q, $session);
392                 cgi_savesession($session);
393         }
394         elsif ($do eq 'prefs') {
395                 cgi_prefs($q, $session);
396         }
397         elsif (defined $session->param("postsignin") || $do eq 'postsignin') {
398                 cgi_postsignin($q, $session);
399         }
400         else {
401                 error("unknown do parameter");
402         }
403 }
404
405 # Does not need to be called directly; all errors will go through here.
406 sub cgierror ($) {
407         my $message=shift;
408
409         print "Content-type: text/html\n\n";
410         print misctemplate(gettext("Error"),
411                 "<p class=\"error\">".gettext("Error").": $message</p>");
412         die $@;
413 }
414
415 1