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