From 7f86a18b50d0329336c8c401782f589939f7f366 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Petr=20P=C3=ADsa=C5=99?= Date: Thu, 17 May 2012 17:46:11 +0200 Subject: [PATCH] Add HTTP server The server will server YUM repository of built packages for mock in the future. --- bin/rebuildperl | 1 + lib/Fedora/Rebuild.pm | 17 +++++ lib/Fedora/Rebuild/Repository.pm | 140 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 158 insertions(+) create mode 100644 lib/Fedora/Rebuild/Repository.pm diff --git a/bin/rebuildperl b/bin/rebuildperl index 2e181b5..75d37ab 100755 --- a/bin/rebuildperl +++ b/bin/rebuildperl @@ -12,6 +12,7 @@ my %config = ( done => 'done', failed => 'failed', workdir => 'workdir', + repodir => 'testrepo', dist => 'rawhide', target => 'dist-rawhide', message => 'Perl mass rebuild', diff --git a/lib/Fedora/Rebuild.pm b/lib/Fedora/Rebuild.pm index a609b9d..e64300e 100644 --- a/lib/Fedora/Rebuild.pm +++ b/lib/Fedora/Rebuild.pm @@ -10,6 +10,7 @@ use IO::Handle; use Fedora::Rebuild::Types qw( Mode ); use Fedora::Rebuild::Set::Package; use Fedora::Rebuild::Package; +use Fedora::Rebuild::Repository; use Fedora::Rebuild::Scheduler; use Fedora::Rebuild::Solver; use namespace::clean; @@ -18,6 +19,9 @@ has 'all' => (is => 'ro', isa => 'Str', required => 1); has 'done' => (is => 'ro', isa => 'Str', required => 1); has 'failed' => (is => 'ro', isa => 'Str', required => 1); has 'workdir' => (is => 'ro', isa => 'Str', required => 1); +# Directory where repository with built packages live. This is needed for +# `mock' build mode. +has 'repodir' => (is => 'ro', isa => 'Str', required => 1); # Git branch name # "f14", "f15" etc. Use "rawhide" for latest one. has 'dist' => (is => 'ro', isa => 'Str', required => 1); @@ -70,6 +74,8 @@ has 'subsequent_failures' => (is => 'rw', isa => 'Int', default => 0, init_arg => undef); has 'last_failed' => (is => 'rw', isa => 'Bool', default => 0, init_arg => undef); +has 'repository' => (is => 'ro', isa => 'Fedora::Rebuild::Repository', + lazy_build => 1, init_arg => undef); # Creates set of packages not yet rebuilt. @@ -193,6 +199,11 @@ sub _build_failed_packages { return $packages; } +sub _build_repository { + my $self = shift; + return Fedora::Rebuild::Repository->new(path => $self->repodir); +} + # Record package names into log of failed packages sub mark_failed { my ($self, $package) = @_; @@ -377,6 +388,12 @@ sub select_rebuildable { # Rebuild all remaining packages sub run { my $self = shift; + if (defined $self->repository) { + print "Starting repository HTTP server...\n"; + my $url = $self->repository->start; + print "Repository URL is: <$url>\n"; + } + print "remaining_packages: " . $self->remaining_packages->string . "\n"; print "done_packages: " . $self->done_packages->string . "\n"; print "Rebuild mode: " . $self->mode . diff --git a/lib/Fedora/Rebuild/Repository.pm b/lib/Fedora/Rebuild/Repository.pm new file mode 100644 index 0000000..f4b202b --- /dev/null +++ b/lib/Fedora/Rebuild/Repository.pm @@ -0,0 +1,140 @@ +package Fedora::Rebuild::Repository; +use strict; +use warnings; +use version 0.77; our $VERSION = version->declare("v0.8.0"); + +use threads; +use threads::shared; +use Moose; +use Carp; +use File::Path; +use File::Spec; +use HTTP::Daemon; +use HTTP::Status qw(:constants :is status_message); +use namespace::clean; + +# Directory where the repository exists +has 'path' => ( is => 'ro', isa => 'Str', required => 1); + +# Private attributes +has 'pid' => ( is => 'rw', isa => 'Int', lazy=> 1, init_arg => undef, + default => 0); + +around BUILDARGS => sub { + my $orig = shift; + my $class = shift; + my %attrs = @_; + + if (! defined $attrs{'path'} || $attrs{'path'} eq '') { + croak "Path must be a non-empty string"; + } + + $attrs{'path'} = File::Spec->rel2abs($attrs{'path'}); + if (! -d $attrs{'path'}) { + File::Path::make_path($attrs{'path'}) or + croak("Could not create repository directory `". $attrs{'path'} . + "': $!\n"); + } + + return $class->$orig(%attrs); +}; + +# Make object shared between threads to prevent killing daemon by DEMOLISH +# from scheduler threads. +# XXX: No attributes are shared automatically. +around 'new' => sub { + my $orig = shift; + my $class = shift; + return shared_clone($class->$orig(@_)); +}; + +# Kill the server process on object desctruction +sub DEMOLISH { + shift->stop; +} + +#sub insert { +# my ($self, $package) = @_; +# return $self; +#} + +# Update the repository. +# This updates YUM metadata. +sub update { + my $self = shift; + ...; +} + + +# Start to serve the repository over HTTP. +# Return URL. undef in case of error. +sub start { + my ($self) = @_; + my $server = HTTP::Daemon->new( 'LocalAddr' => 'localhost' ); + if (!defined($server)) { + return undef; + } + my $daemon = fork; + if (!defined $daemon) { + undef $server; + return undef; + } elsif ($daemon == 0) { + # Daemon + $self->run_daemon($server); + exit 0; + } else { + # Parent + $self->pid($daemon); + return $server->url; + } +} + + +# Stop serving the repository +sub stop { + my $self = shift; + if ($self->pid) { + kill 9, $self->pid; + waitpid($self->pid, 0); + } +} + + +# Private method +sub run_daemon { + my ($self, $server) = @_; + if (! defined $server) { return -1; } + + my $connection; + while (1) { + if (defined $connection) { + $connection->close; + undef($connection); + } + + $connection = $server->accept; + my $request = $connection->get_request; + $connection->force_last_request; + + if (! defined $request) { + print STDERR "repository server: Bad request\n"; + next; + } + if ($request->method eq 'GET') { + my $rpath = $request->uri; + if ($rpath =~ m|\.\./|) { + $connection->send_error(HTTP_FORBIDDEN, + "Parent directories are fobidden"); + next; + } + $rpath =~ s|^/||; + $connection->send_file_response( + File::Spec->catfile($self->path, $rpath)); + } else { + $connection->send_error(HTTP_NOT_IMPLEMENTED, + "Only GET method is supported"); + } + } +} + +1; -- 2.11.4.GIT