view release on metacpan or  search on metacpan

lib/Dancer2/Plugin/WebService.pm  view on Meta::CPAN

has pretty          => (is=>'rw', lazy=>1, default    => 1);
has route_name      => (is=>'rw', lazy=>1, default    => '');
has ClientIP        => (is=>'rw', lazy=>1, default    => '');
has reply_text      => (is=>'rw', lazy=>1, default    => '');
has auth_method     => (is=>'rw', lazy=>1, default    => '');
has auth_command    => (is=>'rw', lazy=>1, default    => '');
has data            => (is=>'rw', lazy=>1, default    => ''); # user posted data
has auth_config     => (is=>'rw', lazy=>1, default    => sub{ {} });
has Format          => (is=>'rw', lazy=>1, default    => sub{ {from => undef, to => undef} });
has Session_timeout => (is=>'ro', lazy=>0, from_config=> 'Session idle timeout',default=> sub{ 3600 }, isa => sub {unless ( $_[0]=~/^\d+$/ ) {warn "Session idle timeout \"$_[0]\" It is not a number\n"; exit 1}} );
has rules           => (is=>'ro', lazy=>0, from_config=> 'Allowed hosts',       default=> sub{ ['127.*', '192.168.*', '172.16.*'] });
has rules_compiled  => (is=>'ro', lazy=>0, default    => sub {my $array = [@{$_[0]->rules}]; for (@{$array}) { s/([^?*]+)/\Q$1\E/g; s|\?|.|g; s|\*+|.*?|g; $_ = qr/^$_$/i } $array});
has dir_session     => (is=>'ro', lazy=>0, default    => sub {my $D = exists $_[0]->config->{'Session directory'} ? $_[0]->config->{'Session directory'}."/$_[0]->{app}->{name}" : "$_[0]->{app}->{config}->{appdir}/session"; $D=~s|/+|/|g; my @MD = spli...
has OS              => (is=>'ro', lazy=>0, default    => sub {my $D = undef; foreach (qw[/usr/bin /bin /usr/sbin /sbin]) {if (-f "$_/uname") {$D="$_/uname"; last}; unless (defined $D) {warn "Could not found utility uname\n"; exit 1} } sub{-f $_[0] ? ...
has rm              => (is=>'ro', lazy=>0, default    => sub {foreach (qw[/usr/bin /bin /usr/sbin /sbin]) {return "$_/rm" if -f "$_/rm" && -x "$_/rm" } warn "Could not found utility rm\n"; exit 1});
has session_enable  => (is=>'ro', lazy=>0, default    => sub {exists $_[0]->config->{'Session enable'} ? $_[0]->config->{'Session enable'}=~/(?i)[y1t]/ ? 1:0 : 1});

# Recursive walker of complex and custon Data Structures
%Handler=(
SCALAR => sub { $Handler{WALKER}->(${$_[0]}, $_[1], @{$_[2]} )},
ARRAY  => sub { $Handler{WALKER}->($_, $_[1], @{$_[2]}) for @{$_[0]} },
HASH   => sub { $Handler{WALKER}->($_[0]->{$_}, $_[1], @{$_[2]}, $_) for sort keys %{$_[0]} },
''     => sub { $_[1]->($_[0], @{$_[2]}) },
WALKER => sub { my $data = shift; $Handler{ref $data}->($data, shift, \@_) }
);


sub BUILD
{
my $plg = shift;
my $app = $plg->app;

(my $module_dir =__FILE__) =~s|/[^/]+$||; # Module's directory
unless (-d $module_dir) { CORE::warn "Could not find the Dancer2::Plugin::WebService installation directory\n"; CORE::exit 1 }

# Built-in routes and their security
$plg->config->{Routes}->{logout}              = { Protected => 1, 'Built in' => 1, Groups=>[] }; # we should be logged in to logout
$plg->config->{Routes}->{login}               = { Protected => 0, 'Built in' => 1 };
$plg->config->{Routes}->{WebService}          = { Protected => 0, 'Built in' => 1 };
$plg->config->{Routes}->{'WebService/client'} = { Protected => 0, 'Built in' => 1 };
$plg->config->{Routes}->{'WebService/routes'} = { Protected => 0, 'Built in' => 1 };
$plg->config->{Routes}->{''}                  = { Protected => 2, 'Built in' => 1 };

# Default settings
$plg->config->{'Default format'}= 'json' if ((! exists $plg->config->{'Default format'}) || ($plg->config->{'Default format'} !~ $fmt_rgx));
$app->config->{content_type}    = $Formats{ $plg->config->{'Default format'} };
$app->config->{show_errors}   //= 0;
$app->config->{charset}       //= 'UTF-8';
$app->config->{encoding}      //= 'UTF-8';

  # Use the first active authentication method
  foreach my $method (@{$plg->config->{'Authentication methods'}}) {
  next unless ((exists $method->{Active}) && ($method->{Active}=~/(?i)[y1t]/));
  $plg->auth_method( $method->{Name} );

    # If the Authorization method is an external script
    if ($plg->auth_method ne 'INTERNAL') {
    unless (exists $method->{Command}) {warn "The active Authentication method \"".$plg->auth_method."\" does not know what to do\n"; exit 1}
    $method->{Command} =~s/^MODULE_INSTALL_DIR/$module_dir/;
    unless (-f $method->{Command}) {warn "Sorry, could not found the external authorization utility $method->{Command}\n"; exit 1}
    unless (-x $method->{Command}) {warn "Sorry, the external authorization utility $method->{Command} is not executable from user ". getpwuid($>) ."\n"; exit 1}

      if ((exists $method->{'Use sudo'}) && ($method->{'Use sudo'}=~/(?i)[y1t]/)) {
      my $sudo = undef;
      foreach (qw[/usr/bin /bin /usr/sbin /sbin]) { if ((-f "$_/sudo") && -x ("$_/sudo")) { $sudo="$_/sudo"; last } }
      unless (defined $sudo) {warn "Could not found sudo command\n"; exit 1}
      $plg->auth_command( "$sudo \Q$method->{Command}\E" )
      }
      else {
      $plg->auth_command( "\Q$method->{Command}\E" )
      }
    }

  delete @{$method}{'Name','Active','Command','Use sudo'};
  $method->{Arguments} //= [];
  $plg->auth_config($method);
  last
  }

delete $plg->config->{'Session enable'};
delete $plg->config->{'Authentication methods'};

  if (($plg->session_enable) && ($plg->auth_method eq '')) {
  warn "\nWhile the sessions are enabled there is not any active authorization method at your config.yml\n";
  CORE::exit 1
  }

  # Check if there are protected routes
  foreach (keys %{$plg->config->{Routes}}) {
  next if exists  $plg->config->{Routes}->{$_}->{'Built in'};
  $plg->config->{Routes}->{$_}->{'Built in'}=0;

    if ((exists $plg->config->{Routes}->{$_}->{Protected}) && ($plg->config->{Routes}->{$_}->{Protected}=~/(?i)[y1t]/)) {

    delete $plg->config->{Routes}->{$_}->{Protected};
           $plg->config->{Routes}->{$_}->{Protected}=1;

      if ($plg->auth_method eq '') {
      warn "\nWhile there is at least one protected route ( $_ ) there is not any active authorization method at your config.yaml\n";
      CORE::exit 1
      }
      else {

        if (exists $plg->config->{Routes}->{$_}->{Groups}) {
        $plg->config->{Routes}->{$_}->{Groups} = [ $plg->config->{Routes}->{$_}->{Groups} ] unless 'ARRAY' eq ref $plg->config->{Routes}->{$_}->{Groups}
        }
        else {
        $plg->config->{Routes}->{$_}->{Groups} = []
        }
      }
    }
    else {
    delete $plg->config->{Routes}->{$_}->{Protected};
           $plg->config->{Routes}->{$_}->{Protected}=0
    }
  }

print STDOUT "\n";
print STDOUT "Application name      : ", $plg->dsl->config->{appname}  ,"\n";
print STDOUT 'Start time            : ', scalar localtime $^T ,"\n";
print STDOUT 'Run as user           : ', (getpwuid($>))[0] ,"\n";
print STDOUT "Command               : $0\n";
print STDOUT "PID parent            : ", getppid() ,"\n";
print STDOUT "PID Main              : $$\n";
print STDOUT 'Authorization method  : ', ( $plg->auth_method ? $plg->auth_method :'UNDEFINED' ) ,"\n";
print STDOUT "Authorization scripts : $module_dir/\n";
print STDOUT 'Environment           : ', $plg->dsl->config->{environment} ,"\n";
print STDOUT 'Logging               : ', $plg->dsl->config->{log} ,"\n";
print STDOUT 'Session enable        : ', ( $plg->session_enable ? 'Yes' : 'No') ,"\n";
print STDOUT 'Session directory     : ', $plg->dir_session ,"\n";
print STDOUT 'Session idle timeout  : ', $plg->Session_timeout ," sec\n";
print STDOUT "Version application   : ", ( exists $plg->dsl->config->{appversion} ? $plg->dsl->config->{appversion} : '0.0.0' ) ,"\n";
print STDOUT "Version Perl          : $^V\n";
print STDOUT "Version Dancer2       : $Dancer2::VERSION\n";
print STDOUT "Version WebService    : $VERSION\n";
print STDOUT "Operating system      : ", $plg->OS ,"\n";

# Restore the valid sessions, and delete the expired ones
opendir DIR, $plg->dir_session or die "Could not list session directory $plg->{dir_session} because $!\n";

  foreach my $token (grep ! /^\.+$/, readdir DIR) {

    if ((-f "$plg->{dir_session}/$token/control/lastaccess") && (-f "$plg->{dir_session}/$token/control/username") && (-f "$plg->{dir_session}/$token/control/groups")) {
    my $lastaccess = ${ Storable::retrieve "$plg->{dir_session}/$token/control/lastaccess" };

      if (time - $lastaccess > $plg->Session_timeout) {
      print STDOUT "Delete expired session: $token\n";
      system $plg->rm, '-rf', "$plg->{dir_session}/$token"
      }
      else {
        $TokenDB{$token}->{data} = {};
      @{$TokenDB{$token}->{control}}{qw/lastaccess username groups/} = ($lastaccess, ${Storable::retrieve "$plg->{dir_session}/$token/control/username"}, ${Storable::retrieve "$plg->{dir_session}/$token/control/groups"});

      opendir __TOKEN, "$plg->{dir_session}/$token/data" or die "Could not read session directory $plg->{dir_session}/$token/data because $!\n";

        foreach my $record (grep ! /^\.{1,2}$/, readdir __TOKEN) {
        next unless -f "$plg->{dir_session}/$token/data/$record";
        $record = Encode::decode('utf8', $record);
        $TokenDB{$token}->{data}->{$record} = Storable::retrieve "$plg->{dir_session}/$token/data/$record";
        $TokenDB{$token}->{data}->{$record} = ${ $TokenDB{$token}->{data}->{$record} } if 'SCALAR' eq ref $TokenDB{$token}->{data}->{$record}
        }

      close __TOKEN;
      print STDOUT "Restore session       : $token (". scalar(keys %{$TokenDB{$token}->{data}}) ." records)\n"
      }
    }
    else {    
    print STDOUT "Delete corrupt session: $token\n";
    system $plg->rm,'-rf',"$plg->{dir_session}/$token"
    }
  }

closedir DIR;
print STDOUT "\n";


#print STDERR Dumper( $app ) ;exit;
#print STDERR Dumper( $plg->config->{Routes} ) ;exit;
#print STDERR Dumper( $plg->auth_config )      ;exit;
#print STDERR Dumper  \%TokenDB; exit;
#print STDERR "---------\n*".  $plg->dir_session  ."*\n---------\n";