File Coverage

blib/lib/Mojolicious/Plugin/WebFinger.pm

Criterion	Covered	Total	%
statement	82	156	52.5
branch	27	124	21.7
condition	27	75	36.0
subroutine	9	15	60.0
pod	1	1	100.0
total	146	371	39.3

package Mojolicious::Plugin::WebFinger;
use Mojo::Base 'Mojolicious::Plugin';
use Mojo::Util 'url_escape';
use Mojo::URL;

# Todo:
# - Make callback non-blocking aware
# - Support 307 Temporary Redirect as described in the spec
# - Support simple startup defintion, like
#   plugin WebFinger => {
#     'akron@sojolicious' => {
#       describedby => {
#	  type => 'application/rdf+xml',
#	  href => 'http://sojolicio.us/akron.foaf'
#       }
#     }
#   };

our $VERSION = '0.12';


my $WK_PATH = '/.well-known/webfinger';

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

  # Plugin parameter
  $param ||= {};

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

  # Load HostMeta if not already loaded.
  # This automatically loads XRD,
  # Util::Endpoint and Util::Callback plugins.
  unless (exists $mojo->renderer->helpers->{hostmeta}) {
    $mojo->plugin('HostMeta');
  };

  # Check for 'prepare_webfinger' and 'fetch_webfinger' callback
  $mojo->callback(
    [qw/fetch_webfinger prepare_webfinger/],
    $param,
    -once
  );

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

  # Establish WebFinger Route
  my $wfr = $mojo->routes->any($WK_PATH);

  # Establish endpoint
  $wfr->endpoint(
    webfinger => {
      query => [
        'resource' => '{uri}',
        'rel'      => '{rel?}',
        'format'   => '{format?}'
      ]
    });

  # Response to webfinger request
  $wfr->to(
    cb => sub {
      my $c = shift;

      # Check for security
      if ($param->{secure} && !$c->req->is_secure) {

        # Bad request - only https allowed!
        return $c->render(status => 400);
      };

      # Get resource parameter
      my $res = $c->param('resource');

      # Delete invalid parameters
      if (!$res || $res eq '{uri}') {

        # Bad request - no resource defined
        return $c->render(status => 400);
      };

      # Set standard format
      unless ($c->stash('format') || scalar $c->param('_format') || scalar $c->param('format')) {
        $c->stash(format => 'jrd');
      };

      # Normalize the resource
      my ($acct, $host, $nres) = _normalize_resource($c, $res);

      # Set host to local
      $host ||= $c->req->url->base->host || 'localhost';

      # Bad request - no resource defined
      return $c->render(status => 400) unless $nres;

      # Check for 'prepare_webfinger' callback
      if ($c->callback(prepare_webfinger => $nres)) {

        # The response body is already rendered
        return if $c->res->body;

        # Create new xrd document
        my $xrd = _serve_webfinger($c, $acct, $nres, $res);

        # Seconds given
        if ($xrd) {

          my $expires;
          unless ($expires = $xrd->expires && $seconds) {
            $expires = $xrd->expires( time + $seconds);
          };

          # Expires set
          if ($expires) {

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

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

        # Server xrd document
        return $c->reply->xrd($xrd, $res);
      };

      # No valid xrd document is existing for this resource
      return $c->reply->xrd(undef, $res);
    }
  );

  # Add Route to Host-Meta - exactly once
  $mojo->hook(
    prepare_hostmeta => sub {
      my ($c, $hostmeta) = @_;

      # Add JRD link
      $hostmeta->link(lrdd => {
        type     => 'application/jrd+json',
        template => $c->endpoint(
          webfinger => {
            '?' => undef
          }
        )
      });

      # Add XRD link
      $hostmeta->link(lrdd => {
        type     => 'application/xrd+xml',
        template => $c->endpoint(
          webfinger => {
            format => 'xrd',
            '?' => undef
          }
        )
      });
    });

  # webfinger helper
  $mojo->helper(
    webfinger => \&_fetch_webfinger
  );
};


# Fetch webfinger resource
sub _fetch_webfinger {
  my $c = shift;

  my ($acct, $res, $nres, $host);


  # Request with host information
  if ($_[1] && !ref($_[1]) && index($_[1], '-') != 0) {
    $host = shift;
    $nres = shift;
  }

  # Get host information from resource
  else {
    $res = shift;
    ($acct, $host, $nres) = _normalize_resource($c, $res);
  };

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

  # Get flags
  my %flag;
  while (defined $_[-1] && index($_[-1], '-') == 0) {
    $flag{ pop() } = 1;
  };

  # Optimize flags for known services
  if ($host && $host =~ /(?:gmail|yahoo|mozilla)\.(?:com|org|net)$/i) {
    $flag{-old} = 1 unless $flag{-modern};
  };

  # Get callback
  my $cb = defined $_[-1] && ref $_[-1] eq 'CODE' ? pop : undef;

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

  # Get relation information
  my $rel = shift;

  # If local, serve local
  if (!$host ||
        ($host eq ($c->req->url->base->host || 'localhost'))) {

    if ($c->callback(prepare_webfinger => $nres)) {

      # Serve local xrd document
      my $xrd = _serve_webfinger($c, $acct, $nres, $res);

      # Return values
      return $cb ? $cb->($xrd, Mojo::Headers->new) : (
        wantarray ? ($xrd, Mojo::Headers->new) : $xrd
      );
    }
    else {
      return $cb ? $cb->() : undef;
    }
  };

  # Check cache
  my ($xrd, $headers) = $c->callback(
    fetch_webfinger => ($host, $nres, $header)
  );

  # Store unchanged normalized resource
  $res = $nres;

  # Delete resource
  $nres =~ s/^acct://;

  # xrd document exists
  if ($xrd) {

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

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

    # Return cached webfinger document
    # Return values
    return $cb ? $cb->($xrd, $headers) : (
      wantarray ? ($xrd, $headers) : $xrd
    );
  };

  # Not found
  return ($cb ? $cb->() : undef) unless $host && $res;

  # Set secure value
  my $secure;
  if (exists $flag{-secure} || exists $flag{-modern}) {
    $secure = 1;
  };

  # Modern webfinger path
  my $path = '//' . $host . $WK_PATH . '?resource=' . url_escape $nres;
  $path = 'https:' . $path if $secure;

  # Non-blocking
  if ($cb) {

    # Initialize delay array
    my @delay;

    # If modern is allowed
    unless (exists $flag{-old}) {

      # push to delay array
      push(
        @delay,

        # Step 1
        sub {
          my $delay = shift;

          # Retrieve from modern path
          $c->get_xrd(
            $path => $header => $delay->begin
          );
        },

        # Step 2
        sub {
          my ($delay, $xrd, $headers) = @_;

          # Document found
          if ($xrd) {

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

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

            # Successful
            return $cb->($xrd, $headers);
          };

          # No more discovery
          return $cb->() if exists $flag{-modern};

          # Next step
          $delay->begin->();
        });
    };

    # Old Host-Meta discovery
    push(
      @delay,

      # Step 3
      sub {
        my $delay = shift;

        my @param = (
          $host,
          $header,
          ['lrdd'],
          $delay->begin(0,1)
        );

        push @param, '-secure' if $secure;

        # Host-Meta with lrdd
        $c->hostmeta( @param );
      },

      # Step 4
      sub {
        # Host-Meta document
        my ($delay, $xrd) = @_;

        # Host-Meta is expired
        return $cb->() if !$xrd || $xrd->expired;

        # Prepare lrdd
        my $template = _get_lrdd($xrd) or return $cb->();

        # Interpolate template
        my $lrdd = $c->endpoint($template => {
          uri => $nres,
          '?' => undef
        });

        # Get lrdd
        $c->get_xrd($lrdd => $header => $delay->begin(0,1))
      },

      # Step 5
      sub {
        my $delay = shift;
        my ($xrd, $headers) = @_;

        # No lrdd xrd document found
        return $cb->() unless $xrd;

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

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

        # Successful
        return $cb->($xrd, $headers);
      });

    # Create delay
    my $delay = Mojo::IOLoop->delay(@delay);

    # Start IOLoop if not running
    $delay->wait unless Mojo::IOLoop->is_running;

    return;
  };

  # Blocking
  # Modern discovery
  unless (exists $flag{-old}) {

    # Retrieve from modern path
    ($xrd, $headers) = $c->get_xrd($path => $header);
  };

  # Not found yet
  unless ($xrd) {

    # No further discovery
    return if exists $flag{-modern};

    # Host-Meta and lrdd
    $xrd = $c->hostmeta(
      $host,
      $header,
      ['lrdd'],
      ($secure ? '-secure' : undef)
    ) or return;

    # Todo: support header expiration date
    return if $xrd->expired;

    # Find 'lrdd' link
    my $template = _get_lrdd($xrd) or return;

    # Interpolate template
    my $lrdd = $c->endpoint(
      $template => {
        uri => $nres,
        '?' => undef
      });

    # Retrieve based on lrdd
    ($xrd, $headers) = $c->get_xrd($lrdd => $header) or return;
  };

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

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

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


# Serve webfinger
sub _serve_webfinger {
  my $c = shift;
  my ($acct, $nres, $res) = @_;

  # No normalized resource
  return unless $nres;

  # No resource given
  $res ||= $nres;

  # Create new XRD document
  my $xrd = $c->new_xrd;

  # Set Subject
  $xrd->subject($res);

  # Set Alias
  $xrd->alias($nres) if $res ne $nres;

  # Run hook
  $c->app->plugins->emit_hook(
    before_serving_webfinger => ($c, $nres, $xrd)
  );

  # Filter relations
  $xrd = $xrd->filter_rel($c->every_param('rel')) if $c->param('rel');

  # Return webfinger document
  return $xrd;
};


# Normalize resource
sub _normalize_resource {
  my ($c, $res) = @_;
  return unless $res;

  # Resource is qualified
  if (index($res, 'acct:') != 0 and $res =~ /^[^:]+:/) {

    return $res unless wantarray;

    # Check host
    my $url = Mojo::URL->new($res);

    # Get host information
    my $host = $url->host;

    # Return array
    return (undef, $host, $res) if wantarray;
  };

  # Delete scheme if exists
  $res =~ s/^acct://i;

  # Split user from domain
  my ($acct, $host) = split '@', lc $res;

  # Create norm writing
  my $norm = 'acct:' . $acct . '@';

  # Use request host if no host is given
  $norm .= ($host || $c->req->url->base->host || 'localhost');

  return wantarray ? ($acct, $host, $norm) : $norm;
};


# Get lrdd
sub _get_lrdd {
  my $xrd = shift;

  # Find 'lrdd' link
  my $lrdd = $xrd->link('lrdd') or return;

  # Get template
  $lrdd->attr('template') or return;
};


1;


__END__