LINUX.ORG.RU

Perl, не работают скрипты с новыми библиотеками

 


0

1

Помогите, пожалуйста!

После переноса на ubuntu 20 не работает часть функционала :( На новом серваке версия perl 5.30 на старом perl 5.26

При попытке скачать файл с сайта, ошибка:

[2020-05-05 15:16:43.21482] [19566] [error] [a03a6c48] Invalid 
path at /usr/share/perl5/Mojolicious/Static.pm line 47.

самописная библиотека /var/www/site.ru/lib/SiteUpload.pm:

package SiteUpload;

use Mojo::Base 'Mojolicious';
use Util;
use Data::Dumper;

has conf => sub { do './conf/app.conf' };
has db   => sub { Util->db(do './conf/mysql.conf') };

sub startup {
        my $self = shift;
        my $conf = $self->conf;

        $self->static  ->paths([$conf->{'path'}->{'data'}]);
        $self->renderer->paths([$conf->{'path'}->{'tmpl'}]);
        $self->log( Mojo::Log->new( %{$conf->{'log'}} ) ) if $conf->{'log'};

        $self->renderer->encoding('cp1251');
        $self->types->type(html => 'text/html; charset=windows-1251');

        $self->plugin('SiteUpload::Helpers');

        my $r = $self->routes;

        $r->route("/load/:secret/:file", secret => qr/[\w0-9]+/, file => qr/.*/)->to("main#download");

        for my $b ($r->under->to('user-auth#check', layout => 'default')) {
                $b->route('/')->to('main#welcome');
                $b->route('/action/')->to('main#action');
                $b->route('/deleted')->to('main#deleted');
#               $b->route('/block/:id/', id => qr/\d+/)->to('main#block');
#               $b->route('/unblock/:id/', id => qr/\d+/)->to('main#unblock');
#               $b->route('/free/:id/', id => qr/\d+/)->to('main#free');
        }

        for my $b ($r->under('/admin')->to('admin-main#enter', layout => 'admin')) {
                $b->route('/'    )->to('admin-main#list');
                $b->route('/full/list')->to('admin-main#full_list');
                $b->route('/:remoteuser', remoteuser => qr/[0-9A-Z_\-\.]+/i)->to('admin-main#user_list');
#               $b->route('/:command/:id', id => qr/\d+/)->to('admin-main#do_command');
        }
}

1;

новая библиотека /usr/share/perl5/Mojolicious/Static.pm:

package Mojolicious::Static;
use Mojo::Base -base;

use Mojo::Asset::File;
use Mojo::Asset::Memory;
use Mojo::Date;
use Mojo::File qw(curfile path);
use Mojo::Loader qw(data_section file_is_binary);
use Mojo::Util qw(encode md5_sum trim);

# Bundled files
my $PUBLIC = curfile->sibling('resources', 'public');
my %EXTRA  = $PUBLIC->list_tree->map(
  sub { join('/', @{$_->to_rel($PUBLIC)}), $_->realpath->to_string })->each;

has classes => sub { ['main'] };
has extra   => sub { +{%EXTRA} };
has paths   => sub { [] };

sub dispatch {
  my ($self, $c) = @_;

  # Method (GET or HEAD)
  my $req    = $c->req;
  my $method = $req->method;
  return undef unless $method eq 'GET' || $method eq 'HEAD';

  # Canonical path
  my $stash = $c->stash;
  my $path  = $req->url->path;
  $path = $stash->{path} ? $path->new($stash->{path}) : $path->clone;
  return undef unless my @parts = @{$path->canonicalize->parts};

  # Serve static file and prevent path traversal
  my $canon_path = join '/', @parts;
  return undef if $canon_path =~ /^\.\.\/|\\/ || !$self->serve($c, $canon_path);
  $stash->{'mojo.static'} = 1;
  return !!$c->rendered;
}

sub file {
  my ($self, $rel) = @_;

  # Search all paths
  my @parts = split '/', $rel;
  for my $path (@{$self->paths}) {
    next unless my $asset = _get_file(path($path, @parts)->to_string);
    return $asset;
  }

  # Search DATA
  if (my $asset = $self->_get_data_file($rel)) { return $asset }

  # Search extra files
  my $extra = $self->extra;
  return exists $extra->{$rel} ? _get_file($extra->{$rel}) : undef;
}

  # ошибка выглядит так, как будто сюда приезжает пустое значение      
  $self->static  ->paths([$conf->{'path'}->{'data'}]);
pru-mike ★★ ()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.