File Coverage: lib/Yukki.pm

# File Coverage

File: | lib/Yukki.pm
Coverage: | 95.2%

line | stmt | bran | cond | sub | pod | time | code
--- | --- | --- | --- | --- | --- | --- | ---
1 |  |  |  |  |  |  | package Yukki;
2 |
3 | 4 4 |  |  | 4 |  | 252 13 | use v5.24;
4 | 4 4 4 |  |  | 4 |  | 16 5 21 | use utf8;
5 | 4 4 4 |  |  | 4 |  | 1370 15616 14 | use Moo;
6 |
7 | 4 4 4 |  |  | 4 |  | 5445 14007 97 | use Class::Load;
8 |
9 | 4 4 4 |  |  | 4 |  | 799 11 70 | use Yukki::Settings;
10 | 4 4 4 |  |  | 4 |  | 999 9 15 | use Yukki::TextUtil qw( load_file );
11 | 4 4 4 |  |  | 4 |  | 656 5 35 | use Yukki::Types qw( AccessLevel YukkiSettings );
12 | 4 4 4 |  |  | 4 |  | 2629 9 19 | use Yukki::Error qw( http_throw );
13 |
14 | 4 4 4 |  |  | 4 |  | 3393 4929 90 | use Crypt::SaltedHash;
15 | 4 4 4 |  |  | 4 |  | 18 4 158 | use List::Util qw( any );
16 | 4 4 4 |  |  | 4 |  | 12 5 19 | use Type::Params qw( validate );
17 | 4 4 4 |  |  | 4 |  | 731 5 16 | use Type::Utils;
18 | 4 4 4 |  |  | 4 |  | 3663 6 20 | use Types::Standard qw( Dict HashRef Str Maybe slurpy Optional );
19 | 4 4 4 |  |  | 4 |  | 2941 4 109 | use Path::Tiny;
20 | 4 4 4 |  |  | 4 |  | 11 5 25 | use Types::Path::Tiny qw( Path );
21 |
22 | 4 4 4 |  |  | 4 |  | 951 6 19 | use namespace::clean;
23 |
24 |  |  |  |  |  |  | # ABSTRACT: Yet Uh-nother wiki
25 |
26 - 48 |  |
    =head1 DESCRIPTION

    This is intended to be the simplest, stupidest wiki on the planet. It uses git for versioning and it is perfectly safe to clone this repository and push and pull and all that jazz to maintain this wiki in multiple places.

    For information on getting started see L<Yukki::Manual::Installation>.

    =head1 WITH ROLES

    =over

    =item *

    L<Yukki::Role::App>

    =back

    =head1 ATTRIBUTES

    =head2 config_file

    This is the name of the configuraiton file. The application will try to find it in F<etc> within the current working directory first. If not there, it will check the C<YUKKI_CONFIG> environment variable.

    =cut
49 |
50 |  |  |  |  |  |  | has config_file => (
51 |  |  |  |  |  |  | is => 'ro',
52 |  |  |  |  |  |  | isa => Path,
53 |  |  |  |  |  |  | required => 1,
54 |  |  |  |  |  |  | coerce => 1,
55 |  |  |  |  |  |  | lazy => 1,
56 |  |  |  |  |  |  | builder => '_build_config_file',
57 |  |  |  |  |  |  | );
58 |
59 |  |  |  |  |  |  | sub _build_config_file {
60 | 7 |  |  | 7 |  | 102 | my $self = shift;
61 |
62 | 7 |  |  |  |  | 30 | my $cwd_conf = path('.', 'etc', 'yukki.conf');
63 | 7 | 100 | 100 |  |  | 333 | if (not $ENV{YUKKI_CONFIG} and -f "$cwd_conf") {
64 | 1 |  |  |  |  | 13 | return $cwd_conf;
65 |  |  |  |  |  |  | }
66 |
67 |  |  |  |  |  |  | die("Please make YUKKI_CONFIG point to your configuration file.\n")
68 | 6 | 100 |  |  |  | 59 | unless defined $ENV{YUKKI_CONFIG};
69 |
70 |  |  |  |  |  |  | die("No configuration found at $ENV{YUKKI_CONFIG}. Please set YUKKI_CONFIG to the correct location.\n")
71 | 5 | 100 |  |  |  | 157 | unless -f $ENV{YUKKI_CONFIG};
72 |
73 | 4 |  |  |  |  | 38 | return $ENV{YUKKI_CONFIG};
74 |  |  |  |  |  |  | }
75 |
76 - 80 |  |
    =head2 settings

    This is the configuration loaded from the L</config_file>.

    =cut
81 |
82 |  |  |  |  |  |  | has settings => (
83 |  |  |  |  |  |  | is => 'ro',
84 |  |  |  |  |  |  | isa => YukkiSettings,
85 |  |  |  |  |  |  | required => 1,
86 |  |  |  |  |  |  | coerce => 1,
87 |  |  |  |  |  |  | lazy => 1,
88 |  |  |  |  |  |  | builder => '_build_settings',
89 |  |  |  |  |  |  | );
90 |
91 |  |  |  |  |  |  | sub _build_settings {
92 | 4 |  |  | 4 |  | 86 | my $self = shift;
93 | 4 |  |  |  |  | 74 | load_file($self->config_file)
94 |  |  |  |  |  |  | }
95 |
96 - 104 |  |
    =head1 METHODS

    =head2 view

      my $view = $app->view('Page');

    Not implemented in this class. See L<Yukki::Web>.

    =cut
105 |
106 | 1 |  |  | 1 | 1 | 6 | sub view { ... }
107 |
108 - 114 |  |
    =head2 controller

      my $controller = $app->controller('Page');

    Not implemented in this class. See L<Yukki::Web>.

    =cut
115 |
116 | 1 |  |  | 1 | 1 | 5 | sub controller { ... }
117 |
118 - 125 |  |
    =head2 model

      my $model = $app->model('Repository', { repository => 'main' });

    Returns an instance of the requested model class. The parameters are passed to
    the instance constructor.

    =cut
126 |
127 |  |  |  |  |  |  | sub model {
128 | 4 |  |  | 4 | 1 | 52 | my ($self, $name, $params) = @_;
129 | 4 |  |  |  |  | 13 | my $class_name = join '::', 'Yukki::Model', $name;
130 | 4 |  |  |  |  | 21 | Class::Load::load_class($class_name);
131 | 4 4 |  | 100 |  |  | 115 36 | return $class_name->new(app => $self, %{ $params // {} });
132 |  |  |  |  |  |  | }
133 |
134 - 143 |  |
    =head2 locate

      my $file = $app->locate('user_path', 'test_user');

    The first argument is the name of the configuration directive naming the path.
    It may be followed by one or more path components to be tacked on to the end.

    Returns a L<Path::Tiny> for the file.

    =cut
144 |
145 |  |  |  |  |  |  | sub _locate {
146 | 14 |  |  | 14 |  | 35 | my ($self, $type, $base, @extra_path) = @_;
147 |
148 | 14 |  |  |  |  | 256 | my $base_path = $self->settings->$base;
149 | 14 |  |  |  |  | 898 | my $root_path;
150 |
151 | 14 | 100 |  |  |  | 52 | if ($base_path !~ m{^/}) {
152 | 12 |  |  |  |  | 182 | $root_path = path($self->settings->root, $base_path);
153 |  |  |  |  |  |  | }
154 |  |  |  |  |  |  | else {
155 | 2 |  |  |  |  | 12 | $root_path = path($base_path);
156 |  |  |  |  |  |  | }
157 |
158 | 14 |  |  |  |  | 553 | my $located_path = $root_path->child(@extra_path);
159 |
160 |  |  |  |  |  |  | # Small safety mechanism
161 | 14 | 50 |  |  |  | 430 | die "attempted to lookup an illegal $base path: ", join('/', @extra_path)
162 |  |  |  |  |  |  | unless $root_path->subsumes($located_path);
163 |
164 | 14 |  |  |  |  | 1299 | return $located_path;
165 |  |  |  |  |  |  | }
166 |
167 |  |  |  |  |  |  | sub locate {
168 | 2 |  |  | 2 | 1 | 29 | my ($self, $base, @extra_path) = @_;
169 | 2 |  |  |  |  | 6 | $self->_locate(file => $base, @extra_path);
170 |  |  |  |  |  |  | }
171 |
172 - 179 |  |
    =head2 locate_dir

      my $dir = $app->locate_dir('repository_path', 'main.git');

    The arguments are identical to L</locate>, but returns a L<Path::Tiny> for
    the given file.

    =cut
180 |
181 |  |  |  |  |  |  | sub locate_dir {
182 | 12 |  |  | 12 | 1 | 84 | my ($self, $base, @extra_path) = @_;
183 | 12 |  |  |  |  | 38 | $self->_locate(dir => $base, @extra_path);
184 |  |  |  |  |  |  | }
185 |
186 - 201 |  |
    =head2 check_access

      my $access_is_ok = $app->check_access({
          user       => $user,
          repository => 'main',
          needs      => 'read',
      });

    The C<user> is optional. It should be an object returned from
    L<Yukki::Model::User>. The C<repository> is required and should be the name of
    the repository the user is trying to gain access to. The C<needs> is the access
    level the user needs. It must be an L<Yukki::Types/AccessLevel>.

    The method returns a true value if access should be granted or false otherwise.

    =cut
202 |
203 |  |  |  |  |  |  | sub check_access {
204 | 60 |  |  | 60 | 1 | 1572 | my ($self, $opt)
205 |  |  |  |  |  |  | = validate(\@_, class_type(__PACKAGE__),
206 |  |  |  |  |  |  | slurpy Dict[
207 |  |  |  |  |  |  | user => Maybe[class_type('Yukki::User')],
208 |  |  |  |  |  |  | special => Optional[Str],
209 |  |  |  |  |  |  | repository => Optional[Str],
210 |  |  |  |  |  |  | needs => AccessLevel,
211 |  |  |  |  |  |  | ]
212 |  |  |  |  |  |  | );
213 |  |  |  |  |  |  | my ($user, $repository, $special, $needs)
214 | 60 60 |  |  |  |  | 494268 12181 | = @{$opt}{qw( user repository special needs )};
215 |
216 | 60 |  | 50 |  |  | 132 | $repository //= '-';
217 | 60 |  | 100 |  |  | 168 | $special //= '-';
218 |
219 |  |  |  |  |  |  | # Always grant none
220 | 60 | 100 |  |  |  | 171 | return 1 if $needs eq 'none';
221 |
222 |  |  |  |  |  |  | my $config = $self->settings->repositories->{$repository}
223 | 43 |  | 33 |  |  | 908 | // $self->settings->special_privileges->{$special};
224 |
225 | 43 | 50 |  |  |  | 378 | return '' unless $config;
226 |
227 | 43 |  |  |  |  | 115 | my $read_groups = $config->read_groups;
228 | 43 |  |  |  |  | 78 | my $write_groups = $config->write_groups;
229 |
230 | 43 |  |  |  |  | 109 | my %access_level = (none => 0, read => 1, write => 2);
231 |  |  |  |  |  |  | my $has_access = sub {
232 | 63 |  | 50 | 63 |  | 302 | $access_level{$_[0] // 'none'} >= $access_level{$needs}
233 | 43 |  |  |  |  | 105 | };
234 |
235 |  |  |  |  |  |  | # Deal with anonymous users first.
236 | 43 | 100 |  |  |  | 100 | return 1 if $has_access->($config->anonymous_access_level);
237 | 28 | 100 |  |  |  | 151 | return '' unless $user;
238 |
239 |  |  |  |  |  |  | # Only logged users considered here forward.
240 | 11 11 |  | 50 |  |  | 14 31 | my @user_groups = @{ $user->{groups} // [] };
241 |
242 | 11 |  |  |  |  | 20 | for my $level (qw( read write )) {
243 | 20 | 100 |  |  |  | 27 | if ($has_access->($level)) {
244 |
245 | 14 |  |  |  |  | 22 | my $groups = "${level}_groups";
246 |
247 | 14 | 100 |  |  |  | 52 | return 1 if $config->$groups eq 'ANY';
248 |
249 | 11 | 100 50 |  |  |  | 34 | if (ref $config->$groups eq 'ARRAY') {
250 | 5 5 |  |  |  |  | 7 12 | my @level_groups = @{ $config->$groups };
251 |
252 | 5 |  |  |  |  | 8 | for my $level_group (@level_groups) {
253 | 9 9 | 100 |  | 9 |  | 20 45 | return 1 if any { $_ eq $level_group } @user_groups;
254 |  |  |  |  |  |  | }
255 |  |  |  |  |  |  | }
256 |  |  |  |  |  |  | elsif ($config->$groups ne 'NONE') {
257 | 0 |  |  |  |  | 0 | warn "weird value ", $config->$groups,
258 |  |  |  |  |  |  | " in $groups config for $repository settings";
259 |  |  |  |  |  |  | }
260 |  |  |  |  |  |  | }
261 |  |  |  |  |  |  | }
262 |
263 | 5 |  |  |  |  | 31 | return '';
264 |  |  |  |  |  |  | }
265 |
266 - 270 |  |
    =head2 hasher

    Returns a message digest object that can be used to create a cryptographic hash.

    =cut
271 |
272 |  |  |  |  |  |  | sub hasher {
273 | 4 |  |  | 4 | 1 | 6 | my $self = shift;
274 |
275 | 4 |  |  |  |  | 72 | return Crypt::SaltedHash->new(algorithm => $self->settings->digest);
276 |  |  |  |  |  |  | }
277 |
278 |  |  |  |  |  |  | with qw( Yukki::Role::App );
279 |
280 - 286 |  |
    =head1 WHY?

    I wanted a Perl-based, MultiMarkdown-supporting wiki that I could take sermon notes and personal study notes for church and Bible study and such. However, I'm offline at church, so I want to do this from my laptop and sync it up to the master wiki when I get home. That's it.

    Does it suit your needs? I don't really care, but if I've shared this on the CPAN or the GitHub, then I'm offering it to you in case you might find it useful WITHOUT WARRANTY. If you want it to suit your needs, bug me by email at C<< hanenkamp@cpan.org >> and send me patches.

    =cut
287 |
288 |  |  |  |  |  |  | 1;