You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
369 lines
8.9 KiB
369 lines
8.9 KiB
3 months ago
|
#!/usr/bin/perl
|
||
|
|
# A simple system for making software releases
|
||
|
|
# (c) 2003--2012 Martin Mares <mj@ucw.cz>
|
||
|
|
|
||
|
|
package UCW::Release;
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use Getopt::Long;
|
||
|
|
|
||
|
|
our $verbose = 0;
|
||
|
|
|
||
|
|
sub new($$) {
|
||
|
|
my ($class,$basename) = @_;
|
||
|
|
my $s = {
|
||
|
|
"PACKAGE" => $basename,
|
||
|
|
"rules" => [
|
||
|
|
# p=preprocess, s=subst, -=discard
|
||
|
|
'(^|/)(CVS|\.arch-ids|{arch}|\.git|tmp)/' => '-',
|
||
|
|
'\.(lsm|spec)$' => 'ps',
|
||
|
|
'(^|/)README$' => 's'
|
||
|
|
],
|
||
|
|
"conditions" => {
|
||
|
|
# Symbols, which can serve as conditions for the preprocessor
|
||
|
|
},
|
||
|
|
"DATE" => `date '+%Y-%m-%d' | tr -d '\n'`,
|
||
|
|
"LSMDATE" => `date '+%y%m%d' | tr -d '\n'`,
|
||
|
|
"distfiles" => [
|
||
|
|
# Files to be uploaded
|
||
|
|
],
|
||
|
|
"uploads" => [
|
||
|
|
# Locations where we want to upload, e.g.:
|
||
|
|
# { "url" => "ftp://metalab.unc.edu/incoming/linux/",
|
||
|
|
# "filter" => '(\.tar\.gz|\.lsm)$', }
|
||
|
|
],
|
||
|
|
"test_compile" => "make",
|
||
|
|
# "archive_dir" => "/tmp/archives/$basename",
|
||
|
|
# Options
|
||
|
|
"do_test" => 1,
|
||
|
|
"do_patch" => 0,
|
||
|
|
"diff_against" => "",
|
||
|
|
"do_upload" => 1,
|
||
|
|
"do_sign" => 1,
|
||
|
|
};
|
||
|
|
bless $s;
|
||
|
|
return $s;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub Confirm($) {
|
||
|
|
my ($s) = @_;
|
||
|
|
print "<confirm> "; <STDIN>;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub GetVersionFromGit($) {
|
||
|
|
my ($s) = @_;
|
||
|
|
return if defined $s->{"VERSION"};
|
||
|
|
my $desc = `git describe --tags`; die "git describe failed\n" if $?;
|
||
|
|
chomp $desc;
|
||
|
|
my ($ver, $rest) = ($desc =~ /^v([0-9.]+)(.*)/) or die "Failed to understand output of git describe: $desc\n";
|
||
|
|
print "Detected version $ver from git description $desc\n";
|
||
|
|
if ($rest ne '') {
|
||
|
|
print "WARNING: We are several commits past release tag... ";
|
||
|
|
$s->Confirm;
|
||
|
|
}
|
||
|
|
$s->{"VERSION"} = $ver;
|
||
|
|
return $ver;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub GetVersionFromFile($) {
|
||
|
|
my ($s,$file,$rx) = @_;
|
||
|
|
return if defined $s->{"VERSION"};
|
||
|
|
open F, $file or die "Unable to open $file for version autodetection";
|
||
|
|
while (<F>) {
|
||
|
|
chomp;
|
||
|
|
if (/$rx/) {
|
||
|
|
$s->{"VERSION"} = $1;
|
||
|
|
print "Detected version $1 from $file\n" if $verbose;
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
close F;
|
||
|
|
if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
|
||
|
|
return $s->{"VERSION"};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub GetVersionsFromChangelog($) {
|
||
|
|
my ($s,$file,$rx) = @_;
|
||
|
|
return if defined $s->{"VERSION"};
|
||
|
|
open F, $file or die "Unable to open $file for version autodetection";
|
||
|
|
while (<F>) {
|
||
|
|
chomp;
|
||
|
|
if (/$rx/) {
|
||
|
|
if (!defined $s->{"VERSION"}) {
|
||
|
|
$s->{"VERSION"} = $1;
|
||
|
|
print "Detected version $1 from $file\n" if $verbose;
|
||
|
|
} elsif ($s->{"VERSION"} eq $1) {
|
||
|
|
# do nothing
|
||
|
|
} else {
|
||
|
|
$s->{"OLDVERSION"} = $1;
|
||
|
|
print "Detected previous version $1 from $file\n" if $verbose;
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
close F;
|
||
|
|
if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
|
||
|
|
return $s->{"VERSION"};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub InitDist($) {
|
||
|
|
my ($s,$dd) = @_;
|
||
|
|
$s->{"DISTDIR"} = $dd;
|
||
|
|
print "Initializing dist directory $dd\n" if $verbose;
|
||
|
|
`rm -rf $dd`; die if $?;
|
||
|
|
`mkdir -p $dd`; die if $?;
|
||
|
|
|
||
|
|
if ($s->{"archive_dir"}) {
|
||
|
|
unshift @{$s->{"uploads"}}, { "url" => "file:" . $s->{"archive_dir"} };
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub ExpandVar($$) {
|
||
|
|
my ($s,$v) = @_;
|
||
|
|
if (defined $s->{$v}) {
|
||
|
|
return $s->{$v};
|
||
|
|
} else {
|
||
|
|
die "Reference to unknown variable $v";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub TransformFile($$$) {
|
||
|
|
my ($s,$file,$action) = @_;
|
||
|
|
|
||
|
|
my $preprocess = ($action =~ /p/);
|
||
|
|
my $subst = ($action =~ /s/);
|
||
|
|
my $dest = "$file.dist";
|
||
|
|
open I, "<", $file or die "open($file): $?";
|
||
|
|
open O, ">", "$dest" or die "open($dest): $!";
|
||
|
|
my @ifs = (); # stack of conditions, 1=satisfied
|
||
|
|
my $empty = 0; # last line was empty
|
||
|
|
my $is_makefile = ($file =~ /(Makefile|.mk)$/);
|
||
|
|
while (<I>) {
|
||
|
|
if ($subst) {
|
||
|
|
s/@([0-9A-Za-z_]+)@/$s->ExpandVar($1)/ge;
|
||
|
|
}
|
||
|
|
if ($preprocess) {
|
||
|
|
if (/^#/ || $is_makefile) {
|
||
|
|
if (/^#?ifdef\s+(\w+)/) {
|
||
|
|
if (defined ${$s->{"conditions"}}{$1}) {
|
||
|
|
push @ifs, ${$s->{"conditions"}}{$1};
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
push @ifs, 0;
|
||
|
|
} elsif (/^#ifndef\s+(\w+)/) {
|
||
|
|
if (defined ${$s->{"conditions"}}{$1}) {
|
||
|
|
push @ifs, -${$s->{"conditions"}}{$1};
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
push @ifs, 0;
|
||
|
|
} elsif (/^#if\s+/) {
|
||
|
|
push @ifs, 0;
|
||
|
|
} elsif (/^#?endif/) {
|
||
|
|
my $x = pop @ifs;
|
||
|
|
defined $x or die "Improper nesting of conditionals";
|
||
|
|
$x && next;
|
||
|
|
} elsif (/^#?else/) {
|
||
|
|
my $x = pop @ifs;
|
||
|
|
defined $x or die "Improper nesting of conditionals";
|
||
|
|
push @ifs, -$x;
|
||
|
|
$x && next;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@ifs && $ifs[$#ifs] < 0 && next;
|
||
|
|
if (/^$/) {
|
||
|
|
$empty && next;
|
||
|
|
$empty = 1;
|
||
|
|
} else { $empty = 0; }
|
||
|
|
}
|
||
|
|
print O;
|
||
|
|
}
|
||
|
|
close O;
|
||
|
|
close I;
|
||
|
|
! -x $file or chmod(0755, "$dest") or die "chmod($dest): $!";
|
||
|
|
rename $dest, $file or "rename($dest,$file): $!";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub GenPackage($) {
|
||
|
|
my ($s) = @_;
|
||
|
|
$s->{"PKG"} = $s->{"PACKAGE"} . "-" . $s->{"VERSION"};
|
||
|
|
my $dd = $s->{"DISTDIR"};
|
||
|
|
my $pkg = $s->{"PKG"};
|
||
|
|
my $dir = "$dd/$pkg";
|
||
|
|
print "Generating $dir\n";
|
||
|
|
|
||
|
|
system "git archive --format=tar --prefix=$dir/ HEAD | tar xf -";
|
||
|
|
die if $?;
|
||
|
|
|
||
|
|
my @files = `cd $dir && find . -type f`;
|
||
|
|
die if $?;
|
||
|
|
|
||
|
|
for my $f (@files) {
|
||
|
|
chomp $f;
|
||
|
|
$f =~ s/^\.\///;
|
||
|
|
my $action = "";
|
||
|
|
my @rules = @{$s->{"rules"}};
|
||
|
|
while (@rules) {
|
||
|
|
my $rule = shift @rules;
|
||
|
|
my $act = shift @rules;
|
||
|
|
if ($f =~ $rule) {
|
||
|
|
$action = $act;
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($action eq '') {
|
||
|
|
} elsif ($action =~ /-/) {
|
||
|
|
unlink "$dir/$f" or die "Cannot unlink $dir/$f: $!\n";
|
||
|
|
print "$f (unlinked)\n" if $verbose;
|
||
|
|
} else {
|
||
|
|
print "$f ($action)\n" if $verbose;
|
||
|
|
$s->TransformFile("$dir/$f", $action);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return $dir;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub GenFile($$) {
|
||
|
|
my ($s,$f) = @_;
|
||
|
|
my $sf = $s->{"DISTDIR"} . "/" . $s->{"PKG"} . "/$f";
|
||
|
|
my $df = $s->{"DISTDIR"} . "/$f";
|
||
|
|
print "Generating $df\n";
|
||
|
|
`cp $sf $df`; die if $?;
|
||
|
|
push @{$s->{"distfiles"}}, $df;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub SignFile($$) {
|
||
|
|
my ($s, $file) = @_;
|
||
|
|
$s->{'do_sign'} or return;
|
||
|
|
print "Signing $file\n";
|
||
|
|
system "gpg", "--armor", "--detach-sig", "$file";
|
||
|
|
die if $?;
|
||
|
|
rename "$file.asc", "$file.sign" or die "No signature produced!?\n";
|
||
|
|
push @{$s->{"distfiles"}}, "$file.sign";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub MakeArchive($) {
|
||
|
|
my ($s) = @_;
|
||
|
|
my $dd = $s->{"DISTDIR"};
|
||
|
|
my $pkg = $s->{"PKG"};
|
||
|
|
|
||
|
|
print "Creating $dd/$pkg.tar\n";
|
||
|
|
my $tarvv = $verbose ? "vv" : "";
|
||
|
|
`cd $dd && tar c${tarvv}f $pkg.tar $pkg >&2`; die if $?;
|
||
|
|
|
||
|
|
print "Creating $dd/$pkg.tar.gz\n";
|
||
|
|
`gzip <$dd/$pkg.tar >$dd/$pkg.tar.gz`; die if $?;
|
||
|
|
push @{$s->{"distfiles"}}, "$dd/$pkg.tar.gz";
|
||
|
|
|
||
|
|
# print "Creating $dd/$pkg.tar.bz2\n";
|
||
|
|
# `bzip2 <$dd/$pkg.tar >$dd/$pkg.tar.bz2`; die if $?;
|
||
|
|
# push @{$s->{"distfiles"}}, "$dd/$pkg.tar.bz2";
|
||
|
|
|
||
|
|
$s->SignFile("$dd/$pkg.tar");
|
||
|
|
}
|
||
|
|
|
||
|
|
sub ParseOptions($) {
|
||
|
|
my ($s) = @_;
|
||
|
|
GetOptions(
|
||
|
|
"verbose!" => \$verbose,
|
||
|
|
"test!" => \$s->{"do_test"},
|
||
|
|
"patch!" => \$s->{"do_patch"},
|
||
|
|
"diff-against=s" => \$s->{"diff_against"},
|
||
|
|
"version=s" => \$s->{"VERSION"},
|
||
|
|
"upload!" => \$s->{"do_upload"},
|
||
|
|
"sign!" => \$s->{"do_sign"},
|
||
|
|
) || die "Syntax: release [--verbose] [--test] [--nopatch] [--version=<version>] [--diff-against=<version>] [--noupload] [--nosign]";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub Test($) {
|
||
|
|
my ($s) = @_;
|
||
|
|
$s->{"do_test"} or return;
|
||
|
|
my $dd = $s->{"DISTDIR"};
|
||
|
|
my $pkg = $s->{"PKG"};
|
||
|
|
my $tdir = "$dd/$pkg.test";
|
||
|
|
$s->{"TESTDIR"} = $tdir;
|
||
|
|
`cp -a $dd/$pkg $tdir`; die if $?;
|
||
|
|
my $log = "$tdir.log";
|
||
|
|
print "Doing a test compilation\n";
|
||
|
|
my $make = $s->{"test_compile"};
|
||
|
|
`( cd $tdir && $make ) >$log 2>&1`;
|
||
|
|
die "There were errors. Please inspect $log" if $?;
|
||
|
|
`grep -q [Ww]arning $log`;
|
||
|
|
$? or print "There were warnings! Please inspect $log.\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub MakePatch($) {
|
||
|
|
my ($s) = @_;
|
||
|
|
$s->{"do_patch"} or return;
|
||
|
|
my $dd = $s->{"DISTDIR"};
|
||
|
|
my $pkg1 = $s->{"PKG"};
|
||
|
|
my $oldver;
|
||
|
|
if ($s->{"diff_against"} ne "") {
|
||
|
|
$oldver = $s->{"diff_against"};
|
||
|
|
} elsif (defined $s->{"OLDVERSION"}) {
|
||
|
|
$oldver = $s->{"OLDVERSION"};
|
||
|
|
} else {
|
||
|
|
print "WARNING: No previous version known. No patch generated.\n";
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
my $pkg0 = $s->{"PACKAGE"} . "-" . $oldver;
|
||
|
|
|
||
|
|
my $oldarch = $s->{"archivedir"} . "/" . $pkg0 . ".tar.gz";
|
||
|
|
-f $oldarch or die "MakePatch: $oldarch not found";
|
||
|
|
print "Unpacking $pkg0 from $oldarch\n";
|
||
|
|
`cd $dd && tar xzf $oldarch`; die if $?;
|
||
|
|
|
||
|
|
my $diff = $s->{"PACKAGE"} . "-" . $oldver . "-" . $s->{"VERSION"} . ".diff.gz";
|
||
|
|
print "Creating a patch from $pkg0 to $pkg1: $diff\n";
|
||
|
|
`cd $dd && diff -ruN $pkg0 $pkg1 | gzip >$diff`; die if $?;
|
||
|
|
push @{$s->{"distfiles"}}, "$dd/$diff";
|
||
|
|
$s->SignFile("$dd/$diff");
|
||
|
|
}
|
||
|
|
|
||
|
|
sub Upload($) {
|
||
|
|
my ($s) = @_;
|
||
|
|
$s->{"do_upload"} or return;
|
||
|
|
foreach my $u (@{$s->{"uploads"}}) {
|
||
|
|
my $url = $u->{"url"};
|
||
|
|
print "Upload to $url :\n";
|
||
|
|
my @files = ();
|
||
|
|
my $filter = $u->{"filter"} || ".*";
|
||
|
|
foreach my $f (@{$s->{"distfiles"}}) {
|
||
|
|
if ($f =~ $filter) {
|
||
|
|
print "\t$f\n";
|
||
|
|
push @files, $f;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$s->Confirm;
|
||
|
|
if ($url =~ m@^file:(.*)@) {
|
||
|
|
my $dir = $1;
|
||
|
|
$dir =~ s@^///@/@;
|
||
|
|
`cp @files $dir/`; die if $?;
|
||
|
|
} elsif ($url =~ m@^scp://([^/]+)(.*)@) {
|
||
|
|
$, = " ";
|
||
|
|
my $host = $1;
|
||
|
|
my $dir = $2;
|
||
|
|
$dir =~ s@^/~@~@;
|
||
|
|
$dir =~ s@^/\./@@;
|
||
|
|
my $cmd = "scp @files $host:$dir\n";
|
||
|
|
`$cmd`; die if $?;
|
||
|
|
} elsif ($url =~ m@ftp://([^/]+)(.*)@) {
|
||
|
|
my $host = $1;
|
||
|
|
my $dir = $2;
|
||
|
|
open FTP, "|ftp -v $host" or die;
|
||
|
|
print FTP "cd $dir\n";
|
||
|
|
foreach my $f (@files) {
|
||
|
|
(my $ff = $f) =~ s@.*\/([^/].*)@$1@;
|
||
|
|
print FTP "put $f $ff\n";
|
||
|
|
}
|
||
|
|
print FTP "bye\n";
|
||
|
|
close FTP;
|
||
|
|
die if $?;
|
||
|
|
} else {
|
||
|
|
die "Don't know how to handle this URL scheme";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|