Adding upstream version 2.25.15.
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
This commit is contained in:
parent
10737b110a
commit
b543f2e88d
GPG key ID:
BCC918A2ABD66424
485 changed files with 191459 additions and 0 deletions
280
lib/Devscripts/Uscan/ftp.pm
Normal file
280
lib/Devscripts/Uscan/ftp.pm
Normal file
|
|
@ -0,0 +1,280 @@
|
|||
package Devscripts::Uscan::ftp;
|
||||
|
||||
use strict;
|
||||
use Cwd qw/abs_path/;
|
||||
use Devscripts::Uscan::Output;
|
||||
use Devscripts::Uscan::Utils;
|
||||
use Devscripts::Uscan::_xtp;
|
||||
use Moo::Role;
|
||||
|
||||
#######################################################################
|
||||
# search $newfile $newversion (ftp mode)
|
||||
#######################################################################
|
||||
sub ftp_search {
|
||||
my ($self) = @_;
|
||||
|
||||
# FTP site
|
||||
uscan_verbose "Requesting URL:\n $self->{parse_result}->{base}";
|
||||
my $request = HTTP::Request->new('GET', $self->parse_result->{base});
|
||||
my $response = $self->downloader->user_agent->request($request);
|
||||
if (!$response->is_success) {
|
||||
uscan_warn
|
||||
"In watch file $self->{watchfile}, reading FTP directory\n $self->{parse_result}->{base} failed: "
|
||||
. $response->status_line . "";
|
||||
return undef;
|
||||
}
|
||||
|
||||
my $content = $response->content;
|
||||
uscan_extra_debug
|
||||
"received content:\n$content\n[End of received content] by FTP";
|
||||
|
||||
# FTP directory listings either look like:
|
||||
# info info ... info filename [ -> linkname]
|
||||
# or they're HTMLised (if they've been through an HTTP proxy)
|
||||
# so we may have to look for <a href="filename"> type patterns
|
||||
uscan_verbose "matching pattern $self->{parse_result}->{pattern}";
|
||||
my (@files);
|
||||
|
||||
# We separate out HTMLised listings from standard listings, so
|
||||
# that we can target our search correctly
|
||||
if ($content =~ /<\s*a\s+[^>]*href/i) {
|
||||
uscan_verbose "HTMLized FTP listing by the HTTP proxy";
|
||||
while ($content
|
||||
=~ m/(?:<\s*a\s+[^>]*href\s*=\s*\")((?-i)$self->{parse_result}->{pattern})\"/gi
|
||||
) {
|
||||
my $file = fix_href($1);
|
||||
my $mangled_version
|
||||
= join(".", $file =~ m/^$self->{parse_result}->{pattern}$/);
|
||||
if (
|
||||
mangle(
|
||||
$self->watchfile, \$self->line,
|
||||
'uversionmangle:', \@{ $self->uversionmangle },
|
||||
\$mangled_version
|
||||
)
|
||||
) {
|
||||
return undef;
|
||||
}
|
||||
my $match = '';
|
||||
if (defined $self->shared->{download_version}
|
||||
and not $self->versionmode eq 'ignore') {
|
||||
if ($mangled_version eq $self->shared->{download_version}) {
|
||||
$match = "matched with the download version";
|
||||
}
|
||||
}
|
||||
my $priority = $mangled_version . '-' . get_priority($file);
|
||||
push @files, [$priority, $mangled_version, $file, $match];
|
||||
}
|
||||
} else {
|
||||
uscan_verbose "Standard FTP listing.";
|
||||
|
||||
# they all look like:
|
||||
# info info ... info filename [ -> linkname]
|
||||
for my $ln (split(/\n/, $content)) {
|
||||
$ln =~ s/^d.*$//; # FTP listing of directory, '' skipped
|
||||
$ln =~ s/\s+->\s+\S+$//; # FTP listing for link destination
|
||||
$ln =~ s/^.*\s(\S+)$/$1/; # filename only
|
||||
if ($ln and $ln =~ m/^($self->{parse_result}->{filepattern})$/) {
|
||||
my $file = $1;
|
||||
my $mangled_version = join(".",
|
||||
$file =~ m/^$self->{parse_result}->{filepattern}$/);
|
||||
if (
|
||||
mangle(
|
||||
$self->watchfile, \$self->line,
|
||||
'uversionmangle:', \@{ $self->uversionmangle },
|
||||
\$mangled_version
|
||||
)
|
||||
) {
|
||||
return undef;
|
||||
}
|
||||
my $match = '';
|
||||
if (defined $self->shared->{download_version}) {
|
||||
if ($mangled_version eq $self->shared->{download_version})
|
||||
{
|
||||
$match = "matched with the download version";
|
||||
}
|
||||
}
|
||||
my $priority = $mangled_version . '-' . get_priority($file);
|
||||
push @files, [$priority, $mangled_version, $file, $match];
|
||||
}
|
||||
}
|
||||
}
|
||||
if (@files) {
|
||||
@files = Devscripts::Versort::versort(@files);
|
||||
my $msg
|
||||
= "Found the following matching files on the web page (newest first):\n";
|
||||
foreach my $file (@files) {
|
||||
$msg .= " $$file[2] ($$file[1]) index=$$file[0] $$file[3]\n";
|
||||
}
|
||||
uscan_verbose $msg;
|
||||
}
|
||||
my ($newversion, $newfile);
|
||||
if (defined $self->shared->{download_version}) {
|
||||
|
||||
# extract ones which has $match in the above loop defined
|
||||
my @vfiles = grep { $$_[3] } @files;
|
||||
if (@vfiles) {
|
||||
(undef, $newversion, $newfile, undef) = @{ $vfiles[0] };
|
||||
} else {
|
||||
uscan_warn
|
||||
"In $self->{watchfile} no matching files for version $self->{shared}->{download_version}"
|
||||
. " in watch line\n $self->{line}";
|
||||
return undef;
|
||||
}
|
||||
} else {
|
||||
if (@files) {
|
||||
(undef, $newversion, $newfile, undef) = @{ $files[0] };
|
||||
} else {
|
||||
uscan_warn
|
||||
"In $self->{watchfile} no matching files for watch line\n $self->{line}";
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
return ($newversion, $newfile);
|
||||
}
|
||||
|
||||
sub ftp_upstream_url {
|
||||
my ($self) = @_;
|
||||
return $self->parse_result->{base} . $self->search_result->{newfile};
|
||||
}
|
||||
|
||||
*ftp_newfile_base = \&Devscripts::Uscan::_xtp::_xtp_newfile_base;
|
||||
|
||||
sub ftp_newdir {
|
||||
my ($line, $site, $dir, $pattern, $dirversionmangle, $watchfile,
|
||||
$lineptr, $download_version)
|
||||
= @_;
|
||||
my $downloader = $line->downloader;
|
||||
|
||||
my ($request, $response, $newdir);
|
||||
my ($download_version_short1, $download_version_short2,
|
||||
$download_version_short3)
|
||||
= partial_version($download_version);
|
||||
my $base = $site . $dir;
|
||||
$request = HTTP::Request->new('GET', $base);
|
||||
$response = $downloader->user_agent->request($request);
|
||||
if (!$response->is_success) {
|
||||
uscan_warn
|
||||
"In watch file $watchfile, reading webpage\n $base failed: "
|
||||
. $response->status_line;
|
||||
return '';
|
||||
}
|
||||
|
||||
my $content = $response->content;
|
||||
uscan_extra_debug
|
||||
"received content:\n$content\n[End of received content] by FTP";
|
||||
|
||||
# FTP directory listings either look like:
|
||||
# info info ... info filename [ -> linkname]
|
||||
# or they're HTMLised (if they've been through an HTTP proxy)
|
||||
# so we may have to look for <a href="filename"> type patterns
|
||||
uscan_verbose "matching pattern $pattern";
|
||||
my (@dirs);
|
||||
my $match = '';
|
||||
|
||||
# We separate out HTMLised listings from standard listings, so
|
||||
# that we can target our search correctly
|
||||
if ($content =~ /<\s*a\s+[^>]*href/i) {
|
||||
uscan_verbose "HTMLized FTP listing by the HTTP proxy";
|
||||
while (
|
||||
$content =~ m/(?:<\s*a\s+[^>]*href\s*=\s*\")((?-i)$pattern)\"/gi) {
|
||||
my $dir = $1;
|
||||
uscan_verbose "Matching target for dirversionmangle: $dir";
|
||||
my $mangled_version = join(".", $dir =~ m/^$pattern$/);
|
||||
if (
|
||||
mangle(
|
||||
$watchfile, $lineptr,
|
||||
'dirversionmangle:', \@{$dirversionmangle},
|
||||
\$mangled_version
|
||||
)
|
||||
) {
|
||||
return 1;
|
||||
}
|
||||
$match = '';
|
||||
if (defined $download_version
|
||||
and $mangled_version eq $download_version) {
|
||||
$match = "matched with the download version";
|
||||
}
|
||||
if (defined $download_version_short3
|
||||
and $mangled_version eq $download_version_short3) {
|
||||
$match = "matched with the download version (partial 3)";
|
||||
}
|
||||
if (defined $download_version_short2
|
||||
and $mangled_version eq $download_version_short2) {
|
||||
$match = "matched with the download version (partial 2)";
|
||||
}
|
||||
if (defined $download_version_short1
|
||||
and $mangled_version eq $download_version_short1) {
|
||||
$match = "matched with the download version (partial 1)";
|
||||
}
|
||||
push @dirs, [$mangled_version, $dir, $match];
|
||||
}
|
||||
} else {
|
||||
# they all look like:
|
||||
# info info ... info filename [ -> linkname]
|
||||
uscan_verbose "Standard FTP listing.";
|
||||
foreach my $ln (split(/\n/, $content)) {
|
||||
$ln =~ s/^-.*$//; # FTP listing of file, '' skipped
|
||||
$ln =~ s/\s+->\s+\S+$//; # FTP listing for link destination
|
||||
$ln =~ s/^.*\s(\S+)$/$1/; # filename only
|
||||
if ($ln =~ m/^($pattern)(\s+->\s+\S+)?$/) {
|
||||
my $dir = $1;
|
||||
uscan_verbose "Matching target for dirversionmangle: $dir";
|
||||
my $mangled_version = join(".", $dir =~ m/^$pattern$/);
|
||||
if (
|
||||
mangle(
|
||||
$watchfile, $lineptr,
|
||||
'dirversionmangle:', \@{$dirversionmangle},
|
||||
\$mangled_version
|
||||
)
|
||||
) {
|
||||
return 1;
|
||||
}
|
||||
$match = '';
|
||||
if (defined $download_version
|
||||
and $mangled_version eq $download_version) {
|
||||
$match = "matched with the download version";
|
||||
}
|
||||
if (defined $download_version_short3
|
||||
and $mangled_version eq $download_version_short3) {
|
||||
$match = "matched with the download version (partial 3)";
|
||||
}
|
||||
if (defined $download_version_short2
|
||||
and $mangled_version eq $download_version_short2) {
|
||||
$match = "matched with the download version (partial 2)";
|
||||
}
|
||||
if (defined $download_version_short1
|
||||
and $mangled_version eq $download_version_short1) {
|
||||
$match = "matched with the download version (partial 1)";
|
||||
}
|
||||
push @dirs, [$mangled_version, $dir, $match];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# extract ones which has $match in the above loop defined
|
||||
my @vdirs = grep { $$_[2] } @dirs;
|
||||
if (@vdirs) {
|
||||
@vdirs = Devscripts::Versort::upstream_versort(@vdirs);
|
||||
$newdir = $vdirs[0][1];
|
||||
}
|
||||
if (@dirs) {
|
||||
@dirs = Devscripts::Versort::upstream_versort(@dirs);
|
||||
my $msg
|
||||
= "Found the following matching FTP directories (newest first):\n";
|
||||
foreach my $dir (@dirs) {
|
||||
$msg .= " $$dir[1] ($$dir[0]) $$dir[2]\n";
|
||||
}
|
||||
uscan_verbose $msg;
|
||||
$newdir //= $dirs[0][1];
|
||||
} else {
|
||||
uscan_warn
|
||||
"In $watchfile no matching dirs for pattern\n $base$pattern";
|
||||
$newdir = '';
|
||||
}
|
||||
return $newdir;
|
||||
}
|
||||
|
||||
# Nothing to clean here
|
||||
sub ftp_clean { 0 }
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue