maint/release.pm

   1 #!/usr/bin/perl
   2 # A simple system for making software releases
   3 # (c) 2003--2010 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                         '\.swp$' => '-',
  22                         ],
  23                 "directories" => [
  24                         ],
  25                 "conditions" => {
  26                         },
  27                 "DATE" => `date '+%Y-%m-%d' | tr -d '\n'`,
  28                 "LSMDATE" => `date '+%y%m%d' | tr -d '\n'`,
  29                 "distfiles" => [
  30                         ],
  31                 "archivedir" => "/home/mj/tmp/archives/$basename",
  32                 "uploads" => [
  33                         ],
  34                 "notifiers" => [
  35                         ],
  36                 # Options
  37                 "do_test" => 1,
  38                 "do_patch" => 1,
  39                 "diff_against" => "",
  40                 "do_upload" => 1,
  41                 "do_git_tag" => 0,
  42                 "force_git_tag" => 0,
  43                 "do_notify" => 0,
  44         };
  45         bless $s;
  46         return $s;
  47 }
  48
  49 sub GetVersionFromFile($) {
  50         my ($s,$file,$rx) = @_;
  51         open F, $file or die "Unable to open $file for version autodetection";
  52         while (<F>) {
  53                 chomp;
  54                 if (/$rx/) {
  55                         $s->{"VERSION"} = $1;
  56                         print "Detected version $1 from $file\n" if $verbose;
  57                         last;
  58                 }
  59         }
  60         close F;
  61         if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
  62         return $s->{"VERSION"};
  63 }
  64
  65 sub GetVersionsFromChangelog($) {
  66         my ($s,$file,$rx) = @_;
  67         open F, $file or die "Unable to open $file for version autodetection";
  68         while (<F>) {
  69                 chomp;
  70                 if (/$rx/) {
  71                         if (!defined $s->{"VERSION"}) {
  72                                 $s->{"VERSION"} = $1;
  73                                 print "Detected version $1 from $file\n" if $verbose;
  74                         } elsif ($s->{"VERSION"} eq $1) {
  75                                 # do nothing
  76                         } else {
  77                                 $s->{"OLDVERSION"} = $1;
  78                                 print "Detected previous version $1 from $file\n" if $verbose;
  79                                 last;
  80                         }
  81                 }
  82         }
  83         close F;
  84         if (!defined $s->{"VERSION"}) { die "Failed to auto-detect version"; }
  85         return $s->{"VERSION"};
  86 }
  87
  88 sub InitDist($) {
  89         my ($s,$dd) = @_;
  90         $s->{"DISTDIR"} = $dd;
  91         print "Initializing dist directory $dd\n" if $verbose;
  92         `rm -rf $dd`; die if $?;
  93         `mkdir -p $dd`; die if $?;
  94 }
  95
  96 sub ExpandVar($$) {
  97         my ($s,$v) = @_;
  98         if (defined $s->{$v}) {
  99                 return $s->{$v};
 100         } else {
 101                 die "Reference to unknown variable $v";
 102         }
 103 }
 104
 105 sub CopyFile($$$$) {
 106         my ($s,$f,$dir,$action) = @_;
 107
 108         (my $d = $f) =~ s@(^|/)[^/]*$@@;
 109         $d = "$dir/$d";
 110         -d $d || `mkdir -p $d`; die if $?;
 111
 112         my $preprocess = ($action =~ /p/);
 113         my $subst = ($action =~ /s/);
 114         if ($preprocess || $subst) {
 115                 open I, "$f" or die "open($f): $?";
 116                 open O, ">$dir/$f" or die "open($dir/$f): $!";
 117                 my @ifs = ();   # stack of conditions, 1=satisfied
 118                 my $empty = 0;  # last line was empty
 119                 my $is_makefile = ($f =~ /(Makefile|.mk)$/);
 120                 while (<I>) {
 121                         if ($subst) {
 122                                 s/@([0-9A-Za-z_]+)@/$s->ExpandVar($1)/ge;
 123                         }
 124                         if ($preprocess) {
 125                                 if (/^#/ || $is_makefile) {
 126                                         if (/^#?ifdef\s+(\w+)/) {
 127                                                 if (defined ${$s->{"conditions"}}{$1}) {
 128                                                         push @ifs, ${$s->{"conditions"}}{$1};
 129                                                         next;
 130                                                 }
 131                                                 push @ifs, 0;
 132                                         } elsif (/^#ifndef\s+(\w+)/) {
 133                                                 if (defined ${$s->{"conditions"}}{$1}) {
 134                                                         push @ifs, -${$s->{"conditions"}}{$1};
 135                                                         next;
 136                                                 }
 137                                                 push @ifs, 0;
 138                                         } elsif (/^#if\s+/) {
 139                                                 push @ifs, 0;
 140                                         } elsif (/^#?endif/) {
 141                                                 my $x = pop @ifs;
 142                                                 defined $x or die "Improper nesting of conditionals";
 143                                                 $x && next;
 144                                         } elsif (/^#?else/) {
 145                                                 my $x = pop @ifs;
 146                                                 defined $x or die "Improper nesting of conditionals";
 147                                                 push @ifs, -$x;
 148                                                 $x && next;
 149                                         }
 150                                 }
 151                                 @ifs && $ifs[$#ifs] < 0 && next;
 152                                 if (/^$/) {
 153                                         $empty && next;
 154                                         $empty = 1;
 155                                 } else { $empty = 0; }
 156                         }
 157                         print O;
 158                 }
 159                 close O;
 160                 close I;
 161                 ! -x $f or chmod(0755, "$dir/$f") or die "chmod($dir/$f): $!";
 162         } else {
 163                 `cp -a "$f" "$dir/$f"`; die if $?;
 164         }
 165 }
 166
 167 sub GenPackage($) {
 168         my ($s) = @_;
 169         $s->{"PKG"} = $s->{"PACKAGE"} . "-" . $s->{"VERSION"};
 170         my $dd = $s->{"DISTDIR"};
 171         my $pkg = $s->{"PKG"};
 172         my $dir = "$dd/$pkg";
 173         print "Generating $dir\n";
 174
 175         FILES: foreach my $f (`find . -type f`) {
 176                 chomp $f;
 177                 $f =~ s/^\.\///;
 178                 my $action = "";
 179                 my @rules = @{$s->{"rules"}};
 180                 while (@rules) {
 181                         my $rule = shift @rules;
 182                         my $act = shift @rules;
 183                         if ($f =~ $rule) {
 184                                 $action = $act;
 185                                 last;
 186                         }
 187                 }
 188                 ($action =~ /-/) && next FILES;
 189                 print "$f ($action)\n" if $verbose;
 190                 $s->CopyFile($f, $dir, $action);
 191         }
 192
 193         foreach my $d (@{$s->{"directories"}}) {
 194                 `mkdir -p $dir/$d`; die if $?;
 195         }
 196
 197         if (-f "$dir/Makefile") {
 198                 print "Cleaning up\n";
 199                 `cd $dir && make distclean >&2`; die if $?;
 200         }
 201
 202         print "Creating $dd/$pkg.tar.gz\n";
 203         my $tarvv = $verbose ? "vv" : "";
 204         `cd $dd && tar cz${tarvv}f $pkg.tar.gz $pkg >&2`; die if $?;
 205         push @{$s->{"distfiles"}}, "$dd/$pkg.tar.gz";
 206
 207         my $adir = $s->{"archivedir"};
 208         my $afile = "$adir/$pkg.tar.gz";
 209         print "Archiving to $afile\n";
 210         -d $adir or `mkdir -p $adir`;
 211         `cp $dd/$pkg.tar.gz $afile`; die if $?;
 212
 213         return $dir;
 214 }
 215
 216 sub GenFile($$) {
 217         my ($s,$f) = @_;
 218         my $sf = $s->{"DISTDIR"} . "/" . $s->{"PKG"} . "/$f";
 219         my $df = $s->{"DISTDIR"} . "/$f";
 220         print "Generating $df\n";
 221         `cp $sf $df`; die if $?;
 222         push @{$s->{"distfiles"}}, $df;
 223 }
 224
 225 sub Usage($) {
 226         my ($s) = @_;
 227         my $usage = <<FOE ;
 228 Usage: $0 <options>
 229
 230 Options:
 231 --[no]verbose           Be chatty about the inner workings of the release system {verbose}
 232 --[no]test              Test the package before uploading {do_test}
 233 --[no]patch             Make a patch against the previous version {do_patch}
 234 --diff-against=<ver>    Set which version we create the patch against
 235 --[no]upload            Upload released files {do_upload}
 236 --[no]git-tag           Tag the Git repository with "v<version>" {do_git_tag}
 237 --force-git-tag         Rewrite the Git tag if it already exists {force_git_tag}
 238 --[no]notify            Call scripts to notify the world about the release {do_notify}
 239 FOE
 240         sub state($) {
 241                 return "(default: " . ($_[0] ? "on" : "off") . ")";
 242         }
 243         $usage =~ s[{(\w+)}][state($s->{$1})]ge;
 244         die $usage;
 245 }
 246
 247 sub ParseOptions($) {
 248         my ($s) = @_;
 249         $s->{"do_git_tag"} = 1 if (-d ".git");
 250         $s->{"do_notify"} = 1 if @{$s->{"notifiers"}};
 251         GetOptions(
 252                 "verbose!" => \$verbose,
 253                 "test!" => \$s->{"do_test"},
 254                 "patch!" => \$s->{"do_patch"},
 255                 "diff-against=s" => \$s->{"diff_against"},
 256                 "upload!" => \$s->{"do_upload"},
 257                 'git-tag!' => \$s->{"do_git_tag"},
 258                 'force-git-tag!' => \$s->{"force_git_tag"},
 259                 'notify!' => \$s->{"do_notify"},
 260         ) || $s->Usage;
 261 }
 262
 263 sub Test($) {
 264         my ($s) = @_;
 265         my $dd = $s->{"DISTDIR"};
 266         my $pkg = $s->{"PKG"};
 267         my $log = "$dd/$pkg.log";
 268         print "Doing a test compilation\n";
 269         `( cd $dd/$pkg && make ) >$log 2>&1`;
 270         die "There were errors. Please inspect $log" if $?;
 271         `grep -q [Ww]arning $log`;
 272         $? or print "There were warnings! Please inspect $log.\n";
 273         print "Cleaning up\n";
 274         `cd $dd/$pkg && make distclean`; die if $?;
 275 }
 276
 277 sub MakePatch($) {
 278         my ($s) = @_;
 279         my $dd = $s->{"DISTDIR"};
 280         my $pkg1 = $s->{"PKG"};
 281         my $oldver;
 282         if ($s->{"diff_against"} ne "") {
 283                 $oldver = $s->{"diff_against"};
 284         } elsif (defined $s->{"OLDVERSION"}) {
 285                 $oldver = $s->{"OLDVERSION"};
 286         } else {
 287                 print "WARNING: No previous version known. No patch generated.\n";
 288                 return;
 289         }
 290         my $pkg0 = $s->{"PACKAGE"} . "-" . $oldver;
 291
 292         my $oldarch = $s->{"archivedir"} . "/" . $pkg0 . ".tar.gz";
 293         -f $oldarch or die "MakePatch: $oldarch not found";
 294         print "Unpacking $pkg0 from $oldarch\n";
 295         `cd $dd && tar xzf $oldarch`; die if $?;
 296
 297         my $diff = $s->{"PACKAGE"} . "-" . $oldver . "-" . $s->{"VERSION"} . ".diff.gz";
 298         print "Creating a patch from $pkg0 to $pkg1: $diff\n";
 299         `cd $dd && diff -ruN $pkg0 $pkg1 | gzip >$diff`; die if $?;
 300         push @{$s->{"distfiles"}}, "$dd/$diff";
 301 }
 302
 303 sub Upload($) {
 304         my ($s) = @_;
 305         foreach my $u (@{$s->{"uploads"}}) {
 306                 my $url = $u->{"url"};
 307                 print "Upload to $url :\n";
 308                 my @files = ();
 309                 my $filter = $u->{"filter"} || ".*";
 310                 foreach my $f (@{$s->{"distfiles"}}) {
 311                         if ($f =~ $filter) {
 312                                 print "\t$f\n";
 313                                 push @files, $f;
 314                         }
 315                 }
 316                 print "<confirm> "; <STDIN>;
 317                 if ($url =~ m@^scp://([^/]+)(.*)@) {
 318                         $, = " ";
 319                         my $host = $1;
 320                         my $dir = $2;
 321                         $dir =~ s@^/~@~@;
 322                         $dir =~ s@^/\./@@;
 323                         my $cmd = "scp @files $host:$dir\n";
 324                         `$cmd`; die if $?;
 325                 } elsif ($url =~ m@ftp://([^/]+)(.*)@) {
 326                         my $host = $1;
 327                         my $dir = $2;
 328                         open FTP, "|ftp -v $host" or die;
 329                         print FTP "cd $dir\n";
 330                         foreach my $f (@files) {
 331                                 (my $ff = $f) =~ s@.*\/([^/].*)@$1@;
 332                                 print FTP "put $f $ff\n";
 333                         }
 334                         print FTP "bye\n";
 335                         close FTP;
 336                         die if $?;
 337                 } else {
 338                         die "Don't know how to handle this URL scheme";
 339                 }
 340         }
 341 }
 342
 343 sub GitTag($) {
 344         my ($s) = @_;
 345         my $tag = 'v' . $s->{'VERSION'};
 346         my $force = ($s->{'force_git_tag'} ? '--force' : '');
 347         print "Tagging Git repository with $tag\n";
 348         `git tag $tag $force`; die if $?;
 349         print "Pushing the tags upstream\n";
 350         `git push --tags`; die if $?;
 351 }
 352
 353 sub AddUcwNotifier($) {
 354         my ($r) = @_;
 355         push @{$r->{"notifiers"}}, sub {
 356                 my ($s) = @_;
 357                 print "Updating web pages\n";
 358                 my $pkg = $s->{'PACKAGE'};
 359                 my $ver = $s->{'VERSION'};
 360                 `ssh jw 'cd www && bin/release-prog $pkg $ver'`; die if $?;
 361         };
 362 };
 363
 364 sub Dispatch($) {
 365         my ($s) = @_;
 366         $s->Test if $s->{"do_test"};
 367         $s->MakePatch if $s->{"do_patch"};
 368         $s->GitTag if $s->{"do_git_tag"};
 369         $s->Upload if $s->{"do_upload"};
 370         if ($s->{"do_notify"}) {
 371                 for my $f (@{$s->{"notifiers"}}) {
 372                         &$f($s);
 373                 }
 374         }
 375 }
 376
 377 1;