[buildd-tools-devel] Bug#546555: sbuild: Please add support to supply remote source (.dsc) files
Andres Mejia
mcitadel at gmail.com
Mon Sep 14 04:00:48 UTC 2009
Package: sbuild
Version: 0.59.1~rc1
Severity: wishlist
Tags: patch
Please allow sbuild to build from remote source files as well as files on the
local system.
Here are patches that I've implemented for the current git version. It adds
three new utility subroutines and uses them to download files from the web.
Basically, on top of supporting passing in local dsc files and [PACKAGE_VERSION]
to get sources via apt, you can now supply a url of a dsc file on the web, and
sbuild will use these source files to build the corresponding packages just like
it does now.
I had to change how dsc_files() was parsing dsc files because of some problem I
was experiencing with dcmd. The new way of parsing the dsc file is better I
think. This takes out a dependency from devscripts I think, but will need a
dependency on libwww-perl.
-- System Information:
Debian Release: squeeze/sid
APT prefers unstable
APT policy: (500, 'unstable'), (1, 'experimental')
Architecture: i386 (i686)
Kernel: Linux 2.6.30-1-686 (SMP w/2 CPU cores)
Locale: LANG=en_US.UTF-8, LC_CTYPE=en_US.UTF-8 (charmap=UTF-8)
Shell: /bin/sh linked to /bin/dash
Versions of packages sbuild depends on:
ii adduser 3.110 add and remove users and groups
ii libsbuild-perl 0.59.1~rc1 Tool for building Debian binary pa
ii perl 5.10.0-25 Larry Wall's Practical Extraction
ii perl-modules 5.10.0-25 Core Perl modules
Versions of packages sbuild recommends:
ii debootstrap 1.0.15 Bootstrap a basic Debian system
ii fakeroot 1.13 Gives a fake root environment
Versions of packages sbuild suggests:
ii deborphan 1.7.28 program that can find unused packa
ii wget 1.11.4-4 retrieves files from the web
-- no debconf information
-------------- next part --------------
>From eb4a1027c00a576f2ba681407d90b4c145530af5 Mon Sep 17 00:00:00 2001
From: Andres Mejia <mcitadel at gmail.com>
Date: Sun, 13 Sep 2009 23:27:00 -0400
Subject: [PATCH 1/2] Add utility subroutines that are used to check and download from a URL and parse dsc files.
---
lib/Sbuild/Utility.pm | 253 ++++++++++++++++++++++++++++++++++++++++++++++++-
1 files changed, 252 insertions(+), 1 deletions(-)
diff --git a/lib/Sbuild/Utility.pm b/lib/Sbuild/Utility.pm
index 52acec5..2ae95a7 100644
--- a/lib/Sbuild/Utility.pm
+++ b/lib/Sbuild/Utility.pm
@@ -39,6 +39,9 @@ use warnings;
use Sbuild::Conf;
use Sbuild::Chroot;
+use File::Temp qw(tempfile);
+use LWP::UserAgent; # Needed to grab content from the WWW.
+use Time::HiRes qw ( time ); # Needed for high resolution timers
sub get_dist ($);
sub setup ($$);
@@ -53,7 +56,7 @@ BEGIN {
@ISA = qw(Exporter);
- @EXPORT = qw(setup cleanup shutdown);
+ @EXPORT = qw(setup cleanup shutdown check_url download parse_file);
$SIG{'INT'} = \&shutdown;
$SIG{'TERM'} = \&shutdown;
@@ -132,4 +135,252 @@ sub shutdown ($) {
exit 1;
}
+# This method simply checks if a URL is valid.
+sub check_url {
+ my ($url) = @_;
+
+ # If $url is a readable plain file on the local system, just return true.
+ return 1 if (-f $url && -r $url);
+
+ # Setup the user agent.
+ my $ua = LWP::UserAgent->new;
+
+ # Determine if we need to specify any proxy settings.
+ $ua->env_proxy;
+ my $proxy = _get_proxy();
+ if ($proxy) {
+ $ua->proxy(['http', 'ftp'], $proxy);
+ }
+
+ # Dispatch a HEAD request, grab the response, and check the response for
+ # success.
+ my $res = $ua->head($url);
+ return 1 if ($res->is_success);
+
+ # URL wasn't valid.
+ return 0;
+}
+
+# This method is used to retrieve a file, usually from a location on the
+# Internet, but it can also be used for files in the local system.
+# $url is location of file, $file is path to write $url into.
+sub download {
+ # The parameters will be any URL and a location to save the file to.
+ my($url, $file) = @_;
+
+ # If $url is a readable plain file on the local system, just return the
+ # $url.
+ return $url if (-f $url && -r $url);
+
+ # Filehandle we'll be writing to.
+ my $fh;
+
+ # If $file isn't defined, a temporary file will be used instead.
+ ($fh, $file) = tempfile( UNLINK => 0 ) if (! $file);
+
+ # Setup the user agent.
+ my $ua = LWP::UserAgent->new;
+
+ # Determine if we need to specify any proxy settings.
+ $ua->env_proxy;
+ my $proxy = _get_proxy();
+ if ($proxy) {
+ $ua->proxy(['http', 'ftp'], $proxy);
+ }
+
+ # Download the file.
+ my $expected_length; # Total size we expect of content
+ my $bytes_received = 0; # Size of content as it is received
+ my $percent; # The percentage downloaded
+ my $tick; # Used for counting.
+ my $start_time = time; # Record of the start time
+ open($fh, '>', $file); # Destination file to download content to
+ my $response = $ua->get($url, ":content_cb" =>
+ sub {
+ my ($chunk, $response) = @_;
+
+ $bytes_received += length($chunk);
+ unless (defined $expected_length) {
+ $expected_length = $response->content_length or undef;
+ }
+ if ($expected_length) {
+ # Here we calculate the speed of the download to print out later
+ my $speed;
+ my $duration = time - $start_time;
+ if ($bytes_received/$duration >= 1024 * 1024) {
+ $speed = sprintf("%.3g MB",
+ ($bytes_received/$duration) / (1024.0 * 1024)) . "/s";
+ } elsif ($bytes_received/$duration >= 1024) {
+ $speed = sprintf("%.3g KB",
+ ($bytes_received/$duration) / 1024.0) . "/s";
+ } else {
+ $speed = $bytes_received/$duration . " bytes/s";
+ }
+ # Calculate the percentage downloaded
+ $percent = sprintf("%d",
+ 100 * $bytes_received / $expected_length);
+ $tick++; # Keep count
+ # Here we print out a progress of the download. We start by
+ # printing out the amount of data retrieved so far, and then
+ # show a progress bar. After 50 ticks, the percentage is printed
+ # and the speed of the download is printed. A new line is
+ # started and the process repeats until the download is
+ # complete.
+ if (($tick == 250) or ($percent == 100)) {
+ print STDERR ".]";
+ printf STDERR "%5s", "$percent%";
+ printf STDERR "%12s", "$speed\n";
+ $tick = 0;
+ } elsif ($tick == 1) {
+ printf STDERR "%8s", sprintf("%d",
+ $bytes_received / 1024) . "KB";
+ print STDERR " [.";
+ } elsif ($tick % 5 == 0) {
+ print STDERR ".";
+ }
+ }
+ # Write the contents of the download to our specified file
+ if ($response->is_success) {
+ print $fh $chunk; # Print content to file
+ } else {
+ # Print message upon failure during download
+ print STDERR "\n" . $response->status_line . "\n";
+ return 0;
+ }
+ }
+ ); # Our GET request
+ close $fh; # Close the destination file
+
+ # Print error message in case we couldn't get a response at all.
+ if (!$response->is_success) {
+ print $response->status_line . "\n";
+ return 0;
+ }
+
+ # At this point, the download should have been successful. Print a success
+ # message and return the location of the file.
+ print STDERR "Download of $url successful.\n";
+ print STDERR "Total size of content downloaded: " .
+ sprintf("%d", $bytes_received/1024) . "KB\n";
+ return $file;
+}
+
+# This method is used to determine the proxy settings used on the local system.
+# It will return the proxy URL if a proxy setting is found.
+sub _get_proxy {
+ my $proxy;
+
+ # Attempt to acquire a proxy URL from apt-config.
+ if (open(my $apt_config_output, '-|', '/usr/bin/apt-config dump')) {
+ foreach my $tmp (<$apt_config_output>) {
+ if ($tmp =~ m/^.*Acquire::http::Proxy\s+/) {
+ $proxy = $tmp;
+ chomp($proxy);
+ # Trim the line to only the proxy URL
+ $proxy =~ s/^.*Acquire::http::Proxy\s+"|";$//g;
+ return $proxy;
+ }
+ }
+ close $apt_config_output;
+ }
+
+ # Attempt to acquire a proxy URL from the user's or system's wgetrc
+ # configuration.
+ # First try the user's wgetrc
+ if (open(my $wgetrc, '<', "$ENV{'HOME'}/.wgetrc")) {
+ foreach my $tmp (<$wgetrc>) {
+ if ($tmp =~ m/^[^#]*http_proxy/) {
+ $proxy = $tmp;
+ chomp($proxy);
+ # Trim the line to only the proxy URL
+ $proxy =~ s/^.*http_proxy\s*=\s*|\s+$//g;
+ return $proxy;
+ }
+ }
+ close($wgetrc);
+ }
+ # Now try the system's wgetrc
+ if (open(my $wgetrc, '<', '/etc/wgetrc')) {
+ foreach my $tmp (<$wgetrc>) {
+ if ($tmp =~ m/^[^#]*http_proxy/) {
+ $proxy = $tmp;
+ chomp($proxy);
+ # Trim the line to only the proxy URL
+ $proxy =~ s/^.*http_proxy\s*=\s*|\s+$//g;
+ return $proxy;
+ }
+ }
+ close($wgetrc);
+ }
+
+ # At this point there should be no proxy settings. Return undefined.
+ return 0;
+}
+
+# Method to parse a rfc822 type file, like Debian changes or control files.
+# It can also be used on files like Packages or Sources files in a Debian
+# archive.
+# This subroutine returns an array of hashes. Each hash is a stanza.
+sub parse_file {
+ # Takes one parameter, the file to parse.
+ my ($file) = @_;
+
+ # Variable we'll be returning from this subroutine.
+ my @array_of_fields;
+
+ # All our regex used in this method
+ # Regex to split each field and it's contents
+ my $split_pattern = qr{
+ ^\b # Match the beginning of a line followed by the word boundary
+ # before a new field
+ }msx;
+ # Regex for detecting the beginning PGP block
+ my $beginning_pgp_block = qr{
+ ^\Q-----BEGIN PGP SIGNED MESSAGE-----\E
+ .*? # Any block starting with the text above followed by some other
+ # text
+ }msx;
+ # Regex for detecting the ending PGP block
+ my $ending_pgp_block = qr{
+ ^\Q-----BEGIN PGP SIGNATURE-----\E
+ .* # Any block starting with the text above followed by some other
+ # text
+ }msx;
+
+ # Enclose this in it's own block, since we change $/
+ {
+ # Attempt to open and read the file
+ my $fh;
+ open $fh, '<', $file or die "Could not read $file: $!";
+
+ # Read paragraph by paragraph
+ local $/ = "";
+ while (<$fh>) {
+ # Skip the beginning PGP block, stop at the ending PGP block
+ next if ($_ =~ $beginning_pgp_block);
+ last if ($_ =~ $ending_pgp_block);
+
+ # Chomp the paragraph and split by each field
+ chomp;
+ my @matches = split /$split_pattern/, "$_\n";
+
+ # Loop through the fields, placing them into a hash
+ my %fields;
+ foreach my $match (@matches) {
+ my ($field, $field_contents);
+ $field = $1 if ($match =~ /([^:]+?):/msx);
+ $field_contents = $1 if ($match =~ /[^:]+?:(.*)/msx);
+ $fields{$field} = $field_contents;
+ }
+
+ # Push each hash of fields as a ref onto our array
+ push @array_of_fields, \%fields;
+ }
+ close $fh or die "Problem encountered closing file $file: $!";
+ }
+
+ # Return a reference to the array
+ return \@array_of_fields;
+}
+
1;
--
1.6.3.3
-------------- next part --------------
>From 5abb0e4b351d8021b6ae339e1282aff1e0158aaa Mon Sep 17 00:00:00 2001
From: Andres Mejia <mcitadel at gmail.com>
Date: Sun, 13 Sep 2009 23:28:38 -0400
Subject: [PATCH 2/2] Implement support to detect and build from remote source files.
This also changed dsc_files to support reading dsc files downloaded from the
web.
---
lib/Sbuild/Build.pm | 76 +++++++++++++++++++++++++++++++++++++--------------
1 files changed, 55 insertions(+), 21 deletions(-)
diff --git a/lib/Sbuild/Build.pm b/lib/Sbuild/Build.pm
index 8fa5007..fc54295 100644
--- a/lib/Sbuild/Build.pm
+++ b/lib/Sbuild/Build.pm
@@ -32,6 +32,8 @@ use File::Basename qw(basename dirname);
use File::Temp qw(tempdir);
use FileHandle;
use GDBM_File;
+use File::Copy qw(); # copy is already exported from Sbuild, so don't export
+ # anything.
use Sbuild qw($devnull binNMU_version version_compare split_version copy isin send_mail debug df);
use Sbuild::Base;
@@ -42,6 +44,7 @@ use Sbuild::Sysconfig qw($version $release_date);
use Sbuild::Conf;
use Sbuild::LogBase qw($saved_stdout);
use Sbuild::Sysconfig;
+use Sbuild::Utility qw(check_url download parse_file);
BEGIN {
use Exporter ();
@@ -70,13 +73,14 @@ sub new {
# Do we need to download?
$self->set('Download', 0);
$self->set('Download', 1)
- if (!($self->get('DSC Base') =~ m/\.dsc$/));
+ if (!($self->get('DSC Base') =~ m/\.dsc$/) || # Use apt to download
+ check_url($self->get('DSC'))); # Valid URL
# Can sources be obtained?
$self->set('Invalid Source', 0);
$self->set('Invalid Source', 1)
- if ((!$self->get('Download') && ! -f $self->get('DSC')) ||
- ($self->get('Download') &&
+ if ((!$self->get('Download')) ||
+ (!($self->get('DSC Base') =~ m/\.dsc$/) && # Use apt to download
$self->get('DSC') ne $self->get('Package_OVersion')) ||
(!defined $self->get('Version')));
@@ -360,18 +364,48 @@ sub fetch_source_files {
return 0;
}
- if (-f "$dir/$dsc" && !$self->get('Download')) {
- $self->log_subsubsection("Local sources");
- $self->log("$dsc exists in $dir; copying to chroot\n");
- my @cwd_files = $self->dsc_files("$dir/$dsc");
- foreach (@cwd_files) {
- if (system ("cp '$_' '$build_dir'")) {
- $self->log_error("Could not copy $_ to $build_dir\n");
+ if ($self->get('DSC Base') =~ m/\.dsc$/) {
+ # Work with a .dsc file.
+ # $file is the name of the downloaded dsc file written in a tempfile.
+ my $file;
+ $file = download($self->get('DSC')) or
+ $self->log_error("Could not download " . $self->get('DSC')) and
+ return 0;
+ my @cwd_files = $self->dsc_files($file);
+ if (-f "$dir/$dsc") {
+ # Copy the local source files into the build directory.
+ $self->log_subsubsection("Local sources");
+ $self->log("$dsc exists in $dir; copying to chroot\n");
+ if (! File::Copy::copy("$dir/$dsc", "$build_dir")) {
+ $self->log_error("Could not copy $dir/$dsc to $build_dir\n");
+ return 0;
+ }
+ push(@fetched, "$build_dir/$dsc");
+ foreach (@cwd_files) {
+ if (! File::Copy::copy("$dir/$_", "$build_dir")) {
+ $self->log_error("Could not copy $dir/$_ to $build_dir\n");
+ return 0;
+ }
+ push(@fetched, "$build_dir/$_");
+ }
+ } else {
+ # Copy the remote source files into the build directory.
+ $self->log_subsubsection("Remote sources");
+ $self->log("Downloading source files from $dir.\n");
+ if (! File::Copy::copy("$file", "$build_dir/" . $self->get('DSC File'))) {
+ $self->log_error("Could not copy downloaded file $file to $build_dir\n");
return 0;
}
- push(@fetched, "$build_dir/" . basename($_));
+ push(@fetched, "$build_dir/" . $self->get('DSC File'));
+ foreach (@cwd_files) {
+ download("$dir/$_", "$build_dir/$_") or
+ $self->log_error("Could not download $dir/$_") and
+ return 0;
+ push(@fetched, "$build_dir/$_");
+ }
}
} else {
+ # Use apt to download the source files
$self->log_subsubsection("Check APT");
my %entries = ();
my $retried = $self->get_conf('APT_UPDATE'); # Already updated if set
@@ -2459,16 +2493,16 @@ sub dsc_files {
debug("Parsing $dsc\n");
- if (-r $dsc && open(DSC, $self->get_conf('DCMD') . " $dsc|")) {
- while (<DSC>) {
- chomp;
- push @files, $_;
- debug(" $_\n");
- }
- close( DSC ) or $self->log("Failed to close $dsc\n");
- } else {
- $self->log("Failed to open $dsc\n");
- }
+ # The parse_file() subroutine returns a ref to an array of hashrefs.
+ my $stanzas = parse_file($dsc);
+
+ # A dsc file would only ever contain one stanza, so we only deal with
+ # the first entry which is a ref to a hash of fields for the stanza.
+ my $stanza = @{$stanzas}[0];
+
+ # We're only interested in the name of the files in the Files field.
+ my $entry = ${$stanza}{'Files'};
+ @files = grep(/\.tar\.gz$|\.diff\.gz$/, split(/\s/, $entry));
return @files;
}
--
1.6.3.3
More information about the Buildd-tools-devel
mailing list