git.oblomov.eu Git - ikiwiki/blob - 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