← Back to branch summary

~ubuntu-branches/ubuntu/precise/devscripts/precise

« back to all changes in this revision

Viewing changes to scripts/uscan.pl

  • Committer: Bazaar Package Importer
  • Author(s): Benjamin Drung
  • Date: 2011-05-22 19:49:16 UTC
  • mfrom: (10.9.4 sid) (10.7.8 squeeze)
  • Revision ID: james.westby@ubuntu.com-20110522194916-tmmamo4499eh1z0a
Tags: 2.10.73ubuntu1
https://launchpad.net/bugs/717389
https://launchpad.net/bugs/429288
https://launchpad.net/bugs/783693
* Merge from Debian unstable (LP: #717389); remaining changes:
  - Demote Recommends to Suggests:
    + libcrypt-ssleay-perl: only needed for a corner case (uscan on SSL
      download sites), wasn't installed by default in previous releases
      either, and seems quite dead upstream; universe only.
    + debian-{keyring,maintainers}: not useful enough in Ubuntu; universe
      only.
    + equivs: too much of a hack to install by default; universe only.
    + libyaml-syck-perl: transition-check is fairly Debian-specific.
  - scripts/debchange.{pl,1}:
    + Adjust --security template for Ubuntu.
    + Add -U/--upstream flag that forces original "just increment
      the end" behaviour; Ubuntu is upstream for some pieces of software.
    + Add --distributor= and DEBCHANGE_DISTRIBUTOR to override lsb_release
      output.
    + Default to "oneiric" as distribution.
    + Add "ubuntu1" to version string for new versions, with tweaks for
      special cases.
    + Add -R/--rebuild flag for Ubuntu's no-change rebuilds.
    + Don't use the last distribution in debian/changelog when doing
      "dch -r" on Ubuntu. "Just because it was last uploaded to jaunty
      doesn't mean that's the right thing to do now." Thanks to Colin
      Watson. (LP: #429288)
  - scripts/debsign.{sh,1}: Implement DEBSIGN_ALWAYS_RESIGN variable to skip
    the "Would you like to use the current signature?" question. (Debian
    #447955)
  - scripts/debuild.pl: Enforce Ubuntu merge policy.
  - scripts/dscverify.pl: Add Ubuntu keyrings.
  - scripts/rmadison.pl: Change default URL parameter to ubuntu.
  - Add test/debchange.pl, test/Makefile: debchange test suite.
  - Rename XS-Vcs-* to XS-Debian-Vcs-*.
* debchange: Use dpkg-vendor instead of lsb_release.
* debchange: Add DEBCHANGE_DISTRIBUTOR to array of config variables. Thanks
  to Adam Dorsey for the patch. (LP: #783693)

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/uscan.pl
611
611
# watch_version=2:
612
612
#
613
613
# For ftp sites:
614
 
#   ftp://site.name/dir/path/pattern-(.*)\.tar\.gz [version [action]]
 
614
#   ftp://site.name/dir/path/pattern-(.+)\.tar\.gz [version [action]]
615
615
#
616
616
# For http sites:
617
 
#   http://site.name/dir/path/pattern-(.*)\.tar\.gz [version [action]]
 
617
#   http://site.name/dir/path/pattern-(.+)\.tar\.gz [version [action]]
618
618
# or
619
 
#   http://site.name/dir/path/base pattern-(.*)\.tar\.gz [version [action]]
 
619
#   http://site.name/dir/path/base pattern-(.+)\.tar\.gz [version [action]]
620
620
#
621
621
# Lines can be prefixed with opts=<opts>.
622
622
#
627
627
# watch_version=3:
628
628
#
629
629
# Correct handling of regex special characters in the path part:
630
 
# ftp://ftp.worldforge.org/pub/worldforge/libs/Atlas-C++/transitional/Atlas-C\+\+-(.*)\.tar\.gz
 
630
# ftp://ftp.worldforge.org/pub/worldforge/libs/Atlas-C++/transitional/Atlas-C\+\+-(.+)\.tar\.gz
631
631
# 
632
632
# Directory pattern matching:
633
633
# ftp://ftp.nessus.org/pub/nessus/nessus-([\d\.]+)/src/nessus-core-([\d\.]+)\.tar\.gz
643
643
# only be performed on the basename version number, not any path version
644
644
# numbers.)
645
645
# opts=uversionmangle=s/^/0.0./ \
646
 
#   ftp://ftp.ibiblio.org/pub/Linux/ALPHA/wine/development/Wine-(.*)\.tar\.gz
 
646
#   ftp://ftp.ibiblio.org/pub/Linux/ALPHA/wine/development/Wine-(.+)\.tar\.gz
647
647
# 
648
648
# Similarly, the upstream part of the Debian version number can be
649
649
# mangled:
650
650
# opts=dversionmangle=s/\.dfsg\.\d+$// \
651
 
#   http://some.site.org/some/path/foobar-(.*)\.tar\.gz
 
651
#   http://some.site.org/some/path/foobar-(.+)\.tar\.gz
652
652
# 
653
653
# The versionmangle=... option is a shorthand for saying uversionmangle=...
654
654
# and dversionmangle=... and applies to both upstream and Debian versions.
658
658
#   href="http://foo.bar.org/download/?path=&amp;download=foo-0.1.1.tar.gz"
659
659
# could be handled as:
660
660
# opts=filenamemangle=s/.*=(.*)/$1/ \
661
 
#     http://foo.bar.org/download/\?path=&amp;download=foo-(.*)\.tar\.gz
 
661
#     http://foo.bar.org/download/\?path=&amp;download=foo-(.+)\.tar\.gz
662
662
# and
663
663
#   href="http://foo.bar.org/download/?path=&amp;download_version=0.1.1"
664
664
# as:
665
665
# opts=filenamemangle=s/.*=(.*)/foo-$1\.tar\.gz/ \
666
 
#    http://foo.bar.org/download/\?path=&amp;download_version=(.*)
 
666
#    http://foo.bar.org/download/\?path=&amp;download_version=(.+)
667
667
# 
668
668
# The option downloadurlmangle can be used to mangle the URL of the file
669
669
# to download.  This can only be used with http:// URLs.  This may be
671
671
# some way into one which will work automatically, for example:
672
672
# opts=downloadurlmangle=s/prdownload/download/ \
673
673
#   http://developer.berlios.de/project/showfiles.php?group_id=2051 \
674
 
#   http://prdownload.berlios.de/softdevice/vdr-softdevice-(.*).tgz
 
674
#   http://prdownload.berlios.de/softdevice/vdr-softdevice-(.+).tgz
675
675
 
676
676
 
677
677
sub process_watchline ($$$$$$)
696
696
    %dehs_tags = ('package' => $pkg);
697
697
 
698
698
    if ($watch_version == 1) {
699
 
        ($site, $dir, $pattern, $lastversion, $action) = split ' ', $line, 5;
 
699
        ($site, $dir, $filepattern, $lastversion, $action) = split ' ', $line, 5;
700
700
 
701
701
        if (! defined $lastversion or $site =~ /\(.*\)/ or $dir =~ /\(.*\)/) {
702
702
            warn "$progname warning: there appears to be a version 2 format line in\n  the version 1 watchfile $watchfile;\n  Have you forgotten a 'version=2' line at the start, perhaps?\n  Skipping the line: $line\n";
704
704
        }
705
705
        if ($site !~ m%\w+://%) {
706
706
            $site = "ftp://$site";
707
 
            if ($pattern !~ /\(.*\)/) {
 
707
            if ($filepattern !~ /\(.*\)/) {
708
708
                # watch_version=1 and old style watchfile;
709
709
                # pattern uses ? and * shell wildcards; everything from the
710
710
                # first to last of these metachars is the pattern to match on
711
 
                $pattern =~ s/(\?|\*)/($1/;
712
 
                $pattern =~ s/(\?|\*)([^\?\*]*)$/$1)$2/;
713
 
                $pattern =~ s/\./\\./g;
714
 
                $pattern =~ s/\?/./g;
715
 
                $pattern =~ s/\*/.*/g;
 
711
                $filepattern =~ s/(\?|\*)/($1/;
 
712
                $filepattern =~ s/(\?|\*)([^\?\*]*)$/$1)$2/;
 
713
                $filepattern =~ s/\./\\./g;
 
714
                $filepattern =~ s/\?/./g;
 
715
                $filepattern =~ s/\*/.*/g;
716
716
                $style='old';
717
717
                warn "$progname warning: Using very old style of filename pattern in $watchfile\n  (this might lead to incorrect results): $3\n";
718
718
            }
723
723
        $base =~ s%(?<!:)//%/%g;
724
724
        $base =~ m%^(\w+://[^/]+)%;
725
725
        $site = $1;
 
726
        $pattern = $filepattern;
726
727
    } else {
727
728
        # version 2/3 watchfile
728
729
        if ($line =~ s/^opt(?:ion)?s=//) {
1025
1026
        } else {
1026
1027
            # they all look like:
1027
1028
            # info info ... info filename [ -> linkname]
1028
 
            while ($content =~ m/\s($filepattern)(\s+->\s+\S+)?$/mg) {
1029
 
                my $file = $1;
1030
 
                my $mangled_version = join(".", $file =~ m/^$filepattern$/);
1031
 
                foreach my $pat (@{$options{'uversionmangle'}}) {
1032
 
                    if (! safe_replace(\$mangled_version, $pat)) {
1033
 
                        warn "$progname: In $watchfile, potentially"
1034
 
                          . " unsafe or malformed uversionmangle"
1035
 
                          . " pattern:\n  '$pat'"
1036
 
                          . " found. Skipping watchline\n"
1037
 
                          . "  $line\n";
1038
 
                        return 1;
 
1029
            for my $ln (split(/\n/, $content)) {
 
1030
                if ($ln =~ m/\s($filepattern)(\s+->\s+\S+)?$/) {
 
1031
                    my $file = $1;
 
1032
                    my $mangled_version = join(".", $file =~ m/^$filepattern$/);
 
1033
                    foreach my $pat (@{$options{'uversionmangle'}}) {
 
1034
                        if (! safe_replace(\$mangled_version, $pat)) {
 
1035
                            warn "$progname: In $watchfile, potentially"
 
1036
                              . " unsafe or malformed uversionmangle"
 
1037
                              . " pattern:\n  '$pat'"
 
1038
                              . " found. Skipping watchline\n"
 
1039
                              . "  $line\n";
 
1040
                            return 1;
 
1041
                        }
1039
1042
                    }
 
1043
                    push @files, [$mangled_version, $file];
1040
1044
                }
1041
 
                push @files, [$mangled_version, $file];
1042
1045
            }
1043
 
        }           
 
1046
        }
1044
1047
 
1045
1048
        if (@files) {
1046
1049
            if ($verbose) {
1346
1349
    if ($repack and $newfile_base =~ /^(.*)\.(tar\.lzma|tlz(?:ma?)?)$/) {
1347
1350
        print "-- Repacking from lzma to gzip\n" if $verbose;
1348
1351
        my $newfile_base_gz = "$1.tar.gz";
1349
 
        system("lzma -cd $destdir/$newfile_base | gzip -n -9 > $destdir/$newfile_base_gz") == 0
 
1352
        system("xz -F lzma -cd $destdir/$newfile_base | gzip -n -9 > $destdir/$newfile_base_gz") == 0
1350
1353
          or die "repacking from lzma to gzip failed\n";
1351
1354
        unlink "$destdir/$newfile_base";
1352
1355
        $newfile_base = $newfile_base_gz;
1369
1372
 
1370
1373
        my $newfile_base_gz = "$1.tar.gz";
1371
1374
        my $tempdir = tempdir ( "uscanXXXX", TMPDIR => 1, CLEANUP => 1 );
1372
 
        system("unzip -q -d $tempdir $destdir/$newfile_base; GZIP=-9 tar -C $tempdir -czf $destdir/$newfile_base_gz .") == 0 
1373
 
          or die("Repacking from zip to tar.gz failed\n");
 
1375
        my $globpattern = "*";
 
1376
        my $hidden = ".[!.]*";
 
1377
        system("unzip -q -a -d $tempdir $destdir/$newfile_base") == 0
 
1378
          or die("Repacking from zip to tar.gz failed (could not unzip)\n");
 
1379
        if (defined glob("$tempdir/$hidden")) {
 
1380
            $globpattern .= " $hidden";
 
1381
        }
 
1382
        system("cd $tempdir; GZIP=-9 tar --owner=root --group=root --mode=a+rX -czf $destdir/$newfile_base_gz $globpattern") == 0
 
1383
          or die("Repacking from zip to tar.gz failed (could not create tarball)\n");
1374
1384
        unlink "$destdir/$newfile_base";
1375
1385
        $newfile_base = $newfile_base_gz;
1376
1386
    }
1377
1387
 
1378
1388
    if ($newfile_base =~ /\.(tar\.gz|tgz|tar\.bz2|tbz2?)$/) {
1379
 
        my $filetype = `file $destdir/$newfile_base`;
1380
 
        $filetype =~ s%^\.\./\Q$newfile_base\E: %%;
 
1389
        my $filetype = `file -b -k $destdir/$newfile_base`;
1381
1390
        unless ($filetype =~ /compressed data/) {
1382
1391
            warn "$progname warning: $destdir/$newfile_base does not appear to be a compressed file;\nthe file command says: $filetype\nNot processing this file any further!\n";
1383
1392
            return 1;
1418
1427
    } elsif ($dehs) {
1419
1428
        my $msg = "Successfully downloaded updated package $newfile_base";
1420
1429
        if ($newfile_base =~ /\.(tar\.gz|tgz)$/) {
 
1430
            $dehs_tags{'target'} = "${pkg}_${newversion}.orig.tar.gz";
1421
1431
            if ($symlink eq 'symlink') {
1422
1432
                $msg .= " and symlinked ${pkg}_${newversion}.orig.tar.gz to it";
1423
1433
            } elsif ($symlink eq 'rename') {
1424
1434
                $msg .= " and renamed it as ${pkg}_${newversion}.orig.tar.gz";
 
1435
            } else {
 
1436
                $dehs_tags{'target'} = $newfile_base;
1425
1437
            }
1426
1438
        }
1427
1439
        elsif ($newfile_base =~ /\.(tar\.bz2|tbz2?)$/) {
 
1440
            $dehs_tags{'target'} = "${pkg}_${newversion}.orig.tar.bz2";
1428
1441
            if ($symlink eq 'symlink') {
1429
1442
                $msg .= " and symlinked ${pkg}_${newversion}.orig.tar.bz2 to it";
1430
1443
            } elsif ($symlink eq 'rename') {
1431
1444
                $msg .= " and renamed it as ${pkg}_${newversion}.orig.tar.bz2";
 
1445
            } else {
 
1446
                $dehs_tags{'target'} = $newfile_base;
1432
1447
            }
1433
1448
        }
1434
1449
        dehs_msg($msg);
1493
1508
 
1494
1509
    $base =~ m%^(\w+://[^/]+)/(.*)$%;
1495
1510
    my $site = $1;
1496
 
    my @dirs = split /(\/)/, $2;
 
1511
    my @dirs = ();
 
1512
    if (defined $2) {
 
1513
        @dirs = split /(\/)/, $2;
 
1514
    }
1497
1515
    my $dir = '/';
1498
1516
 
1499
1517
    foreach my $dirpattern (@dirs) {
1618
1636
        } else {
1619
1637
            # they all look like:
1620
1638
            # info info ... info filename [ -> linkname]
1621
 
            while ($content =~ m/($pattern)(\s+->\s+\S+)?$/mg) {
1622
 
                my $dir = $1;
1623
 
                my $mangled_version = join(".", $dir =~ m/^$pattern$/);
1624
 
                push @dirs, [$mangled_version, $dir];
 
1639
            foreach my $ln (split(/\n/, $content)) {
 
1640
                if ($ln =~ m/($pattern)(\s+->\s+\S+)?$/) {
 
1641
                    my $dir = $1;
 
1642
                    my $mangled_version = join(".", $dir =~ m/^$pattern$/);
 
1643
                    push @dirs, [$mangled_version, $dir];
 
1644
                }
1625
1645
            }
1626
 
        }           
 
1646
        }
1627
1647
        if (@dirs) {
1628
1648
            if ($debug) {
1629
1649
                print STDERR "-- Found the following matching dirs:\n";
1745
1765
 
1746
1766
    for my $tag (qw(package debian-uversion debian-mangled-uversion
1747
1767
                    upstream-version upstream-url
1748
 
                    status messages warnings errors)) {
 
1768
                    status target messages warnings errors)) {
1749
1769
        if (exists $dehs_tags{$tag}) {
1750
1770
            if (ref $dehs_tags{$tag} eq "ARRAY") {
1751
1771
                foreach my $entry (@{$dehs_tags{$tag}}) {