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