File Coverage

blib/lib/Auth/Kokolores.pm

Criterion	Covered	Total	%
statement	21	99	21.2
branch	0	24	0.0
condition	0	9	0.0
subroutine	7	17	41.1
pod	6	9	66.6
total	34	158	21.5

package Auth::Kokolores;

use strict;
use base qw(Net::Server::PreFork);

# ABSTRACT: an alternative saslauthd
our $VERSION = '1.00'; # VERSION

use Auth::Kokolores::Config;
use Auth::Kokolores::Request;
use Auth::Kokolores::Response;
use Auth::Kokolores::Plugins;

use Getopt::Long;

sub print_usage {
  print "$0 [-h|--help] [-c|--config=<file>] [-f|--foreground] [-l|--loglevel=<level>]\n";
  return;
}

sub configure {
  my $self = shift;
  my $server = $self->{'server'};

  return if(@_);

  if( ! defined $server->{'config_file'} ) {
    $server->{'config_file'} = '/etc/kokolores/kokolores.conf';
  }
  $self->{'program_name'} = $0;

  $server->{'background'} = 1;
  $server->{'setsid'} = 1;
  $server->{'no_close_by_child'} = 1;

  # commandline options
  my $cmdline = {};
  GetOptions( $cmdline,
    "help|h",
    "config|c:s",
    "foreground|f",
    "loglevel|l:i",
  );
  if ($cmdline->{'help'}) {
    $self->print_usage;
    exit 0;
  }
  if (defined($cmdline->{'config'}) && $cmdline->{'config'} ne "") {
    $server->{'config_file'} = $cmdline->{'config'};
  }

  # read and apply configuration file
  my $config = Auth::Kokolores::Config->new_from_file( $server->{'config_file'} );
  $config->apply_config( $self );

  $server->{'port'} = $self->{'socket_path'}.'|unix';

  $self->{'plugins'} = Auth::Kokolores::Plugins->new_from_config( $self, $config->Plugin );

  # cmdline values which overwrite config/defaults
  if ($cmdline->{'foreground'}) {
      $server->{'background'} = undef;
      $server->{'setsid'} = undef;
      $server->{'log_file'} = undef;
  }
  if( $cmdline->{'loglevel'} ) {
    $server->{'log_level'} = $cmdline->{'loglevel'};
  }

  return;
}

sub post_configure_hook {
  my $self = shift;
  $self->{'plugins'}->init();
  return;
}

sub post_bind_hook {
  my $self = shift;
  $self->set_socket_permissions;
  return;
}

sub set_socket_permissions {
  my $self = shift;
  my $mode = oct($self->{'socket_mode'});

  $self->log(1, sprintf('setting socket mode to: %o', $mode));
  chmod( $mode, $self->{'socket_path'} )
    or $self->log(1, 'could not change mode of socket: '.$!);

  return;
}

sub child_init_hook {
  my $self = shift;
  $self->{'plugins'}->child_init();
  $self->_set_process_stat('virgin child');
  return;
}

sub child_finish_hook {
  my $self = shift;
  $self->{'plugins'}->shutdown();
  return;
}

sub authenticate {
  my ( $self, $r ) = @_;
  my $matched = 0;

  foreach my $plugin ( $self->{'plugins'}->all_plugins ) {
    my $ok;
    eval { $ok = $plugin->authenticate( $r ); };
    if( $@ ) {
      $self->log(1, 'plugin '.$plugin->name.' failed: '.$@);
      return Auth::Kokolores::Response->new_NO;
    }
    if( $ok ) {
      $self->log(1, 'plugin '.$plugin->name.': success');
    } else {
      $self->log(1, 'plugin '.$plugin->name.': failed');
    }
    if( $ok && $self->{'satisfy'} eq 'any' ) {
      return Auth::Kokolores::Response->new_OK;
    } elsif( $ok ) {
      $matched++;
      next;
    }
    return Auth::Kokolores::Response->new_NO;
  }

  if( $matched && $matched == $self->{'plugins'}->num_plugins ) {
    return Auth::Kokolores::Response->new_OK;
  }
  return Auth::Kokolores::Response->new_NO;
}

sub process_request {
  my ( $self, $conn ) = @_;
  $self->log(1, "handling new client...");

  $self->_set_process_stat('waiting request');
  my $r = Auth::Kokolores::Request->new_from_conn( $conn, $self );

  $self->_set_process_stat('processing request');

  my $result = $self->authenticate( $r );
  $conn->print( $result );

  $self->_set_process_stat('idle');
  return;
}

sub _set_process_stat {
  my ( $self, $stat ) = @_;
  $0 = $self->{'program_name'}.' ('.$stat.')';
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Auth::Kokolores - an alternative saslauthd

=head1 VERSION

version 1.00

=head1 AUTHOR

Markus Benning <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2016 by Markus Benning <[e-mail]>.

This is free software, licensed under:

  The GNU General Public License, Version 2, June 1991

=cut