mirror of
https://git.launchpad.net/ubuntu-dev-tools
synced 2025-03-12 15:41:09 +00:00
184 lines
4.8 KiB
Perl
Executable File
184 lines
4.8 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# Copyright 2007-2008 Kees Cook <kees@ubuntu.com>
|
|
#
|
|
# ##################################################################
|
|
#
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU General Public License
|
|
# as published by the Free Software Foundation; either version 3
|
|
# of the License, or (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# See file /usr/share/common-licenses/GPL for more details.
|
|
#
|
|
# ##################################################################
|
|
#
|
|
# This script attempts to find and download a specific version of a Debian
|
|
# package and its immediate parent to generate a debdiff.
|
|
#
|
|
# Requirements: devscripts diffstat dpkg-dev
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
sub geturls
|
|
{
|
|
my ($urlbase,$pkg,$version)=@_;
|
|
my $file;
|
|
|
|
$file = "${pkg}_${version}.dsc";
|
|
print "Want '$file'\n";
|
|
if (! -r "$file") {
|
|
warn "Trying $urlbase/$file ...\n";
|
|
system("wget $urlbase/$file");
|
|
return 0 if ($? != 0);
|
|
}
|
|
|
|
# Parse the .dsc file for list of required files...
|
|
my @needed;
|
|
open(DSC,"$file") || return 0;
|
|
while (my $line=<DSC>) {
|
|
if ($line =~ /^Files:/) {
|
|
while (my $file=<DSC>) {
|
|
chomp($file);
|
|
last if ($file !~ /^ /);
|
|
my @parts = split(/\s+/,$file);
|
|
my $want = pop(@parts);
|
|
print "Want '$want'\n";
|
|
push(@needed,$want);
|
|
}
|
|
}
|
|
}
|
|
close(DSC);
|
|
|
|
foreach my $file (@needed) {
|
|
if (! -r "$file") {
|
|
warn "Pulling $urlbase/$file ...\n";
|
|
system("wget $urlbase/$file");
|
|
return 0 if ($? != 0);
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub generate_base
|
|
{
|
|
my ($pkg)=@_;
|
|
|
|
my @path;
|
|
push(@path,"main");
|
|
if ($pkg =~ /^(lib.)/) {
|
|
push(@path,$1);
|
|
}
|
|
else {
|
|
push(@path,substr($pkg,0,1));
|
|
}
|
|
push(@path,$pkg);
|
|
return join("/",@path);
|
|
}
|
|
|
|
sub download_source
|
|
{
|
|
my ($pkg,$version)=@_;
|
|
my $urlbase;
|
|
|
|
my $base = generate_base($pkg);
|
|
|
|
# Attempt to pull from security updates first
|
|
$urlbase = "http://security.debian.org/pool/updates/$base";
|
|
|
|
if (!geturls($urlbase,$pkg,$version)) {
|
|
# Try regular pool
|
|
|
|
$urlbase = "http://ftp.debian.org/debian/pool/$base";
|
|
if (!geturls($urlbase,$pkg,$version)) {
|
|
# Try snapshot
|
|
|
|
$urlbase="http://snapshot.debian.net/package/$pkg/$version";
|
|
warn "Fetching snapshot url via '$urlbase' ...\n";
|
|
$urlbase=`curl -sI 'http://snapshot.debian.net/package/$pkg/$version' | grep ^[lL]ocation | cut -d' ' -f2 | head -1`;
|
|
$urlbase =~ s/[\r\n]//g;
|
|
warn "Trying snapshot location '$urlbase' ...\n";
|
|
|
|
if ($urlbase ne "" && !geturls($urlbase,$pkg,$version)) {
|
|
return 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
|
|
|
|
my $pkg = $ARGV[0];
|
|
my $version = $ARGV[1];
|
|
my $just_fetch = ($ARGV[2] && $ARGV[2] eq "--fetch");
|
|
my $skip = $ARGV[2] || 1;
|
|
$skip+=0;
|
|
|
|
if (!defined($pkg) || !defined($version)) {
|
|
die "Usage: $0 PKG VERSION\n";
|
|
}
|
|
|
|
|
|
# Extract latest source
|
|
die "Cannot locate $pkg $version\n" unless download_source($pkg,$version);
|
|
exit(0) if ($just_fetch);
|
|
system("dpkg-source -x ${pkg}_${version}.dsc");
|
|
die "Unpack of $pkg $version failed\n" unless ($? == 0);
|
|
|
|
# Locate prior changelog entry
|
|
my $prev_ver;
|
|
my $upstream_version = $version;
|
|
if ($upstream_version =~ /^([^-]+)-/) {
|
|
$upstream_version = $1;
|
|
}
|
|
my $srcdir="$pkg-$upstream_version";
|
|
if (! -d "$srcdir") {
|
|
undef $srcdir;
|
|
my $dir;
|
|
opendir(DIR,".");
|
|
while ($dir = readdir(DIR)) {
|
|
if ($dir =~ /^${pkg}-/ && -d $dir) {
|
|
$srcdir = $dir;
|
|
last;
|
|
}
|
|
}
|
|
closedir(DIR);
|
|
}
|
|
die "Cannot locate source tree\n" if (!defined($srcdir));
|
|
my $log = "$srcdir/debian/changelog";
|
|
open(LOG,"<$log") || die "$log: $!\n";
|
|
while (my $line=<LOG>) {
|
|
if ($line =~ /^$pkg \((?:\d+:)?([^\)]+)\)/) {
|
|
my $seen = $1;
|
|
if ($seen ne $version) {
|
|
$skip--;
|
|
|
|
if ($skip==0) {
|
|
$prev_ver=$seen;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
close(LOG);
|
|
die "Cannot find earlier source version\n" if (!defined($prev_ver));
|
|
|
|
die "Cannot locate $pkg $prev_ver\n" unless download_source($pkg,$prev_ver);
|
|
#system("dpkg-source -x ${pkg}_${prev_ver}.dsc");
|
|
#die "Unpack of $pkg $prev_ver failed\n" unless ($? == 0);
|
|
|
|
system("debdiff ${pkg}_${prev_ver}.dsc ${pkg}_${version}.dsc > ${pkg}_${version}.debdiff");
|
|
die "Cannot debdiff\n" unless ($? == 0);
|
|
|
|
system("diffstat -p0 ${pkg}_${version}.debdiff");
|
|
print "${pkg}_${version}.debdiff\n";
|