From 79655ca5e1f595974a80da8c9788ed5c7d9ec9bb3ba51d1b897323a57c9634a3 Mon Sep 17 00:00:00 2001
From: Anna Maresova <anicka@suse.com>
Date: Thu, 20 May 2010 14:13:45 +0000
Subject: [PATCH] - fixed filename vulnerability in lwp-download (bnc#606321)

OBS-URL: https://build.opensuse.org/package/show/devel:languages:perl/perl-libwww-perl?expand=0&rev=15
---
 ...libwww-perl-5.834-Content-Disposition.diff | 73 +++++++++++++++++++
 perl-libwww-perl.changes                      |  5 ++
 perl-libwww-perl.spec                         |  2 +
 3 files changed, 80 insertions(+)
 create mode 100644 perl-libwww-perl-5.834-Content-Disposition.diff

diff --git a/perl-libwww-perl-5.834-Content-Disposition.diff b/perl-libwww-perl-5.834-Content-Disposition.diff
new file mode 100644
index 0000000..4233cf6
--- /dev/null
+++ b/perl-libwww-perl-5.834-Content-Disposition.diff
@@ -0,0 +1,73 @@
+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?))?$/
+ 			  ) {
diff --git a/perl-libwww-perl.changes b/perl-libwww-perl.changes
index 277d389..2f9055f 100644
--- a/perl-libwww-perl.changes
+++ b/perl-libwww-perl.changes
@@ -1,3 +1,8 @@
+-------------------------------------------------------------------
+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
 
diff --git a/perl-libwww-perl.spec b/perl-libwww-perl.spec
index 35dc844..2c31178 100644
--- a/perl-libwww-perl.spec
+++ b/perl-libwww-perl.spec
@@ -28,6 +28,7 @@ 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
@@ -66,6 +67,7 @@ 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