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

package Mojolicious::Plugin::HostMeta;
use Mojo::Base 'Mojolicious::Plugin';
use Mojo::Headers;
use Mojo::Util qw/quote/;

our $VERSION = '0.24';

our $WK_PATH = '/.well-known/host-meta';


# Register plugin
sub register {
  my ($plugin, $app, $param) = @_;

  $param ||= {};

  # Load parameter from Config file
  if (my $config_param = $app->config('HostMeta')) {
    $param = { %$param, %$config_param };
  };

  # Get helpers object
  my $helpers = $app->renderer->helpers;

  # Load Util-Endpoint/Callback if not already loaded
  foreach (qw/Endpoint Callback/) {
    $app->plugin("Util::$_") unless exists $helpers->{ lc $_ };
  };

  # Load XML if not already loaded
  unless (exists $helpers->{new_xrd}) {
    $app->plugin('XRD');
  };

  # Set callbacks on registration
  $app->callback(fetch_hostmeta => $param);

  # Get seconds to expiration
  my $seconds = (60 * 60 * 24 * 10);
  if ($param->{expires} && $param->{expires} =~ /^\d+$/) {
    $seconds = delete $param->{expires};
  };

  # Create new hostmeta document
  my $hostmeta = $app->new_xrd;
  $hostmeta->extension( -HostMeta );

  # Get host information on first request
  $app->hook(
    prepare_hostmeta =>
      sub {
        my ($c, $hostmeta) = @_;
        my $host = $c->req->url->to_abs->host;

        # Add host-information to host-meta
        $hostmeta->host( $host ) if $host;
      }
    );

  # Establish 'hostmeta' helper
  $app->helper(
    hostmeta => sub {
      my $c = shift;

      # Undefined host name
      shift if !defined $_[0];

      # Host name is provided
      if (!$_[0] || ref $_[0]) {

        # Return local hostmeta
        return _serve_hostmeta( $c, $hostmeta, @_ );
      };

      # Return discovered hostmeta
      return _fetch_hostmeta( $c, @_ );
    });

  # Establish /.well-known/host-meta route
  my $route = $app->routes->route( $WK_PATH );

  # Define endpoint
  $route->endpoint('host-meta');

  # Set route callback
  $route->to(
    cb => sub {
      my $c = shift;

      # Seconds given
      if ($seconds) {

        # Set cache control
        my $headers = $c->res->headers;
        $headers->cache_control(
          "public, max-age=$seconds"
        );

        # Set expires element
        $hostmeta->expires( time + $seconds );

        # Set expires header
        $headers->expires( $hostmeta->expires );
      };

      # Serve host-meta document
      return $c->helpers->reply->xrd(
        _serve_hostmeta( $c, $hostmeta )
      );
    });
};


# Get HostMeta document
sub _fetch_hostmeta {
  my $c    = shift;
  my $host = lc shift;

  # Trim tail
  pop while @_ && !defined $_[-1];

  # Get headers
  my $header = {};
  if ($_[0] && ref $_[0] && ref($_[0]) eq 'HASH') {
    $header = shift;
  };

  # Check if security is forced
  my $secure = defined $_[-1] && $_[-1] eq '-secure' ? pop : 0;

  # Get callback
  my $cb = pop if ref($_[-1]) && ref($_[-1]) eq 'CODE';

  # Get host information
  unless ($host =~ s!^\s*(?:http(s?)://)?([^/]+)/*\s*$!$2!) {
    return;
  };
  $secure = 1 if $1;

  # Build relations parameter
  my $rel;
  $rel = shift if $_[0] && ref($_[0]) eq 'ARRAY';

  # Helpers proxy
  my $h = $c->helpers;

  # Callback for caching
  my ($xrd, $headers) = $h->callback(
    fetch_hostmeta => $host
  );

  # HostMeta document was cached
  if ($xrd) {

    # Filter relations
    $xrd = $xrd->filter_rel( $rel ) if $rel;

    # Set headers to default
    $headers ||= Mojo::Headers->new if $cb || wantarray;

    # Return cached hostmeta document
    return $cb->( $xrd, $headers ) if $cb;
    return ( $xrd, $headers ) if wantarray;
    return $xrd;
  };

  # Create host-meta path
  my $path = '//' . $host . $WK_PATH;
  $path = 'https:' . $path if $secure;


  # Non-blocking
  if ($cb) {

    return $h->get_xrd(
      $path => $header => sub {
        my ($xrd, $headers) = @_;
        if ($xrd) {

          # Add hostmeta extension
          $xrd->extension(-HostMeta);

          # Hook for caching
          $c->app->plugins->emit_hook(
            after_fetching_hostmeta => (
              $c, $host, $xrd, $headers
            )
          );

          # Filter based on relations
          $xrd = $xrd->filter_rel( $rel ) if $rel;

          # Send to callback
          return $cb->( $xrd, $headers );
        };

        # Fail
        return $cb->();
      });
  };

  # Blocking
  ($xrd, $headers) = $h->get_xrd( $path => $header );

  # No host-meta found
  return unless $xrd;

  # Add hostmeta extension
  $xrd->extension( -HostMeta );

  # Hook for caching
  $c->app->plugins->emit_hook(
    after_fetching_hostmeta => (
      $c, $host, $xrd, $headers
    )
  );

  # Filter based on relations
  $xrd = $xrd->filter_rel( $rel ) if $rel;

  # Return
  return ($xrd, $headers) if wantarray;
  return $xrd;
};


# Run hooks for preparation and serving of hostmeta
sub _serve_hostmeta {
  my $c   = shift;
  my $xrd = shift;

  # Delete tail
  pop while @_ && !defined $_[-1];

  # Ignore security flag
  pop if defined $_[-1] && $_[-1] eq '-secure';

  # Ignore header information
  shift if $_[0] && ref($_[0]) && ref($_[0]) eq 'HASH';

  # Get callback
  my $cb = pop if ref($_[-1]) && ref($_[-1]) eq 'CODE';

  my $rel = shift;

  my $plugins = $c->app->plugins;
  my $phm = 'prepare_hostmeta';


  # prepare_hostmeta has subscribers
  if ($plugins->has_subscribers( $phm )) {

    # Emit hook for subscribers
    $plugins->emit_hook( $phm => ( $c, $xrd ));

    # Unsubscribe all subscribers
    foreach (@{ $plugins->subscribers( $phm ) }) {
      $plugins->unsubscribe( $phm => $_ );
    };
  };

  # No further modifications wanted
  unless ($plugins->has_subscribers('before_serving_hostmeta')) {

    # Filter relations
    $xrd = $xrd->filter_rel( $rel ) if $rel;

    # Return document
    return $cb->( $xrd ) if $cb;
    return $xrd;
  };

  # Clone hostmeta reference
  $xrd = $c->helpers->new_xrd( $xrd->to_string );

  # Emit 'before_serving_hostmeta' hook
  $plugins->emit_hook(
    before_serving_hostmeta => (
      $c, $xrd
    ));

  # Filter relations
  $xrd = $xrd->filter_rel( $rel ) if $rel;

  # Return hostmeta clone
  return $cb->( $xrd ) if $cb;
  return $xrd;
};


1;


__END__