more tests, clean some others, enhance helper.pm

7 files changed, 287 insertions, 29 deletions

diff --git a/t/02create_pkgs.t b/t/02create_pkgs.t
index 8a716226..ff6dabba 100644
--- a/t/02create_pkgs.t
+++ b/t/02create_pkgs.t
@@ -15,6 +15,14 @@ foreach my $spec (glob("SPECS/*.spec")) {
     my ($name) = $spec =~ m!([^/]*)\.spec$!;
     mkdir "media/$name";
     system_("mv RPMS/*/*.rpm media/$name");
+
+    if ($name eq 'various') {
+	system_("cp -r media/various media/various_nohdlist");
+	system_("cp -r media/various media/various_no_subdir");
+	system_("genhdlist --dest media/various_no_subdir");
+    }
+
+    system_("genhdlist --subdir media/$name/media_info media/$name");
 }
 
 sub system_ {
diff --git a/t/helper.pm b/t/helper.pm
index 334700e8..7c8d29b6 100644
--- a/t/helper.pm
+++ b/t/helper.pm
@@ -1,6 +1,13 @@
 package helper;
 
 use Test::More;
+use base 'Exporter';
+our @EXPORT = qw(need_root_and_prepare 
+		 start_httpd httpd_port
+		 urpmi_addmedia urpmi_removemedia
+		 urpmi urpme
+		 system_
+	    );
 
 my $using_root;
 sub need_root_and_prepare() {
@@ -17,17 +24,40 @@ sub need_root_and_prepare() {
     $using_root = 1;
 }
 
+my $server_pid;
+sub httpd_port { 6969 }
+sub start_httpd() {
+    $server_pid = fork();
+    if ($server_pid == 0) {
+	mkdir 'tmp';
+	exec './simple-httpd', $pwd, "$pwd/tmp", httpd_port();
+	exit 1;
+    }
+    'http://localhost:' . httpd_port();
+}
+
+chdir 't' if -d 't';
+
 chomp($::pwd = `pwd`);
-my $urpmi_debug_opt = '-q';#'-v --debug';
+my $urpmi_debug_opt = '-q';
+#$urpmi_debug_opt = '-v --debug';
 
 sub urpmi_addmedia {
     my ($para) = @_;
     system_("perl -I.. ../urpmi.addmedia $urpmi_debug_opt --urpmi-root $::pwd/root $para");
 }
+sub urpmi_removemedia {
+    my ($para) = @_;
+    system_("perl -I.. ../urpmi.removemedia $urpmi_debug_opt --urpmi-root $::pwd/root $para");
+}
 sub urpmi {
     my ($para) = @_;
     system_("perl -I.. ../urpmi $urpmi_debug_opt --urpmi-root $::pwd/root --ignoresize $para");
 }
+sub urpme {
+    my ($para) = @_;
+    system_("perl -I.. ../urpme --urpmi-root $::pwd/root $para");
+}
 
 sub system_ {
     my ($cmd) = @_;
@@ -35,6 +65,10 @@ sub system_ {
     ok($? == 0, $cmd);
 }
 
-END { $using_root and system('rm -rf root') }
+END { 
+    $using_root and system('rm -rf root');
+    $server_pid and kill(9, $server_pid);
+    system('rm -rf tmp');
+}
 
 1;
diff --git a/t/simple-httpd b/t/simple-httpd
new file mode 100755
index 00000000..ff485228
--- /dev/null
+++ b/t/simple-httpd
@@ -0,0 +1,191 @@
+#!/usr/bin/perl -w
+
+###----------------------------------------###
+###     httpd server class                 ###
+###----------------------------------------###
+
+use base qw(Net::Server::Single);
+use strict;
+
+@ARGV == 3 or die "usage: simple-httpd <document root> <log dir> <port>\n";
+my ($DOCUMENT_ROOT, $SERVER_ROOT, $PORT) = @ARGV;
+
+### run the server
+__PACKAGE__->run;
+exit;
+
+###----------------------------------------------------------------###
+
+### set up some server parameters
+sub configure_hook {
+  my $self = shift;
+
+  my $root = $self->{server_root} = $SERVER_ROOT;
+
+  $self->{server}->{port}     = "*:$PORT";   # port and addr to bind
+  $self->{server}->{user}     = 'nobody'; # user to run as
+  $self->{server}->{group}    = 'nobody'; # group to run as
+  $self->{server}->{setsid}   = 1;        # daemonize
+  $self->{server}->{log_file} = "$root/server.log";
+
+
+  $self->{document_root} = $DOCUMENT_ROOT;
+  $self->{access_log}    = "$root/access.log";
+  $self->{error_log}     = "$root/error.log";
+
+  $self->{default_index} = [ qw(index.html index.htm main.htm) ];
+
+  $self->{mime_types} = {
+    html => 'text/html',
+    htm  => 'text/html',
+    gif  => 'image/gif',
+    jpg  => 'image/jpeg',
+  };
+  $self->{mime_default} = 'text/plain';
+
+}
+
+sub post_configure_hook {
+  my $self = shift;
+
+  open(STDERR, ">>". $self->{error_log})  || die "Couldn't open STDERR: $!";
+  open(ACCESS, ">>". $self->{access_log}) || die "Couldn't open ACCESS: $!";
+  my $old = select ACCESS;
+  $| = 1;
+  select STDERR;
+  $| = 1;
+  select $old;
+}
+
+
+### process the request
+sub process_request {
+  my $self = shift;
+
+  local %ENV = ();
+  local $self->{needs_header} = 1;
+
+  ### read the first line of response
+  my $line = <STDIN> || return $self->error(400, "No Data");
+  $line =~ s/[\r\n]+$//;
+  if ($line !~ /^ (\w+) \ + (\S+) \ + (HTTP\/[01].\d) $ /x) {
+    return $self->error(400, "Bad request $line");
+  }
+  my ($method, $req, $protocol) = ($1, $2, $3);
+  print ACCESS join(" ", time, $method, $req)."\n";
+
+  ### read in other headers
+  $self->read_headers || return $self->error(400, "Strange headers");
+
+  ### do we support the type
+  if ($method !~ /GET|POST|HEAD/) {
+    return $self->error(400, "Unsupported Method");
+  }
+  $ENV{REQUEST_METHOD} = $method;
+
+  ### can we read that request
+  if ($req !~ m|^ (?:http://[^/]+)? (.*) $|x) {
+    return $self->error(400, "Malformed URL");
+  }
+  $ENV{REQUEST_URI} = $1;
+
+  ### parse out the uri and query string
+  my $uri = '';
+  $ENV{QUERY_STRING} = '';
+  if ($ENV{REQUEST_URI} =~ m|^ ([^\?]+) (?:\?(.+))? $|x) {
+    $ENV{QUERY_STRING} = defined($2) ? $2 : '';
+    $uri = $1;
+  }
+
+  ### clean up uri
+  if ($uri =~ /[\ \;]/) {
+    return $self->error(400, "Malformed URL");
+  }
+  $uri =~ s/%(\w\w)/chr(hex($1))/eg;
+  1 while $uri =~ s|^\.\./+||; # can't go below doc root
+
+
+  ### at this point the uri should be ready to use
+  $uri = "$self->{document_root}$uri";
+
+  ### see if there's an index page
+  if (-d $uri) {
+    foreach (@{ $self->{default_index} }){
+      if (-e "$uri/$_") {
+        $uri = "$uri/$_";
+        last;
+      }
+    }
+  }
+
+  ### error 404
+  if (! -e $uri) {
+    return $self->error(404, "file not found");
+
+  ### directory listing
+  } elsif (-d $uri) {
+    ### need work on this
+    print $self->content_type('text/html'),"\r\n";
+    print "Directory listing not supported";
+
+  }
+
+  ### spit it out
+  open(my $fh, "<$uri") || return $self->error(500, "Can't open file [$!]");
+
+  my ($type) = $uri =~ /([^\.]+)$/;
+  $type = $self->{mime_types}->{$type} || $self->{mime_default};
+
+  print $self->status(200), $self->content_type($type), "\r\n";
+
+  print STDOUT $_ while read $fh, $_, 8192;
+  close $fh;
+
+}
+
+sub read_headers {
+  my $self = shift;
+
+  $self->{headers} = {};
+
+  while (defined($_ = <STDIN>)) {
+    s/[\r\n]+$//;
+    last unless length $_;
+    return 0 if ! /^ ([\w\-]+) :[\ \t]+ (.+) $/x;
+    my $key = "HTTP_" . uc($1);
+    $key =~ tr/-/_/;
+    $self->{headers}->{$key} = $2;
+  }
+
+  return 1;
+}
+
+sub content_type {
+  my ($self, $type) = @_;
+  $self->http_header;
+  return "Content-type: $type\r\n";
+}
+
+sub error{
+  my ($self, $number, $msg) = @_;
+  print $self->status($number, $msg), "\r\n";
+  warn "Error - $number - $msg\n";
+}
+
+sub status {
+  my ($self, $number, $msg) = @_;
+  $msg = '' if ! defined $msg;
+  return if $self->http_header($number);
+  return "Status $number: $msg\r\n";
+}
+
+sub http_header {
+  my $self = shift;
+  my $number = shift || 200;
+  return if ! delete $self->{needs_header};
+  print "HTTP/1.0 $number\r\n";
+  return 1;
+}
+
+1;
+
diff --git a/t/superuser--arch_to_noarch.t b/t/superuser--arch_to_noarch.t
index 3224ea87..1b3869dc 100644
--- a/t/superuser--arch_to_noarch.t
+++ b/t/superuser--arch_to_noarch.t
@@ -1,18 +1,17 @@
 #!/usr/bin/perl
 
 use strict;
+use lib '.', 't';
+use helper;
 use Test::More 'no_plan';
 
-chdir 't' if -d 't';
-require './helper.pm';
-
-helper::need_root_and_prepare();
+need_root_and_prepare();
 
 my $name = 'arch_to_noarch';
 
 foreach my $nb (1 .. 4) {
     my $medium_name = "${name}_$nb";
-    helper::urpmi_addmedia("$medium_name $::pwd/media/$medium_name");
-    helper::urpmi("$name");
+    urpmi_addmedia("$medium_name $::pwd/media/$medium_name");
+    urpmi("$name");
     is(`rpm -qa --root $::pwd/root`, "$name-$nb-1\n");
 }
diff --git a/t/superuser--exclude.t b/t/superuser--exclude.t
index 44a2a1a3..24abb189 100644
--- a/t/superuser--exclude.t
+++ b/t/superuser--exclude.t
@@ -1,26 +1,20 @@
 #!/usr/bin/perl
 
 use strict;
+use lib '.', 't';
+use helper;
 use Test::More 'no_plan';
 
 BEGIN { use_ok 'urpm::cfg' }
 BEGIN { use_ok 'urpm::download' }
 
-chdir 't' if -d 't';
-require './helper.pm';
-
-helper::need_root_and_prepare();
+need_root_and_prepare();
 
 my $name = 'various';
 
-my $urpmi_debug_opt = '-q';#'-v --debug';
-my $urpmi_addmedia = "perl -I.. ../urpmi.addmedia $urpmi_debug_opt --urpmi-root $::pwd/root";
-my $urpmi          = "perl -I.. ../urpmi          $urpmi_debug_opt --urpmi-root $::pwd/root --ignoresize";
-my $urpme          = "perl -I.. ../urpme --urpmi-root $::pwd/root";
-
 my @want = `rpm -qpl media/$name/$name-1-1.*.rpm`;
 
-system_("$urpmi_addmedia $name $::pwd/media/$name");
+urpmi_addmedia("$name $::pwd/media/$name");
 
 foreach ([ '', \@want ],
 	 [ '--excludedocs', [ grep { !m!^/usr/share/doc! } @want ] ],
@@ -44,18 +38,18 @@ sub test_rpm_cmdline {
 sub test_urpmi_cmdline {
     my ($option, $want) = @_;
 
-    system_("$urpmi $option $name");
+    urpmi("$option $name");
     check("urpmi $option", $want);
-    system_("$urpme $name");
+    urpme($name);
     check('rpm -e', []);
 }
 sub test_urpmi_through_urpmi_cfg {
     my ($option, $want) = @_;
 
     set_urpmi_cfg_global_options(cmdline2hash($option));
-    system_("$urpmi $name");
+    urpmi($name);
     check("urpmi ($option in urpmi.cfg)", $want);
-    system_("$urpme $name");
+    urpme($name);
     check('rpm -e', []);
     set_urpmi_cfg_global_options({});
 }
@@ -85,11 +79,4 @@ sub filter_urpmi_rpm_files {
     grep { !m!^(/dev/null|/etc/urpmi|/etc/rpm/macros|/var/(cache|lib)/(urpmi|rpm))! } @_;
 }
 
-sub system_ {
-    my ($cmd) = @_;
-    system($cmd);
-    ok($? == 0, $cmd);
-}
 sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
-
-END { system('rm -rf root') }
diff --git a/t/superuser--http.t b/t/superuser--http.t
new file mode 100644
index 00000000..85ef1d1c
--- /dev/null
+++ b/t/superuser--http.t
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+
+use strict;
+use lib '.', 't';
+use helper;
+use Test::More 'no_plan';
+
+
+need_root_and_prepare();
+my $url = start_httpd();
+
+my $name = 'various';
+
+foreach my $medium_name ('various', 'various_no_subdir') {
+    urpmi_addmedia("$medium_name $url/media/$medium_name");
+    urpmi($name);
+    is(`rpm -qa --root $::pwd/root`, "$name-1-1\n");
+    urpme($name);
+    urpmi_removemedia($medium_name);
+}
diff --git a/t/superuser--media_info_dir.t b/t/superuser--media_info_dir.t
new file mode 100644
index 00000000..bfa2be56
--- /dev/null
+++ b/t/superuser--media_info_dir.t
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+
+use strict;
+use lib '.', 't';
+use helper;
+use Test::More 'no_plan';
+
+
+need_root_and_prepare();
+
+my $name = 'various';
+
+foreach my $medium_name ('various', 'various_nohdlist', 'various_no_subdir') {
+    urpmi_addmedia("$medium_name $::pwd/media/$medium_name");
+    urpmi($name);
+    is(`rpm -qa --root $::pwd/root`, "$name-1-1\n");
+    urpme($name);
+    urpmi_removemedia($medium_name);
+}