From 62c1446f09cc16428431510218e5e4f1e06271f3 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Thu, 30 Nov 2006 17:57:43 +0000 Subject: more tests, clean some others, enhance helper.pm --- t/02create_pkgs.t | 8 ++ t/helper.pm | 38 ++++++++- t/simple-httpd | 191 ++++++++++++++++++++++++++++++++++++++++++ t/superuser--arch_to_noarch.t | 11 ++- t/superuser--exclude.t | 29 ++----- t/superuser--http.t | 20 +++++ t/superuser--media_info_dir.t | 19 +++++ 7 files changed, 287 insertions(+), 29 deletions(-) create mode 100755 t/simple-httpd create mode 100644 t/superuser--http.t create mode 100644 t/superuser--media_info_dir.t (limited to 't') 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 \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 = || 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($_ = )) { + 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); +} -- cgit v1.2.1