maint/release.pm

   1 #!/usr/bin/perl
   2 # A simple system for making software releases
   3 # (c) 2003--2012 Martin Mares <mj@ucw.cz>
   4
   5 package UCW::Release;
   6 use strict;
   7 use warnings;
   8 use Getopt::Long;
   9
  10 our $verbose = 0;
  11
  12 sub new($$) {
  13         my ($class,$basename) = @_;
  14         my $s = {
  15                 "PACKAGE" => $basename,
  16                 "rules" => [
  17                         # p=preprocess, s=subst, -=discard
  18                         '(^|/)(CVS|\.arch-ids|{arch}|\.git|tmp)/' => '-',
  19                         '\.(lsm|spec)$' => 'ps',
  20                         '(^|/)README$' => 's'
  21                         ],
  22                 "conditions" => {
  23                         # Symbols, which can serve as conditions for the preprocessor
  24                         },
  25                 "DATE" => `date '+%Y-%m-%d' | tr -d '\n'`,
  26                 "LSMDATE" => `date '+%y%m%d' | tr -d '\n'`,
  27                 "distfiles" => [
  28                         # Files to be uploaded
  29                         ],
  30                 "uploads" => [
  31                         # Locations where we want to upload, e.g.:
  32                         #       { "url" => "ftp://metalab.unc.edu/incoming/linux/",
  33                         #         "filter" => '(\.tar\.gz|\.lsm)$', }
  34                         ],
  35                 "test_compile" => "make",
  36                 # "archive_dir" => "/tmp/archives/$basename",
  37                 # Options
  38                 "do_test" => 1,
  39                 "do_patch" => 0,
  40                 "diff_against" => "",
  41                 "do_upload" => 1,
  42                 "do_sign" => 1,
  43         };
  44         bless $s;
  45         return $s;
  46 }
  47
  48 sub Confirm($) {
  49         my ($s) = @_;
  50         print "<confirm> "; <STDIN>;
  51 }
  52
  53 sub GetVersionFromGit($) {
  54         my ($s) = @_;
  55         return if defined $s->{"VERSION"};
  56         my $desc = `git describe --tags`; die "git describe failed\n" if $?;
  57         chomp $desc;
  58         my ($ver, $rest) = ($desc =~ /^v([0-9.]+)(.*)/) or die "Failed to understand output of git describe: $desc\n";
  59         print "Detected version $ver from git description $desc\n";
  60         if ($rest ne '') {
  61                 print "WARNING: We are several commits past release tag... ";
  62                 $s->Confirm;
  63         }
  64         $s->{"VERSION"} = $ver;
  65         return $ver;
  66 }
  67
  68 sub GetVersionFromFile($) {
  69         my ($s,$file,$rx) = @_;
  70         return if defined $s->{"VERSION"};
  71         open F, $file or die "Unable to open $file for version autodetection";
  72         while (<F>) {
  73                 chomp;
  74                 if (/$rx/) {
  75                         $s->{"VERSION"} = $1;
  76                         print "Detected version $1 from $file\n" if $verbose;
  77                         last;
  78                 }
  79         }
  80         close F;
  81         if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
  82         return $s->{"VERSION"};
  83 }
  84
  85 sub GetVersionsFromChangelog($) {
  86         my ($s,$file,$rx) = @_;
  87         return if defined $s->{"VERSION"};
  88         open F, $file or die "Unable to open $file for version autodetection";
  89         while (<F>) {
  90                 chomp;
  91                 if (/$rx/) {
  92                         if (!defined $s->{"VERSION"}) {
  93                                 $s->{"VERSION"} = $1;
  94                                 print "Detected version $1 from $file\n" if $verbose;
  95                         } elsif ($s->{"VERSION"} eq $1) {
  96                                 # do nothing
  97                         } else {
  98                                 $s->{"OLDVERSION"} = $1;
  99                                 print "Detected previous version $1 from $file\n" if $verbose;
 100                                 last;
 101                         }
 102                 }
 103         }
 104         close F;
 105         if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
 106         return $s->{"VERSION"};
 107 }
 108
 109 sub InitDist($) {
 110         my ($s,$dd) = @_;
 111         $s->{"DISTDIR"} = $dd;
 112         print "Initializing dist directory $dd\n" if $verbose;
 113         `rm -rf $dd`; die if $?;
 114         `mkdir -p $dd`; die if $?;
 115
 116         if ($s->{"archive_dir"}) {
 117                 unshift @{$s->{"uploads"}}, { "url" => "file:" . $s->{"archive_dir"} };
 118         }
 119 }
 120
 121 sub ExpandVar($$) {
 122         my ($s,$v) = @_;
 123         if (defined $s->{$v}) {
 124                 return $s->{$v};
 125         } else {
 126                 die "Reference to unknown variable $v";
 127         }
 128 }
 129
 130 sub TransformFile($$$) {
 131         my ($s,$file,$action) = @_;
 132
 133         my $preprocess = ($action =~ /p/);
 134         my $subst = ($action =~ /s/);
 135         my $dest = "$file.dist";
 136         open I, "<", $file or die "open($file): $?";
 137         open O, ">", "$dest" or die "open($dest): $!";
 138         my @ifs = ();   # stack of conditions, 1=satisfied
 139         my $empty = 0;  # last line was empty
 140         my $is_makefile = ($file =~ /(Makefile|.mk)$/);
 141         while (<I>) {
 142                 if ($subst) {
 143                         s/@([0-9A-Za-z_]+)@/$s->ExpandVar($1)/ge;
 144                 }
 145                 if ($preprocess) {
 146                         if (/^#/ || $is_makefile) {
 147                                 if (/^#?ifdef\s+(\w+)/) {
 148                                         if (defined ${$s->{"conditions"}}{$1}) {
 149                                                 push @ifs, ${$s->{"conditions"}}{$1};
 150                                                 next;
 151                                         }
 152                                         push @ifs, 0;
 153                                 } elsif (/^#ifndef\s+(\w+)/) {
 154                                         if (defined ${$s->{"conditions"}}{$1}) {
 155                                                 push @ifs, -${$s->{"conditions"}}{$1};
 156                                                 next;
 157                                         }
 158                                         push @ifs, 0;
 159                                 } elsif (/^#if\s+/) {
 160                                         push @ifs, 0;
 161                                 } elsif (/^#?endif/) {
 162                                         my $x = pop @ifs;
 163                                         defined $x or die "Improper nesting of conditionals";
 164                                         $x && next;
 165                                 } elsif (/^#?else/) {
 166                                         my $x = pop @ifs;
 167                                         defined $x or die "Improper nesting of conditionals";
 168                                         push @ifs, -$x;
 169                                         $x && next;
 170                                 }
 171                         }
 172                         @ifs && $ifs[$#ifs] < 0 && next;
 173                         if (/^$/) {
 174                                 $empty && next;
 175                                 $empty = 1;
 176                         } else { $empty = 0; }
 177                 }
 178                 print O;
 179         }
 180         close O;
 181         close I;
 182         ! -x $file or chmod(0755, "$dest") or die "chmod($dest): $!";
 183         rename $dest, $file or "rename($dest,$file): $!";
 184 }
 185
 186 sub GenPackage($) {
 187         my ($s) = @_;
 188         $s->{"PKG"} = $s->{"PACKAGE"} . "-" . $s->{"VERSION"};
 189         my $dd = $s->{"DISTDIR"};
 190         my $pkg = $s->{"PKG"};
 191         my $dir = "$dd/$pkg";
 192         print "Generating $dir\n";
 193
 194         system "git archive --format=tar --prefix=$dir/ HEAD | tar xf -";
 195         die if $?;
 196
 197         my @files = `cd $dir && find . -type f`;
 198         die if $?;
 199
 200         for my $f (@files) {
 201                 chomp $f;
 202                 $f =~ s/^\.\///;
 203                 my $action = "";
 204                 my @rules = @{$s->{"rules"}};
 205                 while (@rules) {
 206                         my $rule = shift @rules;
 207                         my $act = shift @rules;
 208                         if ($f =~ $rule) {
 209                                 $action = $act;
 210                                 last;
 211                         }
 212                 }
 213                 if ($action eq '') {
 214                 } elsif ($action =~ /-/) {
 215                         unlink "$dir/$f" or die "Cannot unlink $dir/$f: $!\n";
 216                         print "$f (unlinked)\n" if $verbose;
 217                 } else {
 218                         print "$f ($action)\n" if $verbose;
 219                         $s->TransformFile("$dir/$f", $action);
 220                 }
 221         }
 222
 223         return $dir;
 224 }
 225
 226 sub GenFile($$) {
 227         my ($s,$f) = @_;
 228         my $sf = $s->{"DISTDIR"} . "/" . $s->{"PKG"} . "/$f";
 229         my $df = $s->{"DISTDIR"} . "/$f";
 230         print "Generating $df\n";
 231         `cp $sf $df`; die if $?;
 232         push @{$s->{"distfiles"}}, $df;
 233 }
 234
 235 sub SignFile($$) {
 236         my ($s, $file) = @_;
 237         $s->{'do_sign'} or return;
 238         print "Signing $file\n";
 239         system "gpg", "--armor", "--detach-sig", "$file";
 240         die if $?;
 241         rename "$file.asc", "$file.sign" or die "No signature produced!?\n";
 242         push @{$s->{"distfiles"}}, "$file.sign";
 243 }
 244
 245 sub MakeArchive($) {
 246         my ($s) = @_;
 247         my $dd = $s->{"DISTDIR"};
 248         my $pkg = $s->{"PKG"};
 249
 250         print "Creating $dd/$pkg.tar\n";
 251         my $tarvv = $verbose ? "vv" : "";
 252         `cd $dd && tar c${tarvv}f $pkg.tar $pkg >&2`; die if $?;
 253
 254         print "Creating $dd/$pkg.tar.gz\n";
 255         `gzip <$dd/$pkg.tar >$dd/$pkg.tar.gz`; die if $?;
 256         push @{$s->{"distfiles"}}, "$dd/$pkg.tar.gz";
 257
 258         # print "Creating $dd/$pkg.tar.bz2\n";
 259         # `bzip2 <$dd/$pkg.tar >$dd/$pkg.tar.bz2`; die if $?;
 260         # push @{$s->{"distfiles"}}, "$dd/$pkg.tar.bz2";
 261
 262         $s->SignFile("$dd/$pkg.tar");
 263 }
 264
 265 sub ParseOptions($) {
 266         my ($s) = @_;
 267         GetOptions(
 268                 "verbose!" => \$verbose,
 269                 "test!" => \$s->{"do_test"},
 270                 "patch!" => \$s->{"do_patch"},
 271                 "diff-against=s" => \$s->{"diff_against"},
 272                 "version=s" => \$s->{"VERSION"},
 273                 "upload!" => \$s->{"do_upload"},
 274                 "sign!" => \$s->{"do_sign"},
 275         ) || die "Syntax: release [--verbose] [--test] [--nopatch] [--version=<version>] [--diff-against=<version>] [--noupload] [--nosign]";
 276 }
 277
 278 sub Test($) {
 279         my ($s) = @_;
 280         $s->{"do_test"} or return;
 281         my $dd = $s->{"DISTDIR"};
 282         my $pkg = $s->{"PKG"};
 283         my $tdir = "$dd/$pkg.test";
 284         $s->{"TESTDIR"} = $tdir;
 285         `cp -a $dd/$pkg $tdir`; die if $?;
 286         my $log = "$tdir.log";
 287         print "Doing a test compilation\n";
 288         my $make = $s->{"test_compile"};
 289         `( cd $tdir && $make ) >$log 2>&1`;
 290         die "There were errors. Please inspect $log" if $?;
 291         `grep -q [Ww]arning $log`;
 292         $? or print "There were warnings! Please inspect $log.\n";
 293 }
 294
 295 sub MakePatch($) {
 296         my ($s) = @_;
 297         $s->{"do_patch"} or return;
 298         my $dd = $s->{"DISTDIR"};
 299         my $pkg1 = $s->{"PKG"};
 300         my $oldver;
 301         if ($s->{"diff_against"} ne "") {
 302                 $oldver = $s->{"diff_against"};
 303         } elsif (defined $s->{"OLDVERSION"}) {
 304                 $oldver = $s->{"OLDVERSION"};
 305         } else {
 306                 print "WARNING: No previous version known. No patch generated.\n";
 307                 return;
 308         }
 309         my $pkg0 = $s->{"PACKAGE"} . "-" . $oldver;
 310
 311         my $oldarch = $s->{"archivedir"} . "/" . $pkg0 . ".tar.gz";
 312         -f $oldarch or die "MakePatch: $oldarch not found";
 313         print "Unpacking $pkg0 from $oldarch\n";
 314         `cd $dd && tar xzf $oldarch`; die if $?;
 315
 316         my $diff = $s->{"PACKAGE"} . "-" . $oldver . "-" . $s->{"VERSION"} . ".diff.gz";
 317         print "Creating a patch from $pkg0 to $pkg1: $diff\n";
 318         `cd $dd && diff -ruN $pkg0 $pkg1 | gzip >$diff`; die if $?;
 319         push @{$s->{"distfiles"}}, "$dd/$diff";
 320         $s->SignFile("$dd/$diff");
 321 }
 322
 323 sub Upload($) {
 324         my ($s) = @_;
 325         foreach my $u (@{$s->{"uploads"}}) {
 326                 my $url = $u->{"url"};
 327                 print "Upload to $url :\n";
 328                 my @files = ();
 329                 my $filter = $u->{"filter"} || ".*";
 330                 foreach my $f (@{$s->{"distfiles"}}) {
 331                         if ($f =~ $filter) {
 332                                 print "\t$f\n";
 333                                 push @files, $f;
 334                         }
 335                 }
 336                 $s->Confirm;
 337                 if ($url =~ m@^file:(.*)@) {
 338                         my $dir = $1;
 339                         $dir =~ s@^///@/@;
 340                         `cp @files $dir/`; die if $?;
 341                 } elsif ($url =~ m@^scp://([^/]+)(.*)@) {
 342                         $, = " ";
 343                         my $host = $1;
 344                         my $dir = $2;
 345                         $dir =~ s@^/~@~@;
 346                         $dir =~ s@^/\./@@;
 347                         my $cmd = "scp @files $host:$dir\n";
 348                         `$cmd`; die if $?;
 349                 } elsif ($url =~ m@ftp://([^/]+)(.*)@) {
 350                         my $host = $1;
 351                         my $dir = $2;
 352                         open FTP, "|ftp -v $host" or die;
 353                         print FTP "cd $dir\n";
 354                         foreach my $f (@files) {
 355                                 (my $ff = $f) =~ s@.*\/([^/].*)@$1@;
 356                                 print FTP "put $f $ff\n";
 357                         }
 358                         print FTP "bye\n";
 359                         close FTP;
 360                         die if $?;
 361                 } else {
 362                         die "Don't know how to handle this URL scheme";
 363                 }
 364         }
 365 }
 366
 367 1;