This file is indexed.

/usr/share/perl5/MojoMojo.pm is in libmojomojo-perl 1.11+dfsg-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
package MojoMojo;

use strict;
use Path::Class 'file';

use Catalyst qw/
  ConfigLoader
  Authentication
  Cache
  Session
  Session::Store::Cache
  Session::State::Cookie
  Static::Simple
  SubRequest
  Unicode
  I18N
  Setenv
  /;

use Storable;
use Digest::MD5;
use Data::Dumper;
use DateTime;
use MRO::Compat;
use DBIx::Class::ResultClass::HashRefInflator;
use Encode      ();
use URI::Escape ();
use MojoMojo::Formatter::Wiki;
use Module::Pluggable::Ordered
  search_path => 'MojoMojo::Formatter',
  except      => qr/^MojoMojo::Plugin::/,
  require     => 1;

our $VERSION = '1.11';
use 5.008004;

MojoMojo->config->{authentication}{dbic} = {
  user_class     => 'DBIC::Person',
  user_field     => 'login',
  password_field => 'pass'
};
MojoMojo->config->{default_view} = 'TT';
MojoMojo->config->{'Plugin::Cache'}{backend} = {
  class          => "Cache::FastMmap",
  unlink_on_exit => 1,
  share_file     => ''
    . Path::Class::file(
    File::Spec->tmpdir,
    'mojomojo-sharefile-' . Digest::MD5::md5_hex(MojoMojo->config->{home})
    ),
};

__PACKAGE__->config(
  authentication => {
    default_realm => 'members',
    use_session   => 1,
    realms        => {
      members => {
        credential => {
          class              => 'Password',
          password_field     => 'pass',
          password_type      => 'hashed',
          password_hash_type => 'SHA-1',
        },
        store => {class => 'DBIx::Class', user_class => 'DBIC::Person',},
      },
    }
  }
);

__PACKAGE__->config('Controller::HTML::FormFu' =>
    {languages_from_context => 1, localize_from_context => 1,});

__PACKAGE__->config(setup_components => {search_extra => ['::Extensions'],});

MojoMojo->setup();

# Check for deployed database
my $has_DB        = 1;
my $NO_DB_MESSAGE = <<"EOF";

    ***********************************************
    ERROR. Looks like you need to deploy a database.
    Run script/mojomojo_spawn_db.pl
    ***********************************************

EOF
eval {
  MojoMojo->model('DBIC')
    ->schema->resultset('MojoMojo::Schema::Result::Person')->next;
};
if ($@) {
  $has_DB = 0;
  warn $NO_DB_MESSAGE;
  warn "(Error: $@)";
}

MojoMojo->model('DBIC')
  ->schema->attachment_dir(MojoMojo->config->{attachment_dir}
    || MojoMojo->path_to('uploads') . '');

=head1 NAME

MojoMojo - A Wiki with a tree

=head1 SYNOPSIS

  # Set up database (see mojomojo.conf first)

  ./script/mojomojo_spawn_db.pl

  # Standalone mode

  ./script/mojomo_server.pl

  # In apache conf
  <Location /mojomojo>
    SetHandler perl-script
    PerlHandler MojoMojo
  </Location>

=head1 DESCRIPTION

Mojomojo is a content management system, borrowing many concepts from
wikis and blogs. It allows you to maintain a full tree-structure of pages,
and to interlink them in various ways. It has full version support, so you can
always go back to a previous version and see what's changed with an easy diff
system. There are also a some of useful features like live AJAX preview while
editing, tagging, built-in fulltext search, image galleries, and RSS feeds
for every wiki page.

To find out more about how you can use MojoMojo, please visit
L<http://mojomojo.org/> or read the installation instructions in
L<MojoMojo::Installation> to try it out yourself.

=head1 METHODS

=head2 prepare

Accommodate a forcing of SSL if needed in a reverse proxy setup.

=cut

sub prepare {
  my $self = shift->next::method(@_);
  if ($self->config->{force_ssl}) {
    my $request = $self->request;
    $request->base->scheme('https');
    $request->uri->scheme('https');
  }
  return $self;
}


=head2 ajax

Return whether the request is an AJAX one (used by the live preview,
for example), as opposed to a rgular request (such as one used to view
a page).

=cut

sub ajax {
  my ($c) = @_;
  return $c->req->header('x-requested-with')
    && $c->req->header('x-requested-with') eq 'XMLHttpRequest';
}

=head2 expand_wikilink

Proxy method for the L<MojoMojo::Formatter::Wiki> expand_wikilink method.

=cut

sub expand_wikilink {
  my $c = shift;
  return MojoMojo::Formatter::Wiki->expand_wikilink(@_);
}

=head2 wikiword

Format a wikiword as a link or as a wanted page, as appropriate.

=cut

sub wikiword {
  return MojoMojo::Formatter::Wiki->format_link(@_);
}

=head2 pref

Find or create a preference key. Update it if a value is passed, then
return the current setting.

=cut

sub pref {
  my ($c, $setting, $value) = @_;

  return unless $setting;

  # Unfortunately there are MojoMojo->pref() calls in
  # MojoMojo::Schema::Result::Person which makes it hard
  # to get cache working for those calls - so we'll just
  # not use caching for those calls.
  return $c->pref_cached($setting, $value) if ref($c) eq 'MojoMojo';

  $setting
    = $c->model('DBIC::Preference')->find_or_create({prefkey => $setting});
  if (defined $value) {
    $setting->prefvalue($value);
    $setting->update();
    return $value;
  }
  return (defined $setting->prefvalue() ? $setting->prefvalue : "");
}

=head2 pref_cached

Get preference key/value from cache if possible.

=cut

sub pref_cached {
  my ($c, $setting, $value) = @_;

  # Already in cache and no new value to set?
  if (defined $c->cache->get($setting) and not defined $value) {
    return $c->cache->get($setting);
  }

  # Check that we have a database, i.e. script/mojomojo_spawn_db.pl was run.
  my $row;
  $row = $c->model('DBIC::Preference')->find_or_create({prefkey => $setting});

  # Update database
  $row->update({prefvalue => $value}) if defined $value;

  my $prefvalue = $row->prefvalue();

  # if no entry in preferences, try get one from config or get default value
  unless (defined $prefvalue) {

    if ($setting eq 'main_formatter') {
      $prefvalue
        = defined $c->config->{'main_formatter'}
        ? $c->config->{'main_formatter'}
        : 'MojoMojo::Formatter::Markdown';
    }
    elsif ($setting eq 'default_lang') {
      $prefvalue
        = defined $c->config->{$setting} ? $c->config->{$setting} : 'en';
    }
    elsif ($setting eq 'name') {
      $prefvalue
        = defined $c->config->{$setting} ? $c->config->{$setting} : 'MojoMojo';
    }
    elsif ($setting eq 'theme') {
      $prefvalue
        = defined $c->config->{$setting} ? $c->config->{$setting} : 'default';
    }
    elsif ($setting =~ /^(enforce_login|check_permission_on_view)$/) {
      $prefvalue
        = defined $c->config->{'permissions'}{$setting}
        ? $c->config->{'permissions'}{$setting}
        : 0;
    }
    elsif ($setting
      =~ /^(cache_permission_data|create_allowed|delete_allowed|edit_allowed|view_allowed|attachment_allowed)$/
      )
    {
      $prefvalue
        = defined $c->config->{'permissions'}{$setting}
        ? $c->config->{'permissions'}{$setting}
        : 1;
    }
    else {
      $prefvalue = $c->config->{$setting};
    }

  }

  # Update cache
  $c->cache->set($setting => $prefvalue);

  return $c->cache->get($setting);
}

=head2 fixw

Clean up wiki words: replace spaces with underscores and remove non-\w, / and .
characters.

=cut

sub fixw {
  my ($c, $w) = @_;
  $w =~ s/\s/\_/g;
  $w =~ s/[^\w\/\.]//g;
  return $w;
}

=head2 tz

Convert timezone

=cut

sub tz {
  my ($c, $dt) = @_;
  if ($c->user && $c->user->timezone) {
    eval { $dt->set_time_zone($c->user->timezone) };
  }
  return $dt;
}

=head2 prepare_action

Provide "No DB" message when one needs to spawn the db (script/mojomojo_spawn.pl).

=cut

sub prepare_action {
  my $c = shift;

  if ($has_DB) {
    $c->next::method(@_);
  }
  else {
    $c->res->status(404);
    $c->response->body($NO_DB_MESSAGE);
    return;
  }
}

=head2 prepare_path

We override this method to work around some of Catalyst's assumptions about
dispatching. Since MojoMojo supports page namespaces
(e.g. C</parent_page/child_page>), with page paths that always start with C</>,
we strip the trailing slash from C<< $c->req->base >>. Also, since MojoMojo
indicates actions by appending a C<.$action> to the path
(e.g. C</parent_page/child_page.edit>), we remove the page path and save it in
C<< $c->stash->{path} >> and reset C<< $c->req->path >> to C<< $action >>.
We save the original URI in C<< $c->stash->{pre_hacked_uri} >>.

=cut

sub prepare_path {
  my $c = shift;
  $c->next::method(@_);
  $c->stash->{pre_hacked_uri} = $c->req->uri->clone;
  my $base = $c->req->base;
  $base =~ s|/+$||;
  $c->req->base(URI->new($base));
  my ($path, $action);
  $path = $c->req->path;

  if ($path =~ /^special(?:\/|$)(.*)/) {
    $c->stash->{path} = $path;
    $c->req->path($1);
  }
  else {
    # find the *last* period, so that pages can have periods in their name.
    my $index = index($path, '.');

    if ($index == -1) {

      # no action found, default to view
      $c->stash->{path} = $path;
      $c->req->path('view');
    }
    else {

      # set path in stash, and set req.path to action
      $c->stash->{path} = substr($path, 0, $index);
      $c->req->path(substr($path, $index + 1));
    }
  }
  $c->stash->{path} = '/' . $c->stash->{path} unless ($path =~ m!^/!);
}

=head2 base_uri

Return C<< $c->req->base >> as an URI object.

=cut

sub base_uri {
  my $c = shift;
  return URI->new($c->req->base);
}

=head2 uri_for

Override C<< $c->uri_for >> to append path, if a relative path is used.

=cut

sub uri_for {
  my $c = shift;
  unless ($_[0] =~ m/^\//) {
    my $val = shift @_;
    my $prefix = $c->stash->{path} =~ m|^/| ? '' : '/';
    unshift(@_, $prefix . $c->stash->{path} . '.' . $val);
  }

  # do I see unicode here?
  if (Encode::is_utf8($_[0])) {
    $_[0]
      = join('/', map { URI::Escape::uri_escape_utf8($_) } split(/\//, $_[0]));
  }

  my $res = $c->next::method(@_);
  $res->scheme('https') if $c->config->{'force_ssl'};
  return $res;
}

=head2 uri_for_static

C</static/> has been remapped to C</.static/>.

=cut

sub uri_for_static {
  my ($self, $asset) = @_;
  return (
    defined($self->config->{static_path})
    ? $self->config->{static_path} . $asset
    : $self->uri_for('/.static', $asset));
}

=head2 _cleanup_path

Lowercase the path and remove any double-slashes.

=cut

sub _cleanup_path {
  my ($c, $path) = @_;
  ## Make some changes to the path - we have to do this
  ## because path is not always cleaned up before we get it:
  ## sometimes we get caps, other times we don't. Permissions are
  ## set using lowercase paths.

  ## lowercase the path - and ensure it has a leading /
  my $searchpath = lc($path);

  # clear out any double-slashes
  $searchpath =~ s|//|/|g;

  return $searchpath;
}

=head2 _expand_path_elements

Generate all the intermediary paths to C</path/to/a/page>, starting from C</>
and ending with the complete path:

    /
    /path
    /path/to
    /path/to/a
    /path/to/a/page

=cut    

sub _expand_path_elements {
  my ($c, $path) = @_;
  my $searchpath = $c->_cleanup_path($path);

  my @pathelements = split '/', $searchpath;

  if (@pathelements && $pathelements[0] eq '') {
    shift @pathelements;
  }

  my @paths_to_check = ('/');

  my $current_path = '';

  foreach my $pathitem (@pathelements) {
    $current_path .= "/" . $pathitem;
    push @paths_to_check, $current_path;
  }

  return @paths_to_check;
}

=head2 get_permissions_data

Permissions are checked prior to most actions, including C<view> if that is
turned on in the configuration. The permission system works as follows:

=over

=item 1.

There is a base set of rules which may be defined in the application
config. These are:

    $c->config->{permissions}{view_allowed} = 1; # or 0
    
Similar entries exist for C<delete>, C<edit>, C<create> and C<attachment>.
If these config variables are not defined, the default is to allow anyone 
to do anything.

=item 2.

Global rules that apply to everyone may be specified by creating a
record with a role id of 0.

=item 3.

Rules are defined using a combination of path(s)?, and role and may be
applied to subpages or not.

TODO: clarify.

=item 4.

All rules matching a given user's roles and the current path are used to
determine the final yes/no on each permission. Rules are evaluated from
least-specific path to most specific. This means that when checking
permissions on C</foo/bar/baz>, permission rules set for C</foo> will be
overridden by rules set on C</foo/bar> when editing C</foo/bar/baz>. When two
rules (from different roles) are found for the same path prefix, explicit
C<allow>s override C<deny>s. Null entries for a given permission are always
ignored and do not affect the permissions defined at earlier level. This
allows you to change certain permissions (such as C<create>) only while not
affecting previously determined permissions for the other actions. Finally -
C<apply_to_subpages> C<yes>/C<no> is exclusive, meaning that a rule for C</foo> with
C<apply_to_subpages> set to C<yes> will apply to C</foo/bar> but not to C</foo>
alone. The endpoint in the path is always checked for a rule explicitly for that
page - meaning C<apply_to_subpages = no>.

=back

=cut

sub get_permissions_data {
  my ($c, $current_path, $paths_to_check, $role_ids) = @_;

  # default to roles for current user
  $role_ids ||= $c->user_role_ids($c->user);

  my $permdata;

  ## Now that we have our path elements to check, we have to figure out how we are accessing them.
  ## If we have caching turned on, we load the perms from the cache and walk the tree.
  ## Otherwise we pull what we need out of the DB. The structure is:
  # $permdata{$pagepath} = {
  #     admin => {
  #         page => {
  #             create => 'yes',
  #             delete => 'yes',
  #             view => 'yes',
  #             edit => 'yes',
  #             attachment => 'yes',
  #         },
  #         subpages => {
  #             create => 'yes',
  #             delete => 'yes',
  #             view => 'yes',
  #             edit => 'yes',
  #             attachment => 'yes',
  #         },
  #     },
  #     users => .....
  # }
  if ($c->pref('cache_permission_data')) {
    $permdata = $c->cache->get('page_permission_data');
  }

# If we don't have any permissions data, we have a problem. We need to load it.
# We have two options here - if we are caching, we will load everything and cache it.
# If we are not - then we load just the bits we need.
  if (!$permdata) {

    # Initialize $permdata as a reference or we end up with an error
    # when we try to dereference it further down.  The error we're avoiding is:
    # Can't use string ("") as a HASH ref while "strict refs"
    $permdata = {};

    ## Either the data hasn't been loaded, or it's expired since we used it last,
    ## so we need to reload it.
    my $rs = $c->model('DBIC::PathPermissions')
      ->search(undef, {order_by => 'length(path),role,apply_to_subpages'});

    # If we are not caching, we don't return the whole enchilada.
    if (!$c->pref('cache_permission_data')) {
      ## this seems odd to me - but that's what the DBIx::Class says to do.
      $rs = $rs->search({role => $role_ids}) if $role_ids;
      $rs = $rs->search(
        {
          '-or' => [
            {path => $paths_to_check, apply_to_subpages => 'yes'},
            {path => $current_path,   apply_to_subpages => 'no'}
          ]
        }
      );
    }
    $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');

    my $recordtype;
    while (my $record = $rs->next) {
      if ($record->{'apply_to_subpages'} eq 'yes') {
        $recordtype = 'subpages';
      }
      else {
        $recordtype = 'page';
      }
      %{$permdata->{$record->{'path'}}{$record->{'role'}}{$recordtype}}
        = map { $_ => $record->{$_ . "_allowed"} }
        qw/create edit view delete attachment/;
    }
  }

  ## now we re-cache it - if we need to.  # !$c->cache('memory')->exists('page_permission_data')
  if ($c->pref('cache_permission_data')) {
    $c->cache->set('page_permission_data', $permdata);
  }

  return $permdata;
}

=head2 user_role_ids

Get the list of role ids for a user.

=cut

sub user_role_ids {
  my ($c, $user) = @_;

  ## always use role_id 0 - which is default role and includes everyone.
  my @role_ids = (0);

  if (ref($user)) {
    push @role_ids, map { $_->role->id } $user->role_members->all;
  }

  return @role_ids;
}

=head2 check_permissions

Check user permissions for a path.

=cut

sub check_permissions {
  my ($c, $path, $user) = @_;

  return {attachment => 1, create => 1, delete => 1, edit => 1, view => 1,}
    if ($user && $user->is_admin);

  # if no user is logged in
  if (not $user) {

    # if anonymous user is allowed
    my $anonymous = $c->pref('anonymous_user');
    if ($anonymous) {

      # get anonymous user for no logged-in users
      $user = $c->model('DBIC::Person')->search({login => $anonymous})->first;
    }
  }

  my @paths_to_check = $c->_expand_path_elements($path);
  my $current_path   = $paths_to_check[-1];

  my @role_ids = $c->user_role_ids($user);

  my $permdata
    = $c->get_permissions_data($current_path, \@paths_to_check, \@role_ids);

  # rules comparison hash
  # allow everything by default
  my %rulescomparison = (
    'create' => {
      'allowed' => $c->pref('create_allowed'),
      'role'    => '__default',
      'len'     => 0,
    },
    'delete' => {
      'allowed' => $c->pref('delete_allowed'),
      'role'    => '__default',
      'len'     => 0,
    },
    'edit' => {
      'allowed' => $c->pref('edit_allowed'),
      'role'    => '__default',
      'len'     => 0,
    },
    'view' => {
      'allowed' => $c->pref('view_allowed'),
      'role'    => '__default',
      'len'     => 0,
    },
    'attachment' => {
      'allowed' => $c->pref('attachment_allowed'),
      'role'    => '__default',
      'len'     => 0,
    },
  );

  ## The outcome of this loop is a combined permission set.
  ## The rule orders are essentially based on how specific the path
  ## match is.  More specific paths override less specific paths.
  ## When conflicting rules at the same level of path hierarchy
  ## (with different roles) are discovered, the grant is given precedence
  ## over the deny.  Note that more-specific denies will still
  ## override.
  my $permtype = 'subpages';
  foreach my $i (0 .. $#paths_to_check) {
    my $path = $paths_to_check[$i];
    if ($i == $#paths_to_check) {
      $permtype = 'page';
    }
    foreach my $role (@role_ids) {
      if ( exists($permdata->{$path})
        && exists($permdata->{$path}{$role})
        && exists($permdata->{$path}{$role}{$permtype}))
      {

        my $len = length($path);

        foreach my $perm (keys %{$permdata->{$path}{$role}{$permtype}}) {

          ## if the xxxx_allowed column is null, this permission is ignored.
          if (defined($permdata->{$path}{$role}{$permtype}{$perm})) {
            if ($len == $rulescomparison{$perm}{'len'}) {
              if ($permdata->{$path}{$role}{$permtype}{$perm} eq 'yes') {
                $rulescomparison{$perm}{'allowed'} = 1;
                $rulescomparison{$perm}{'len'}     = $len;
                $rulescomparison{$perm}{'role'}    = $role;
              }
            }
            elsif ($len > $rulescomparison{$perm}{'len'}) {
              if ($permdata->{$path}{$role}{$permtype}{$perm} eq 'yes') {
                $rulescomparison{$perm}{'allowed'} = 1;
              }
              else {
                $rulescomparison{$perm}{'allowed'} = 0;
              }
              $rulescomparison{$perm}{'len'}  = $len;
              $rulescomparison{$perm}{'role'} = $role;
            }
          }
        }
      }
    }
  }

  my %perms
    = map { $_ => $rulescomparison{$_}{'allowed'} } keys %rulescomparison;

  return \%perms;
}

=head2 check_view_permission

Check if a user can view a path.

=cut

sub check_view_permission {
  my $c = shift;

  return 1 unless $c->pref('check_permission_on_view');

  my $user;
  if ($c->user_exists()) {
    $user = $c->user->obj;
  }

  $c->log->info('Checking permissions') if $c->debug;

  my $perms = $c->check_permissions($c->stash->{path}, $user);
  if (!$perms->{view}) {
    $c->stash->{message}
      = $c->loc('Permission Denied to view x', $c->stash->{page}->name);
    $c->stash->{template} = 'message.tt';
    return;
  }

  return 1;
}

my $search_setup_failed = 0;

MojoMojo->config->{index_dir}      ||= MojoMojo->path_to('index');
MojoMojo->config->{attachment_dir} ||= MojoMojo->path_to('uploads');
MojoMojo->config->{root}           ||= MojoMojo->path_to('root');
unless (-e MojoMojo->config->{index_dir}) {
  if (not mkdir MojoMojo->config->{index_dir}) {
    warn 'Could not make index directory <'
      . MojoMojo->config->{index_dir}
      . '> - FIX IT OR SEARCH WILL NOT WORK!';
    $search_setup_failed = 1;
  }
}
unless (-w MojoMojo->config->{index_dir}) {
  warn 'Require write access to index <'
    . MojoMojo->config->{index_dir}
    . '> - FIX IT OR SEARCH WILL NOT WORK!';
  $search_setup_failed = 1;
}

MojoMojo->model('Search')->prepare_search_index()
  if not -f MojoMojo->config->{index_dir} . '/segments'
  and not $search_setup_failed
  and not MojoMojo->pref('disable_search');

unless (-e MojoMojo->config->{attachment_dir}) {
  mkdir MojoMojo->config->{attachment_dir}
    or die 'Could not make attachment directory <'
    . MojoMojo->config->{attachment_dir} . '>';
}
die 'Require write access to attachment_dir: <'
  . MojoMojo->config->{attachment_dir} . '>'
  unless -w MojoMojo->config->{attachment_dir};

1;

=head1 SUPPORT

=over

=item *

L<http://mojomojo.org>

=item *

IRC: L<irc://irc.perl.org/mojomojo>.

=item *

Mailing list: L<http://mojomojo.2358427.n2.nabble.com/>

=item *

Commercial support and customization for MojoMojo is also provided by Nordaaker
Ltd. Contact C<arneandmarcus@nordaaker.com> for details.

=back

=head1 AUTHORS

Marcus Ramberg C<marcus@nordaaker.com>

David Naughton C<naughton@umn.edu>

Andy Grundman C<andy@hybridized.org>

Jonathan Rockway C<jrockway@jrockway.us>

A number of other contributors over the years:
https://www.ohloh.net/p/mojomojo/contributors

=head1 COPYRIGHT

Unless explicitly stated otherwise, all modules and scripts in this distribution are:
Copyright 2005-2010, Marcus Ramberg

=head1 LICENSE

You may distribute this code under the same terms as Perl itself.

=cut