Perl, не работают скрипты с новыми библиотеками
Форум — General
Помогите, пожалуйста!
После переноса на 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;
}