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_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 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}) { 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 ($downloader, $site, $dir, $pattern, $dirversionmangle, $watchfile, $lineptr, $download_version) = @_; 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_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 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;