File: | lib/Yukki.pm |
Coverage: | 95.2% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Yukki; | ||||||
2 | |||||||
3 | 4 4 | 252 13 | use v5.24; | ||||
4 | 4 4 4 | 16 5 21 | use utf8; | ||||
5 | 4 4 4 | 1370 15616 14 | use Moo; | ||||
6 | |||||||
7 | 4 4 4 | 5445 14007 97 | use Class::Load; | ||||
8 | |||||||
9 | 4 4 4 | 799 11 70 | use Yukki::Settings; | ||||
10 | 4 4 4 | 999 9 15 | use Yukki::TextUtil qw( load_file ); | ||||
11 | 4 4 4 | 656 5 35 | use Yukki::Types qw( AccessLevel YukkiSettings ); | ||||
12 | 4 4 4 | 2629 9 19 | use Yukki::Error qw( http_throw ); | ||||
13 | |||||||
14 | 4 4 4 | 3393 4929 90 | use Crypt::SaltedHash; | ||||
15 | 4 4 4 | 18 4 158 | use List::Util qw( any ); | ||||
16 | 4 4 4 | 12 5 19 | use Type::Params qw( validate ); | ||||
17 | 4 4 4 | 731 5 16 | use Type::Utils; | ||||
18 | 4 4 4 | 3663 6 20 | use Types::Standard qw( Dict HashRef Str Maybe slurpy Optional ); | ||||
19 | 4 4 4 | 2941 4 109 | use Path::Tiny; | ||||
20 | 4 4 4 | 11 5 25 | use Types::Path::Tiny qw( Path ); | ||||
21 | |||||||
22 | 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 | 102 | my $self = shift; | ||||
61 | |||||||
62 | 7 | 30 | my $cwd_conf = path('.', 'etc', 'yukki.conf'); | ||||
63 | 7 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 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 | 132 | $repository //= '-'; | ||||
217 | 60 | 168 | $special //= '-'; | ||||
218 | |||||||
219 | # Always grant none | ||||||
220 | 60 | 171 | return 1 if $needs eq 'none'; | ||||
221 | |||||||
222 | my $config = $self->settings->repositories->{$repository} | ||||||
223 | 43 | 908 | // $self->settings->special_privileges->{$special}; | ||||
224 | |||||||
225 | 43 | 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 | 302 | $access_level{$_[0] // 'none'} >= $access_level{$needs} | ||||
233 | 43 | 105 | }; | ||||
234 | |||||||
235 | # Deal with anonymous users first. | ||||||
236 | 43 | 100 | return 1 if $has_access->($config->anonymous_access_level); | ||||
237 | 28 | 151 | return '' unless $user; | ||||
238 | |||||||
239 | # Only logged users considered here forward. | ||||||
240 | 11 11 | 14 31 | my @user_groups = @{ $user->{groups} // [] }; | ||||
241 | |||||||
242 | 11 | 20 | for my $level (qw( read write )) { | ||||
243 | 20 | 27 | if ($has_access->($level)) { | ||||
244 | |||||||
245 | 14 | 22 | my $groups = "${level}_groups"; | ||||
246 | |||||||
247 | 14 | 52 | return 1 if $config->$groups eq 'ANY'; | ||||
248 | |||||||
249 | 11 | 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 | 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 | 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; |