forked from pool/perl-libwww-perl
Accepting request 40441 from devel:languages:perl
checked in (request 40441) OBS-URL: https://build.opensuse.org/request/show/40441 OBS-URL: https://build.opensuse.org/package/show/devel:languages:perl/perl-libwww-perl?expand=0&rev=16
This commit is contained in:
parent
79655ca5e1
commit
505c3a29e9
@ -1,73 +0,0 @@
|
||||
Index: libwww-perl-5.834/bin/lwp-download
|
||||
===================================================================
|
||||
--- libwww-perl-5.834.orig/bin/lwp-download
|
||||
+++ libwww-perl-5.834/bin/lwp-download
|
||||
@@ -6,7 +6,7 @@ lwp-download - Fetch large files from th
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
-B<lwp-download> [B<-a>] <I<url>> [<I<local path>>]
|
||||
+B<lwp-download> [B<-a>] [B<-s>] <I<url>> [<I<local path>>]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
@@ -16,15 +16,19 @@ file.
|
||||
If I<local path> is not specified, then the current directory is
|
||||
assumed.
|
||||
|
||||
-If I<local path> is a directory, then the basename of the file to save
|
||||
-is picked up from the Content-Disposition header or the URL of the
|
||||
-response. If the file already exists, then B<lwp-download> will
|
||||
-prompt before it overwrites and will fail if its standard input is not
|
||||
-a terminal. This form of invocation will also fail is no acceptable
|
||||
-filename can be derived from the sources mentioned above.
|
||||
+If I<local path> is a directory, then the last segment of the path of the
|
||||
+I<url> is appended to form a local filename. If the I<url> path ends with
|
||||
+slash the name "index" is used. With the B<-s> option pick up the last segment
|
||||
+of the filename from server provided sources like the Content-Disposition
|
||||
+header or any redirect URLs. A file extension to match the server reported
|
||||
+Content-Type might also be appended. If a file with the produced filename
|
||||
+already exists, then B<lwp-download> will prompt before it overwrites and will
|
||||
+fail if its standard input is not a terminal. This form of invocation will
|
||||
+also fail is no acceptable filename can be derived from the sources mentioned
|
||||
+above.
|
||||
|
||||
If I<local path> is not a directory, then it is simply used as the
|
||||
-path to save into.
|
||||
+path to save into. If the file already exists it's overwritten.
|
||||
|
||||
The I<lwp-download> program is implemented using the I<libwww-perl>
|
||||
library. It is better suited to down load big files than the
|
||||
@@ -66,7 +70,7 @@ $progname =~ s/\.\w*$//; # strip extensi
|
||||
#parse option
|
||||
use Getopt::Std;
|
||||
my %opt;
|
||||
-unless (getopts('a', \%opt)) {
|
||||
+unless (getopts('as', \%opt)) {
|
||||
usage();
|
||||
}
|
||||
|
||||
@@ -106,20 +110,17 @@ my $res = $ua->request(HTTP::Request->ne
|
||||
|
||||
unless (defined $argfile) {
|
||||
# find a suitable name to use
|
||||
- $file = $res->filename;
|
||||
+ $file = $opt{s} && $res->filename;
|
||||
|
||||
# if this fails we try to make something from the URL
|
||||
unless ($file) {
|
||||
- my $req = $res->request; # not always there
|
||||
- my $rurl = $req ? $req->uri : $url;
|
||||
-
|
||||
- $file = ($rurl->path_segments)[-1];
|
||||
+ $file = ($url->path_segments)[-1];
|
||||
if (!defined($file) || !length($file)) {
|
||||
$file = "index";
|
||||
my $suffix = media_suffix($res->content_type);
|
||||
$file .= ".$suffix" if $suffix;
|
||||
}
|
||||
- elsif ($rurl->scheme eq 'ftp' ||
|
||||
+ elsif ($url->scheme eq 'ftp' ||
|
||||
$file =~ /\.t[bg]z$/ ||
|
||||
$file =~ /\.tar(\.(Z|gz|bz2?))?$/
|
||||
) {
|
@ -1,8 +1,3 @@
|
||||
-------------------------------------------------------------------
|
||||
Thu May 20 16:02:44 CEST 2010 - anicka@suse.cz
|
||||
|
||||
- fixed filename vulnerability in lwp-download (bnc#606321)
|
||||
|
||||
-------------------------------------------------------------------
|
||||
Wed Jan 13 16:40:12 CET 2010 - anicka@suse.cz
|
||||
|
||||
|
@ -28,7 +28,6 @@ License: Artistic License ..
|
||||
Group: Development/Libraries/Perl
|
||||
Url: http://search.cpan.org/dist/LWP/
|
||||
Source: %{cpan_name}-%{version}.tar.bz2
|
||||
Patch: %{name}-%{version}-Content-Disposition.diff
|
||||
BuildRoot: %{_tmppath}/%{name}-%{version}-build
|
||||
BuildRequires: perl
|
||||
BuildRequires: perl-macros
|
||||
@ -67,7 +66,6 @@ help you implement simple HTTP servers.
|
||||
Martijn Koster
|
||||
%prep
|
||||
%setup -q -n %{cpan_name}-%{version}
|
||||
%patch -p1
|
||||
|
||||
%build
|
||||
CFLAGS="$RPM_OPT_FLAGS" perl Makefile.PL
|
||||
|
Loading…
Reference in New Issue
Block a user