maint/release.pm

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