File Coverage

blib/lib/Toadfarm.pm
Criterion Covered Total %
statement 162 220 73.6
branch 67 128 52.3
condition 19 49 38.7
subroutine 26 32 81.2
pod 1 1 100.0
total 275 430 63.9


line stmt bran cond sub pod time code
1             package Toadfarm;
2 19     19   5507038 use Mojo::Base 'Mojolicious';
  19         169  
  19         130  
3              
4 19     19   2768811 use Cwd 'abs_path';
  19         47  
  19         857  
5 19     19   104 use Data::Dumper ();
  19         38  
  19         341  
6 19     19   97 use File::Basename qw(basename dirname);
  19         42  
  19         846  
7 19     19   113 use File::Spec;
  19         33  
  19         451  
8 19     19   8222 use File::Which;
  19         16652  
  19         839  
9 19     19   120 use Mojo::File;
  19         34  
  19         603  
10 19     19   87 use Mojo::Util qw(class_to_path monkey_patch);
  19         36  
  19         1141  
11              
12 19 50   19   103 use constant DEBUG => $ENV{TOADFARM_DEBUG} ? 1 : 0;
  19         38  
  19         2782  
13              
14             our $VERSION = '0.84';
15              
16             BEGIN {
17 19 50 33 19   324 $ENV{TOADFARM_ACTION} //= (@ARGV and $ARGV[0] =~ /^(reload|start|stop)$/) ? $1 : 'load';
      66        
18 19 50       59221 $ENV{MOJO_CONFIG} = $ENV{TOADFARM_CONFIG} if $ENV{TOADFARM_CONFIG};
19             }
20              
21             sub import {
22 16 100   16   149 return unless grep {/^(-dsl|-init|-test)/} @_;
  31         206  
23              
24 15         35 my $class = shift;
25 15         32 my $caller = caller;
26 15         124 my $app = Toadfarm->new;
27 15   50     4257 my $tf = $app->config->{tf} ||= {}; # internal
28              
29 15         476 $_->import for qw(strict warnings utf8);
30 15         355 feature->import(':5.10');
31 15         27 unshift @{$app->commands->namespaces}, 'Toadfarm::Command';
  15         102  
32              
33             monkey_patch $caller, (
34 6     6   2493 app => sub {$app},
        6      
35             change_root => \&_change_root,
36 0     0   0 logging => sub { $tf->{logging}++; $app->_setup_log(@_) },
  0         0  
37 0 0   0   0 mount => sub { push @{$app->config->{apps}}, @_ == 2 ? @_ : ($_[0], {}); $app },
  0         0  
  0         0  
38 1 50   1   730 plugin => sub { push @{$app->config->{tf_plugins}}, @_ == 2 ? @_ : ($_[0], {}); $app },
  1         4  
  1         13  
39             run_as => \&_run_as,
40 0     1   0 secrets => sub { $tf->{secrets}++; $app->secrets([@_]) },
  0         0  
41             start => sub {
42 4 50   4   1341 if (@_) {
43 4 50       15 my $listen = ref $_[0] eq 'ARRAY' ? shift : undef;
44 4 50       25 $app->config->{hypnotoad} = @_ > 1 ? {@_} : {%{$_[0]}} if @_;
  0 50       0  
45 4 50       51 $app->config->{hypnotoad}{listen} = $listen if $listen;
46             }
47              
48 4 100       32 $app->moniker($class->_moniker) if $app->moniker eq 'toadfarm';
49 4   33     23 $app->config->{hypnotoad}{pid_file} ||= $class->_pid_file($app);
50 4 50       18 $app = $class->_setup_app($app) if $ENV{TOADFARM_ACTION};
51 4         20 Mojo::UserAgent::Server->app($app);
52 4         24 warn '$config=' . Mojo::Util::dumper($app->config) if DEBUG;
53 4 50       15 $class->_die_on_insecure($app) unless $ENV{TOADFARM_INSECURE};
54 1         6 $app->start;
55             },
56 15         1246 );
57             }
58              
59             sub startup {
60 19     23 1 374172 my $self = shift;
61 19 100       86 my $config = $ENV{MOJO_CONFIG} ? $self->plugin('Config') : {};
62              
63             # remember the config when hot reloading the app
64 19         8400 $ENV{TOADFARM_CONFIG} = delete $ENV{MOJO_CONFIG};
65              
66 19         63 $self->{mounted} = 0;
67 19 100       425 $self->_setup_log($config->{log}) if $config->{log}{file};
68 19 100       82 $self->_paths($config->{paths}) if $config->{paths};
69 19 100       89 $self->secrets([$config->{secret}]) if $config->{secret};
70 19 100       63 $self->secrets($config->{secrets}) if $config->{secrets};
71 19 100       55 $self->_mount_apps(@{$config->{apps}}) if $config->{apps};
  2         10  
72 19 100       71 $self->_load_plugins(@{$config->{tf_plugins}}) if $config->{tf_plugins};
  2         10  
73 19 50       1566 $self->_mount_root_app(delete $self->{root_app}) if $self->{root_app};
74             }
75              
76             sub _change_root {
77 0     0   0 my @cmd = @_;
78 0         0 my $exit = -2;
79              
80 0 0       0 return 1 if $<; # not root
81              
82 0   0     0 unshift @cmd, $ENV{TOADFARM_CHROOT_BIN} || 'chroot';
83 0         0 push @cmd, $^X;
84 0 0       0 push @cmd, -I => $INC[0] if $ENV{TOADFARM_ACTION} eq 'test';
85 0         0 push @cmd, File::Spec->rel2abs($0), @ARGV;
86              
87 0         0 warn "[Toadfarm] system @cmd\n" if DEBUG;
88 0         0 system @cmd;
89 0 0       0 die "Could not run '@cmd' exit=$exit\n" if $exit = $? >> 8;
90 0         0 exit $?;
91             }
92              
93             sub _die_on_insecure {
94 4     4   7 my ($class, $app) = @_;
95 4         8 my $config = $app->config;
96 4   100     32 my $plugins = $config->{tf_plugins} || [];
97              
98 4 100       17 die "Cannot change user without TOADFARM_INSECURE=1" if $config->{hypnotoad}{user};
99 3 100       13 die "Cannot change group without TOADFARM_INSECURE=1" if $config->{hypnotoad}{group};
100             die "Cannot run as 'root' without TOADFARM_INSECURE=1"
101             if +($> == 0 or $< == 0)
102 2 100 33     30 and !grep {/\bSetUserGroup$/} @$plugins;
  2   66     13  
103             }
104              
105 0 0   0   0 sub _exit { say shift and exit 0 }
106              
107             sub _load_plugins {
108 3     3   5 my $self = shift;
109              
110 3         4 unshift @{$self->plugins->namespaces}, 'Toadfarm::Plugin';
  3         12  
111              
112 3         39 while (@_) {
113 3         9 my ($plugin, $config) = (shift @_, shift @_);
114 3         11 $self->log->info("Loading plugin $plugin");
115 3         771 $self->plugin($plugin, $config);
116             }
117             }
118              
119             sub _moniker {
120 1     1   91 my $moniker = basename $0;
121 1         6 $moniker =~ s!\W!_!g;
122 1         5 $moniker;
123             }
124              
125             sub _mount_apps {
126 2     2   4 my $self = shift;
127 2         9 my $routes = $self->routes;
128 2         14 my $config = $self->config;
129              
130 2         17 while (@_) {
131 3         296 my ($app, $rules) = (shift @_, shift @_);
132 3         18 my $server = Mojo::Server->new;
133 3         57 my $mount_point = delete $rules->{mount_point};
134 3         5 my ($request_base, $tmp, @over);
135              
136 3         14 local $ENV{MOJO_CONFIG} = $ENV{MOJO_CONFIG};
137              
138 3 100       11 if (ref $rules->{config} eq 'HASH') {
139 2         10 require File::Temp;
140 2         2 my %config = (%{$self->config}, %{$rules->{config}});
  2         5  
  2         23  
141 2         14 $tmp = File::Temp->new;
142             Mojo::File->new($tmp->filename)->spurt(
143 2         1017 do {
144 2         34 local $Data::Dumper::Terse = 1;
145 2         3 local $Data::Dumper::Deepcopy = 1;
146 2         8 Data::Dumper::Dumper(\%config);
147             }
148             );
149 2         649 $ENV{MOJO_CONFIG} = $tmp->filename;
150             }
151              
152 3 50 33     34 unless (ref $app and UNIVERSAL::isa($app, 'Mojolicious')) {
153 3         8 my ($class, $path, @error) = ($app, $app);
154 3 50 33     91 $path = File::Which::which($path) || class_to_path($path) unless -r $path;
155 3 50 33     903 $app = eval { $server->build_app($class) } or push @error, $@ if $class =~ /^[\w:]+$/;
  3         18  
156 3 50 0     16563 $app = eval { $server->load_app($path) } or push @error, $@ unless ref $app;
  0         0  
157 3 50       10 die join "\n", @error unless $app;
158             }
159              
160 3 50       11 $app->log($self->log) if $config->{log}{combined};
161 3 50       9 $app->secrets($self->secrets) if $config->{tf}{secrets};
162              
163 3 100       19 if (ref $rules->{config} eq 'HASH') {
164 2         3 my $local = delete $rules->{config};
165 2         12 $app->config->{$_} = $local->{$_} for keys %$local;
166             }
167              
168 3   66     38 $app->config->{$_} ||= $config->{$_} for keys %$config;
169              
170 3         112 for my $k (qw(local_port remote_address remote_port)) {
171 9         20 push @over, $self->_skip_if(tx => $k, delete $rules->{$k});
172             }
173              
174 3         10 for my $name (sort keys %$rules) {
175 3 100       19 $request_base = $rules->{$name} if $name eq 'X-Request-Base';
176 3         11 push @over, $self->_skip_if(header => $name, $rules->{$name});
177             }
178              
179 3 50       23 if (@over) {
    0          
180 3         20 $self->log->info("Mounting @{[$app->moniker]} with conditions");
  3         126  
181 3         59 unshift @over, "sub { my \$h = \$_[1]->req->headers;\nlocal \$1;";
182 3 100       14 push @over, "\$_[1]->req->url->base(Mojo::URL->new(\$1 || '$request_base'));" if $request_base;
183 3         7 push @over, "return 1; }";
184 3   50     445 $routes->add_condition("toadfarm_condition_$self->{mounted}", => eval "@over" || die "@over: $@");
185 3   50     51 $routes->any($mount_point || '/')->requires("toadfarm_condition_$self->{mounted}")->partial(1)->to(app => $app);
186             }
187             elsif ($mount_point) {
188 0         0 $routes->any($mount_point)->partial(1)->to(app => $app);
189             }
190             else {
191 0         0 $self->{root_app} = $app;
192             }
193              
194 3         764 $self->{mounted}++;
195             }
196              
197 2         233 $self;
198             }
199              
200             sub _mount_root_app {
201 0     0   0 my ($self, $app) = @_;
202 0         0 $self->log->info("Mounting @{[$app->moniker]} without conditions.");
  0         0  
203 0         0 $self->routes->any('/')->partial(1)->to(app => $app);
204             }
205              
206             sub _paths {
207 1     1   15 my ($self, $config) = @_;
208              
209 1         4 for my $type (qw(renderer static)) {
210 2 50       16 my $paths = $config->{$type} or next;
211 2         9 $self->$type->paths($paths);
212             }
213             }
214              
215             sub _pid_file {
216 4     4   49 my ($class, $app) = @_;
217 4         88 my $name = basename $0;
218 4         196 my $dir = dirname abs_path $0;
219              
220 4 50       113 return File::Spec->catfile($dir, "$name.pid") if -w $dir;
221 0         0 return File::Spec->catfile(File::Spec->tmpdir, "toadfarm-$name.pid");
222             }
223              
224             sub _run_as {
225 0   0 0   0 my $user = shift || die "Usage: run_as('username')";
226 0         0 my ($exit, $uid, @sudo);
227              
228 0 0       0 $uid = $user =~ m!^\d+$! ? $user : scalar getpwnam $user;
229 0 0       0 die "Could not find uid for user $user\n" unless $uid;
230 0 0       0 return 1 if $uid == $>;
231              
232 0         0 for my $p (File::Spec->path) {
233 0         0 $sudo[0] = File::Spec->catfile($p, 'sudo');
234 0 0       0 next unless -x $sudo[0];
235 0         0 push @sudo, qw(-i -n -u), "#$uid";
236 0         0 last;
237             }
238              
239 0 0       0 die "Cannot change to uid=$uid: 'sudo' was not found.\n" unless @sudo > 1;
240 0         0 push @sudo, $^X;
241 0 0       0 push @sudo, -I => $INC[0] if $ENV{TOADFARM_ACTION} eq 'test';
242 0         0 push @sudo, File::Spec->rel2abs($0), @ARGV;
243 0         0 warn "[Toadfarm] system @sudo\n" if DEBUG;
244 0         0 system @sudo;
245 0 0       0 die "Could not run '@sudo' exit=$exit\n" if $exit = $? >> 8;
246 0         0 exit $?;
247             }
248              
249             sub _setup_app {
250 4     4   9 my ($class, $app) = @_;
251 4         11 my $config = $app->config;
252              
253 4 50       80 $app->secrets([Mojo::Util::md5_sum($$ . $0 . time . rand)]) unless $config->{tf}{secrets};
254 4 50       25 $app->_mount_apps(@{$config->{apps}}) if $config->{apps};
  0         0  
255 4 100       10 $app->_load_plugins(@{$config->{tf_plugins}}) if $config->{tf_plugins};
  1         5  
256              
257 4 50       405 if (my $root_app = delete $app->{root_app}) {
258 0 0       0 if (@{$config->{apps} || []} == 2) {
  0 0       0  
259 0   0     0 my $plugins = $config->{tf_plugins} || [];
260 0 0       0 $root_app->config(hypnotoad => $config->{hypnotoad}) if $config->{hypnotoad};
261 0 0       0 $root_app->log($app->log) if $config->{tf}{logging};
262 0         0 $root_app->plugin(shift(@$plugins), shift(@$plugins)) for @$plugins;
263 0         0 $root_app->secrets($app->secrets);
264 0         0 push @{$root_app->commands->namespaces}, 'Toadfarm::Command';
  0         0  
265 0         0 return $root_app;
266             }
267             else {
268 0         0 $app->_mount_root_app($root_app);
269             }
270             }
271              
272 4         8 return $app;
273             }
274              
275             sub _setup_log {
276 1     1   3 my ($self, $config) = @_;
277 1         17 my $log = Mojo::Log->new;
278              
279 1         26 $self->config(log => $config);
280 1 50 33     22 $log->path($config->{path}) if $config->{path} ||= delete $config->{file};
281 1   50     10 $log->level($config->{level} || 'info');
282 1         10 $self->log($log);
283             }
284              
285             sub _skip_if {
286 12     12   18 my ($self, $type, $k, $value) = @_;
287 12 50       28 my $format = $type eq 'tx' ? '$_[1]->tx->%s' : $type eq 'header' ? q[$h->header('%s')] : q[INVALID(%s)];
    100          
288              
289 12 100       25 if (!defined $value) {
    100          
290 9         16 return;
291             }
292             elsif (ref $value eq 'Regexp') {
293 1         3 $value =~ s,(?
294 1         8 return sprintf "return 0 unless +($format || '') =~ /(%s)/;", $k, $value;
295             }
296             else {
297 2         13 return sprintf "return 0 unless +($format || '') eq '%s';", $k, $value;
298             }
299             }
300              
301             1;
302              
303             =encoding utf8
304              
305             =head1 NAME
306              
307             Toadfarm - One Mojolicious app to rule them all
308              
309             =head1 VERSION
310              
311             0.84
312              
313             =head1 DESCRIPTION
314              
315             Toadfarm is a module for configuring and starting your L
316             applications. You can either combine multiple applications in one script,
317             or just use it as a init script.
318              
319             Core features:
320              
321             =over 4
322              
323             =item *
324              
325             Wrapper around L that makes your
326             application L
327             compatible.
328              
329             =item *
330              
331             Advanced routing and virtual host configuration. Also support routing
332             from behind another web server, such as L.
333             This feature is very much like L on steroids.
334              
335             =item *
336              
337             Hijacking log messages to a common log file. There's also plugin,
338             L, that allows you to log the requests sent
339             to your server.
340              
341             =back
342              
343             =head1 SYNOPSIS
344              
345             =head2 Script
346              
347             Here is an example script that sets up logging and mounts some applications
348             under different domains, as well as loading in some custom plugins.
349              
350             See L for more information about the different functions.
351              
352             #!/usr/bin/perl
353             use Toadfarm -init;
354              
355             logging {
356             combined => 1,
357             file => "/var/log/toadfarm/app.log",
358             level => "info",
359             };
360              
361             mount "MyApp" => {
362             Host => "myapp.example.com",
363             config => {
364             config_parameter_for_myapp => "foo"
365             },
366             };
367              
368             mount "/path/to/app" => {
369             Host => "example.com",
370             mount_point => "/other",
371             };
372              
373             mount "Catch::All::App";
374              
375             plugin "Toadfarm::Plugin::AccessLog";
376              
377             start; # needs to be at the last line
378              
379             =head2 Usage
380              
381             You don't have to put L in init.d, but it will work with standard
382             start/stop actions.
383              
384             $ /etc/init.d/your-script reload
385             $ /etc/init.d/your-script start
386             $ /etc/init.d/your-script stop
387              
388             See also L for more details.
389              
390             You can also start the application with normal L commands:
391              
392             $ morbo /etc/init.d/your-script
393             $ /etc/init.d/your-script daemon
394              
395             =head1 DOCUMENTATION INDEX
396              
397             =over 4
398              
399             =item * L - Introduction.
400              
401             =item * L - Domain specific language for Toadfarm.
402              
403             =item * L - Config file format.
404              
405             =item * L - Command line options.
406              
407             =item * L - Toadfarm behind nginx.
408              
409             =item * L - Virtual host setup.
410              
411             =back
412              
413             =head1 PLUGINS
414              
415             =over 4
416              
417             =item * L
418              
419             Log each request that hit your application.
420              
421             =item * L
422              
423             Kill Hypnotoad workers if they grow too large.
424              
425             =item * L
426              
427             Start as root, run workers as less user. See also
428             L.
429              
430             =back
431              
432             =head1 PREVIOUS VERSIONS
433              
434             L prior to version 0.49 used to be a configuration file loaded in
435             by the C script. This resulted in all the executables to be named
436             C instead of something descriptive. It also felt a bit awkward to
437             take over C and use all the crazy hacks to start C.
438              
439             It also didn't work well as an init script, so there still had to be a
440             seperate solution for that.
441              
442             The new L DSL aim to solve all of these issues. This means that
443             if you decide to still use any C, it should be for the
444             applications loaded from inside C and not the startup script.
445              
446             Note that the old solution still works, but a warning tells you to change
447             to the new L based API.
448              
449             =head1 COPYRIGHT AND LICENSE
450              
451             Copyright (C) 2014, Jan Henning Thorsen
452              
453             This program is free software, you can redistribute it and/or modify it
454             under the terms of the Artistic License version 2.0.
455              
456             =head1 AUTHOR
457              
458             Jan Henning Thorsen - C
459              
460             =cut