Fix fatal typos in danish directives underlay translation
[ikiwiki.git] / IkiWiki / CGI.pm
blobaf58d7cb56893a831d5ae798d5c5f16fc96b23fd
1 #!/usr/bin/perl
3 package IkiWiki;
5 use warnings;
6 use strict;
7 use IkiWiki;
8 use IkiWiki::UserInfo;
9 use open qw{:utf8 :std};
10 use Encode;
12 sub printheader ($) {
13 my $session=shift;
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));
24 sub showform ($$$$;@) {
25 my $form=shift;
26 my $buttons=shift;
27 my $session=shift;
28 my $cgi=shift;
30 if (exists $hooks{formbuilder}) {
31 run_hooks(formbuilder => sub {
32 shift->(form => $form, cgi => $cgi, session => $session,
33 buttons => $buttons);
34 });
37 printheader($session);
38 print misctemplate($form->title, $form->render(submit => $buttons), @_);
41 sub redirect ($$) {
42 my $q=shift;
43 my $url=shift;
44 if (! $config{w3mmode}) {
45 print $q->redirect($url);
47 else {
48 print "Content-type: text/plain\n";
49 print "W3m-control: GOTO $url\n\n";
53 sub decode_cgi_utf8 ($) {
54 # decode_form_utf8 method is needed for 5.10
55 if ($] < 5.01) {
56 my $cgi = shift;
57 foreach my $f ($cgi->param) {
58 $cgi->param($f, map { decode_utf8 $_ } $cgi->param($f));
63 sub decode_form_utf8 ($) {
64 if ($] >= 5.01) {
65 my $form = shift;
66 foreach my $f ($form->field) {
67 $form->field(name => $f,
68 value => decode_utf8($form->field($f)),
69 force => 1,
75 # Check if the user is signed in. If not, redirect to the signin form and
76 # save their place to return to later.
77 sub needsignin ($$) {
78 my $q=shift;
79 my $session=shift;
81 if (! defined $session->param("name") ||
82 ! userinfo_get($session->param("name"), "regdate")) {
83 $session->param(postsignin => $ENV{QUERY_STRING});
84 cgi_signin($q, $session);
85 cgi_savesession($session);
86 exit;
90 sub cgi_signin ($$) {
91 my $q=shift;
92 my $session=shift;
94 decode_cgi_utf8($q);
95 eval q{use CGI::FormBuilder};
96 error($@) if $@;
97 my $form = CGI::FormBuilder->new(
98 title => "signin",
99 name => "signin",
100 charset => "utf-8",
101 method => 'POST',
102 required => 'NONE',
103 javascript => 0,
104 params => $q,
105 action => $config{cgiurl},
106 header => 0,
107 template => {type => 'div'},
108 stylesheet => baseurl()."style.css",
110 my $buttons=["Login"];
112 if ($q->param("do") ne "signin" && !$form->submitted) {
113 $form->text(gettext("You need to log in first."));
115 $form->field(name => "do", type => "hidden", value => "signin",
116 force => 1);
118 decode_form_utf8($form);
119 run_hooks(formbuilder_setup => sub {
120 shift->(form => $form, cgi => $q, session => $session,
121 buttons => $buttons);
123 decode_form_utf8($form);
125 if ($form->submitted) {
126 $form->validate;
129 showform($form, $buttons, $session, $q);
132 sub cgi_postsignin ($$) {
133 my $q=shift;
134 my $session=shift;
136 # Continue with whatever was being done before the signin process.
137 if (defined $session->param("postsignin")) {
138 my $postsignin=CGI->new($session->param("postsignin"));
139 $session->clear("postsignin");
140 cgi($postsignin, $session);
141 cgi_savesession($session);
142 exit;
144 else {
145 if ($config{sslcookie} && ! $q->https()) {
146 error(gettext("probable misconfiguration: sslcookie is set, but you are attempting to login via http, not https"));
148 else {
149 error(gettext("login failed, perhaps you need to turn on cookies?"));
154 sub cgi_prefs ($$) {
155 my $q=shift;
156 my $session=shift;
158 needsignin($q, $session);
159 decode_cgi_utf8($q);
161 # The session id is stored on the form and checked to
162 # guard against CSRF.
163 my $sid=$q->param('sid');
164 if (! defined $sid) {
165 $q->delete_all;
167 elsif ($sid ne $session->id) {
168 error(gettext("Your login session has expired."));
171 eval q{use CGI::FormBuilder};
172 error($@) if $@;
173 my $form = CGI::FormBuilder->new(
174 title => "preferences",
175 name => "preferences",
176 header => 0,
177 charset => "utf-8",
178 method => 'POST',
179 validate => {
180 email => 'EMAIL',
182 required => 'NONE',
183 javascript => 0,
184 params => $q,
185 action => $config{cgiurl},
186 template => {type => 'div'},
187 stylesheet => baseurl()."style.css",
188 fieldsets => [
189 [login => gettext("Login")],
190 [preferences => gettext("Preferences")],
191 [admin => gettext("Admin")]
194 my $buttons=["Save Preferences", "Logout", "Cancel"];
196 decode_form_utf8($form);
197 run_hooks(formbuilder_setup => sub {
198 shift->(form => $form, cgi => $q, session => $session,
199 buttons => $buttons);
201 decode_form_utf8($form);
203 $form->field(name => "do", type => "hidden", value => "prefs",
204 force => 1);
205 $form->field(name => "sid", type => "hidden", value => $session->id,
206 force => 1);
207 $form->field(name => "email", size => 50, fieldset => "preferences");
209 my $user_name=$session->param("name");
211 if (! $form->submitted) {
212 $form->field(name => "email", force => 1,
213 value => userinfo_get($user_name, "email"));
216 if ($form->submitted eq 'Logout') {
217 $session->delete();
218 redirect($q, $config{url});
219 return;
221 elsif ($form->submitted eq 'Cancel') {
222 redirect($q, $config{url});
223 return;
225 elsif ($form->submitted eq 'Save Preferences' && $form->validate) {
226 if (defined $form->field('email')) {
227 userinfo_set($user_name, 'email', $form->field('email')) ||
228 error("failed to set email");
231 $form->text(gettext("Preferences saved."));
234 showform($form, $buttons, $session, $q);
237 sub cgi_custom_failure ($$) {
238 my $header=shift;
239 my $message=shift;
241 print $header;
242 print $message;
244 # Internet Explod^Hrer won't show custom 404 responses
245 # unless they're >= 512 bytes
246 print ' ' x 512;
248 exit;
251 sub check_banned ($$) {
252 my $q=shift;
253 my $session=shift;
255 my $name=$session->param("name");
256 if (defined $name) {
257 if (grep { $name eq $_ } @{$config{banned_users}}) {
258 $session->delete();
259 cgi_savesession($session);
260 cgi_custom_failure(
261 $q->header(-status => "403 Forbidden"),
262 gettext("You are banned."));
267 sub cgi_getsession ($) {
268 my $q=shift;
270 eval q{use CGI::Session; use HTML::Entities};
271 error($@) if $@;
272 CGI::Session->name("ikiwiki_session_".encode_entities($config{wikiname}));
274 my $oldmask=umask(077);
275 my $session = eval {
276 CGI::Session->new("driver:DB_File", $q,
277 { FileName => "$config{wikistatedir}/sessions.db" })
279 if (! $session || $@) {
280 error($@." ".CGI::Session->errstr());
283 umask($oldmask);
285 return $session;
288 # To guard against CSRF, the user's session id (sid)
289 # can be stored on a form. This function will check
290 # (for logged in users) that the sid on the form matches
291 # the session id in the cookie.
292 sub checksessionexpiry ($$) {
293 my $q=shift;
294 my $session = shift;
296 if (defined $session->param("name")) {
297 my $sid=$q->param('sid');
298 if (! defined $sid || $sid ne $session->id) {
299 error(gettext("Your login session has expired."));
304 sub cgi_savesession ($) {
305 my $session=shift;
307 # Force session flush with safe umask.
308 my $oldmask=umask(077);
309 $session->flush;
310 umask($oldmask);
313 sub cgi (;$$) {
314 my $q=shift;
315 my $session=shift;
317 eval q{use CGI};
318 error($@) if $@;
319 $CGI::DISABLE_UPLOADS=$config{cgi_disable_uploads};
321 if (! $q) {
322 binmode(STDIN);
323 $q=CGI->new;
324 binmode(STDIN, ":utf8");
326 run_hooks(cgi => sub { shift->($q) });
329 my $do=$q->param('do');
330 if (! defined $do || ! length $do) {
331 my $error = $q->cgi_error;
332 if ($error) {
333 error("Request not processed: $error");
335 else {
336 error("\"do\" parameter missing");
340 # Need to lock the wiki before getting a session.
341 lockwiki();
342 loadindex();
344 if (! $session) {
345 $session=cgi_getsession($q);
348 # Auth hooks can sign a user in.
349 if ($do ne 'signin' && ! defined $session->param("name")) {
350 run_hooks(auth => sub {
351 shift->($q, $session)
353 if (defined $session->param("name")) {
354 # Make sure whatever user was authed is in the
355 # userinfo db.
356 if (! userinfo_get($session->param("name"), "regdate")) {
357 userinfo_setall($session->param("name"), {
358 email => "",
359 password => "",
360 regdate => time,
361 }) || error("failed adding user");
366 check_banned($q, $session);
368 run_hooks(sessioncgi => sub { shift->($q, $session) });
370 if ($do eq 'signin') {
371 cgi_signin($q, $session);
372 cgi_savesession($session);
374 elsif ($do eq 'prefs') {
375 cgi_prefs($q, $session);
377 elsif (defined $session->param("postsignin") || $do eq 'postsignin') {
378 cgi_postsignin($q, $session);
380 else {
381 error("unknown do parameter");
385 # Does not need to be called directly; all errors will go through here.
386 sub cgierror ($) {
387 my $message=shift;
389 print "Content-type: text/html\n\n";
390 print misctemplate(gettext("Error"),
391 "<p class=\"error\">".gettext("Error").": $message</p>");
392 die $@;