File Coverage

blib/lib/Mojolicious/Plugin/HostMeta.pm
Criterion Covered Total %
statement 84 106 79.2
branch 38 70 54.2
condition 30 47 63.8
subroutine 9 10 90.0
pod 1 1 100.0
total 162 234 69.2


line stmt bran cond sub pod time code
1             package Mojolicious::Plugin::HostMeta;
2 1     1   1510 use Mojo::Base 'Mojolicious::Plugin';
  1         3  
  1         8  
3 1     1   216 use Mojo::Headers;
  1         14  
  1         7  
4 1     1   34 use Mojo::Util qw/quote/;
  1         2  
  1         1755  
5            
6             our $VERSION = '0.25';
7            
8             our $WK_PATH = '/.well-known/host-meta';
9            
10            
11             # Register plugin
12             sub register {
13 1     1 1 41 my ($plugin, $app, $param) = @_;
14            
15 1   50     5 $param ||= {};
16            
17             # Load parameter from Config file
18 1 50       13 if (my $config_param = $app->config('HostMeta')) {
19 0         0 $param = { %$param, %$config_param };
20             };
21            
22             # Get helpers object
23 1         23 my $helpers = $app->renderer->helpers;
24            
25             # Load Util-Endpoint/Callback if not already loaded
26 1         16 foreach (qw/Endpoint Callback/) {
27 2 50       3444 $app->plugin("Util::$_") unless exists $helpers->{ lc $_ };
28             };
29            
30             # Load XML if not already loaded
31 1 50       1519 unless (exists $helpers->{new_xrd}) {
32 1         5 $app->plugin('XRD');
33             };
34            
35             # Set callbacks on registration
36 1         19123 $app->callback(fetch_hostmeta => $param);
37            
38             # Get seconds to expiration
39 1         216 my $seconds = (60 * 60 * 24 * 10);
40 1 50 33     6 if ($param->{expires} && $param->{expires} =~ /^\d+$/) {
41 0         0 $seconds = delete $param->{expires};
42             };
43            
44             # Create new hostmeta document
45 1         7 my $hostmeta = $app->new_xrd;
46 1         379 $hostmeta->extension( -HostMeta );
47            
48             # Get host information on first request
49             $app->hook(
50             prepare_hostmeta =>
51             sub {
52 1     1   13 my ($c, $hostmeta) = @_;
53 1         5 my $host = $c->req->url->to_abs->host;
54            
55             # Add host-information to host-meta
56 1 50       256 $hostmeta->host( $host ) if $host;
57             }
58 1         1140 );
59            
60             # Establish 'hostmeta' helper
61             $app->helper(
62             hostmeta => sub {
63 11     11   83762 my $c = shift;
64            
65             # Undefined host name
66 11 100       41 shift if !defined $_[0];
67            
68             # Host name is provided
69 11 100 100     74 if (!$_[0] || ref $_[0]) {
70            
71             # Return local hostmeta
72 9         35 return _serve_hostmeta( $c, $hostmeta, @_ );
73             };
74            
75             # Return discovered hostmeta
76 2         11 return _fetch_hostmeta( $c, @_ );
77 1         27 });
78            
79             # Establish /.well-known/host-meta route
80 1         111 my $route = $app->routes->any( $WK_PATH );
81            
82             # Define endpoint
83 1         470 $route->endpoint('host-meta');
84            
85             # Set route callback
86             $route->to(
87             cb => sub {
88 4     4   91903 my $c = shift;
89            
90             # Seconds given
91 4 50       18 if ($seconds) {
92            
93             # Set cache control
94 4         16 my $headers = $c->res->headers;
95 4         92 $headers->cache_control(
96             "public, max-age=$seconds"
97             );
98            
99             # Set expires element
100 4         49 $hostmeta->expires( time + $seconds );
101            
102             # Set expires header
103 4         21984 $headers->expires( $hostmeta->expires );
104             };
105            
106             # Serve host-meta document
107 4         3636 return $c->helpers->reply->xrd(
108             _serve_hostmeta( $c, $hostmeta )
109             );
110 1         52 });
111             };
112            
113            
114             # Get HostMeta document
115             sub _fetch_hostmeta {
116 2     2   6 my $c = shift;
117 2         7 my $host = lc shift;
118            
119             # Trim tail
120 2   66     14 pop while @_ && !defined $_[-1];
121            
122             # Get headers
123 2         6 my $header = {};
124 2 50 66     15 if ($_[0] && ref $_[0] && ref($_[0]) eq 'HASH') {
      66        
125 0         0 $header = shift;
126             };
127            
128             # Check if security is forced
129 2 50 66     12 my $secure = defined $_[-1] && $_[-1] eq '-secure' ? pop : 0;
130            
131             # Get callback
132 2 100 66     10 my $cb = pop if ref($_[-1]) && ref($_[-1]) eq 'CODE';
133            
134             # Get host information
135 2 50       25 unless ($host =~ s!^\s*(?:http(s?)://)?([^/]+)/*\s*$!$2!) {
136 0         0 return;
137             };
138 2 50       28 $secure = 1 if $1;
139            
140             # Build relations parameter
141 2         6 my $rel;
142 2 50 33     10 $rel = shift if $_[0] && ref($_[0]) eq 'ARRAY';
143            
144             # Helpers proxy
145 2         10 my $h = $c->helpers;
146            
147             # Callback for caching
148 2         63 my ($xrd, $headers) = $h->callback(
149             fetch_hostmeta => $host
150             );
151            
152             # HostMeta document was cached
153 2 50       5256 if ($xrd) {
154            
155             # Filter relations
156 2 50       17 $xrd = $xrd->filter_rel( $rel ) if $rel;
157            
158             # Set headers to default
159 2 100 33     20 $headers ||= Mojo::Headers->new if $cb || wantarray;
      66        
160            
161             # Return cached hostmeta document
162 2 100       16 return $cb->( $xrd, $headers ) if $cb;
163 1 50       4 return ( $xrd, $headers ) if wantarray;
164 1         5 return $xrd;
165             };
166            
167             # Create host-meta path
168 0         0 my $path = '//' . $host . $WK_PATH;
169 0 0       0 $path = 'https:' . $path if $secure;
170            
171            
172             # Non-blocking
173 0 0       0 if ($cb) {
174            
175             return $h->get_xrd(
176             $path => $header => sub {
177 0     0   0 my ($xrd, $headers) = @_;
178 0 0       0 if ($xrd) {
179            
180             # Add hostmeta extension
181 0         0 $xrd->extension(-HostMeta);
182            
183             # Hook for caching
184 0         0 $c->app->plugins->emit_hook(
185             after_fetching_hostmeta => (
186             $c, $host, $xrd, $headers
187             )
188             );
189            
190             # Filter based on relations
191 0 0       0 $xrd = $xrd->filter_rel( $rel ) if $rel;
192            
193             # Send to callback
194 0         0 return $cb->( $xrd, $headers );
195             };
196            
197             # Fail
198 0         0 return $cb->();
199 0         0 });
200             };
201            
202             # Blocking
203 0         0 ($xrd, $headers) = $h->get_xrd( $path => $header );
204            
205             # No host-meta found
206 0 0       0 return unless $xrd;
207            
208             # Add hostmeta extension
209 0         0 $xrd->extension( -HostMeta );
210            
211             # Hook for caching
212 0         0 $c->app->plugins->emit_hook(
213             after_fetching_hostmeta => (
214             $c, $host, $xrd, $headers
215             )
216             );
217            
218             # Filter based on relations
219 0 0       0 $xrd = $xrd->filter_rel( $rel ) if $rel;
220            
221             # Return
222 0 0       0 return ($xrd, $headers) if wantarray;
223 0         0 return $xrd;
224             };
225            
226            
227             # Run hooks for preparation and serving of hostmeta
228             sub _serve_hostmeta {
229 13     13   147 my $c = shift;
230 13         30 my $xrd = shift;
231            
232             # Delete tail
233 13   66     60 pop while @_ && !defined $_[-1];
234            
235             # Ignore security flag
236 13 50 66     47 pop if defined $_[-1] && $_[-1] eq '-secure';
237            
238             # Ignore header information
239 13 50 66     72 shift if $_[0] && ref($_[0]) && ref($_[0]) eq 'HASH';
      66        
240            
241             # Get callback
242 13 100 100     43 my $cb = pop if ref($_[-1]) && ref($_[-1]) eq 'CODE';
243            
244 13         20 my $rel = shift;
245            
246 13         49 my $plugins = $c->app->plugins;
247 13         112 my $phm = 'prepare_hostmeta';
248            
249            
250             # prepare_hostmeta has subscribers
251 13 100       49 if ($plugins->has_subscribers( $phm )) {
252            
253             # Emit hook for subscribers
254 2         21 $plugins->emit_hook( $phm => ( $c, $xrd ));
255            
256             # Unsubscribe all subscribers
257 2         6041 foreach (@{ $plugins->subscribers( $phm ) }) {
  2         10  
258 2         20 $plugins->unsubscribe( $phm => $_ );
259             };
260             };
261            
262             # No further modifications wanted
263 13 100       126 unless ($plugins->has_subscribers('before_serving_hostmeta')) {
264            
265             # Filter relations
266 1 50       19 $xrd = $xrd->filter_rel( $rel ) if $rel;
267            
268             # Return document
269 1 50       5 return $cb->( $xrd ) if $cb;
270 1         9 return $xrd;
271             };
272            
273             # Clone hostmeta reference
274 12         89 $xrd = $c->helpers->new_xrd( $xrd->to_string );
275            
276             # Emit 'before_serving_hostmeta' hook
277 12         11278 $plugins->emit_hook(
278             before_serving_hostmeta => (
279             $c, $xrd
280             ));
281            
282             # Filter relations
283 12 100       159118 $xrd = $xrd->filter_rel( $rel ) if $rel;
284            
285             # Return hostmeta clone
286 12 100       9871 return $cb->( $xrd ) if $cb;
287 9         122 return $xrd;
288             };
289            
290            
291             1;
292            
293            
294             __END__