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