File Coverage

blib/lib/PlugAuth/Plugin/Finger.pm

Criterion	Covered	Total	%
statement	21	59	35.5
branch	0	16	0.0
condition	0	9	0.0
subroutine	7	9	77.7
pod	0	1	0.0
total	28	94	29.7

package PlugAuth::Plugin::Finger;

use strict;
use warnings;
use v5.10;
use Role::Tiny::With;
use YAML::XS qw( Dump );
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.01'; # VERSION


sub init
{
  my($self) = @_;
  my $port = ($> && $^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__