File Coverage

blib/lib/PlugAuth/Plugin/Finger.pm

Criterion	Covered	Total	%
statement	44	55	80.0
branch	9	16	56.2
condition	2	9	22.2
subroutine	8	8	100.0
pod	0	1	0.0
total	63	89	70.7

package PlugAuth::Plugin::Finger;

use strict;
use warnings;
use 5.010001;
use Role::Tiny::With;
use AnyEvent::Finger::Server;
use Log::Log4perl qw( :easy );

with 'PlugAuth::Role::Plugin';

# ABSTRACT: Add a finger protocol interface to your PlugAuth server
our $VERSION = '0.02'; # VERSION


sub init
{
  my($self) = @_;

  my $port = $self->plugin_config->port(
    default => $> && $^O !~ /^(cygwin|MSWin32)$/ ? 8079 : 79,
  );

  INFO "finger binding to port $port";

  my $server = $self->{server} = AnyEvent::Finger::Server->new(
    port         => $port,
    forward_deny => 1,
  );

  $server->start(sub {
    my $tx = shift;
    $self->app->refresh;
    if($tx->req->listing_request)
    {
      $tx->res->say("users:");
      $tx->res->say("  $_") for $self->app->auth->all_users;
      $tx->res->say("groups:");
      $tx->res->say("  $_") for $self->app->authz->all_groups;
      if($tx->req->verbose)
      {
        $tx->res->say("grants:");
        $tx->res->say("  $_") for @{ $self->app->authz->granted };
      }
    }
    else
    {
      my $name = lc $tx->req->as_string; # stringifying gets the user and the hostname, but not the verbosity
      my $found = 0;
      if(my $groups = $self->app->authz->groups_for_user($name))
      {
        $tx->res->say("user:" . $name);
        $tx->res->say("belongs to:");
        $tx->res->say("  " . join(', ', sort @$groups));
        $found = 1;
      }
      elsif(my $users = $self->app->authz->users_in_group($name))
      {
        $tx->res->say("group:" . $name);
        $tx->res->say("members:");
        $tx->res->say("  " . join(', ', sort @$users));
        $found = 1;
      }
      else
      {
        $tx->res->say("no such user or group");
      }
      if($tx->req->verbose && $found)
      {
        $tx->res->say("granted:");
        foreach my $grant (@{ $self->app->authz->granted })
        {
          $tx->res->say("  $grant")
            if $grant =~ /:(.*)$/ && grep { $name eq lc $_ || $_ eq '#u' } map { s/^\s+//; s/\s+$//; $_ } split /,/, $1;
        }
      }
    }
    $tx->res->done;
  });
}

1;

__END__