1#!/usr/bin/perl -w
2# Generate a release announcement message.
3
4my $VERSION = '2009-09-01 06:47'; # UTC
5# The definition above must lie within the first 8 lines in order
6# for the Emacs time-stamp write hook (at end) to update it.
7# If you change this file with Emacs, please let the write hook
8# do its job.  Otherwise, update this string manually.
9
10# Copyright (C) 2002-2009 Free Software Foundation, Inc.
11
12# This program is free software: you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation, either version 3 of the License, or
15# (at your option) any later version.
16
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
20# GNU General Public License for more details.
21
22# You should have received a copy of the GNU General Public License
23# along with this program.  If not, see <http://www.gnu.org/licenses/>.
24
25# Written by Jim Meyering
26
27use strict;
28
29use Getopt::Long;
30use Digest::MD5;
31use Digest::SHA1;
32use POSIX qw(strftime);
33
34(my $ME = $0) =~ s|.*/||;
35
36my %valid_release_types = map {$_ => 1} qw (alpha beta major);
37my @archive_suffixes = ('tar.gz', 'tar.bz2', 'tar.lzma', 'tar.xz');
38
39sub usage ($)
40{
41  my ($exit_code) = @_;
42  my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
43  if ($exit_code != 0)
44    {
45      print $STREAM "Try `$ME --help' for more information.\n";
46    }
47  else
48    {
49      my @types = sort keys %valid_release_types;
50      print $STREAM <<EOF;
51Usage: $ME [OPTIONS]
52Generate an announcement message.
53
54OPTIONS:
55
56These options must be specified:
57
58   --release-type=TYPE          TYPE must be one of @types
59   --package-name=PACKAGE_NAME
60   --previous-version=VER
61   --current-version=VER
62   --gpg-key-id=ID         The GnuPG ID of the key used to sign the tarballs
63   --url-directory=URL_DIR
64
65The following are optional:
66
67   --news=NEWS_FILE
68   --bootstrap-tools=TOOL_LIST  a comma-separated list of tools, e.g.,
69                                autoconf,automake,bison,gnulib
70   --gnulib-version=VERSION     report VERSION as the gnulib version, where
71                                VERSION is the result of running git describe
72                                in the gnulib source directory.
73                                required if gnulib is in TOOL_LIST.
74   --no-print-checksums         do not emit MD5 or SHA1 checksums
75   --archive-suffix=SUF         add SUF to the list of archive suffixes
76
77   --help             display this help and exit
78   --version          output version information and exit
79
80EOF
81    }
82  exit $exit_code;
83}
84
85
86=item C<%size> = C<sizes (@file)>
87
88Compute the sizes of the C<@file> and return them as a hash.  Return
89C<undef> if one of the computation failed.
90
91=cut
92
93sub sizes (@)
94{
95  my (@file) = @_;
96
97  my $fail = 0;
98  my %res;
99  foreach my $f (@file)
100    {
101      my $cmd = "du --human $f";
102      my $t = `$cmd`;
103      # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS
104      $@
105	and (warn "$ME: command failed: `$cmd'\n"), $fail = 1;
106      chomp $t;
107      $t =~ s/^([\d.]+[MkK]).*/${1}B/;
108      $res{$f} = $t;
109    }
110  return $fail ? undef : %res;
111}
112
113=item C<print_locations ($title, \@url, \%size, @file)
114
115Print a section C<$title> dedicated to the list of <@file>, which
116sizes are stored in C<%size>, and which are available from the C<@url>.
117
118=cut
119
120sub print_locations ($\@\%@)
121{
122  my ($title, $url, $size, @file) = @_;
123  print "Here are the $title:\n";
124  foreach my $url (@{$url})
125    {
126      for my $file (@file)
127	{
128	  print "  $url/$file";
129	  print "   (", $$size{$file}, ")"
130	    if exists $$size{$file};
131	  print "\n";
132	}
133    }
134  print "\n";
135}
136
137=item C<print_checksums (@file)
138
139Print the MD5 and SHA1 signature section for each C<@file>.
140
141=cut
142
143sub print_checksums (@)
144{
145  my (@file) = @_;
146
147  print "Here are the MD5 and SHA1 checksums:\n";
148  print "\n";
149
150  foreach my $meth (qw (md5 sha1))
151    {
152      foreach my $f (@file)
153	{
154	  open IN, '<', $f
155	    or die "$ME: $f: cannot open for reading: $!\n";
156	  binmode IN;
157	  my $dig =
158	    ($meth eq 'md5'
159	     ? Digest::MD5->new->addfile(*IN)->hexdigest
160	     : Digest::SHA1->new->addfile(*IN)->hexdigest);
161	  close IN;
162	  print "$dig  $f\n";
163	}
164    }
165  print "\n";
166}
167
168=item C<print_news_deltas ($news_file, $prev_version, $curr_version)
169
170Print the section of the NEWS file C<$news_file> addressing changes
171between versions C<$prev_version> and C<$curr_version>.
172
173=cut
174
175sub print_news_deltas ($$$)
176{
177  my ($news_file, $prev_version, $curr_version) = @_;
178
179  print "\n$news_file\n\n";
180
181  # Print all lines from $news_file, starting with the first one
182  # that mentions $curr_version up to but not including
183  # the first occurrence of $prev_version.
184  my $in_items;
185
186  my $re_prefix = qr/(?:\* )?(?:Noteworthy c|Major c|C)(?i:hanges)/;
187
188  open NEWS, '<', $news_file
189    or die "$ME: $news_file: cannot open for reading: $!\n";
190  while (defined (my $line = <NEWS>))
191    {
192      if ( ! $in_items)
193	{
194	  # Match lines like these:
195	  # * Major changes in release 5.0.1:
196	  # * Noteworthy changes in release 6.6 (2006-11-22) [stable]
197	  $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$curr_version\E(?:[^\d.]|$)/o
198	    or next;
199	  $in_items = 1;
200	  print $line;
201	}
202      else
203	{
204	  # This regexp must not match version numbers in NEWS items.
205	  # For example, they might well say `introduced in 4.5.5',
206	  # and we don't want that to match.
207	  $line =~ /^$re_prefix.*(?:[^\d.]|$)\Q$prev_version\E(?:[^\d.]|$)/o
208	    and last;
209	  print $line;
210	}
211    }
212  close NEWS;
213
214  $in_items
215    or die "$ME: $news_file: no matching lines for `$curr_version'\n";
216}
217
218sub print_changelog_deltas ($$)
219{
220  my ($package_name, $prev_version) = @_;
221
222  # Print new ChangeLog entries.
223
224  # First find all CVS-controlled ChangeLog files.
225  use File::Find;
226  my @changelog;
227  find ({wanted => sub {$_ eq 'ChangeLog' && -d 'CVS'
228			  and push @changelog, $File::Find::name}},
229	'.');
230
231  # If there are no ChangeLog files, we're done.
232  @changelog
233    or return;
234  my %changelog = map {$_ => 1} @changelog;
235
236  # Reorder the list of files so that if there are ChangeLog
237  # files in the specified directories, they're listed first,
238  # in this order:
239  my @dir = qw ( . src lib m4 config doc );
240
241  # A typical @changelog array might look like this:
242  # ./ChangeLog
243  # ./po/ChangeLog
244  # ./m4/ChangeLog
245  # ./lib/ChangeLog
246  # ./doc/ChangeLog
247  # ./config/ChangeLog
248  my @reordered;
249  foreach my $d (@dir)
250    {
251      my $dot_slash = $d eq '.' ? $d : "./$d";
252      my $target = "$dot_slash/ChangeLog";
253      delete $changelog{$target}
254	and push @reordered, $target;
255    }
256
257  # Append any remaining ChangeLog files.
258  push @reordered, sort keys %changelog;
259
260  # Remove leading `./'.
261  @reordered = map { s!^\./!!; $_ } @reordered;
262
263  print "\nChangeLog entries:\n\n";
264  # print join ("\n", @reordered), "\n";
265
266  $prev_version =~ s/\./_/g;
267  my $prev_cvs_tag = "\U$package_name\E-$prev_version";
268
269  my $cmd = "cvs -n diff -u -r$prev_cvs_tag -rHEAD @reordered";
270  open DIFF, '-|', $cmd
271    or die "$ME: cannot run `$cmd': $!\n";
272  # Print two types of lines, making minor changes:
273  # Lines starting with `+++ ', e.g.,
274  # +++ ChangeLog   22 Feb 2003 16:52:51 -0000      1.247
275  # and those starting with `+'.
276  # Don't print the others.
277  my $prev_printed_line_empty = 1;
278  while (defined (my $line = <DIFF>))
279    {
280      if ($line =~ /^\+\+\+ /)
281	{
282	  my $separator = "*"x70 ."\n";
283	  $line =~ s///;
284	  $line =~ s/\s.*//;
285	  $prev_printed_line_empty
286	    or print "\n";
287	  print $separator, $line, $separator;
288	}
289      elsif ($line =~ /^\+/)
290	{
291	  $line =~ s///;
292	  print $line;
293	  $prev_printed_line_empty = ($line =~ /^$/);
294	}
295    }
296  close DIFF;
297
298  # The exit code should be 1.
299  # Allow in case there are no modified ChangeLog entries.
300  $? == 256 || $? == 128
301    or warn "$ME: warning: `cmd' had unexpected exit code or signal ($?)\n";
302}
303
304sub get_tool_versions ($$)
305{
306  my ($tool_list, $gnulib_version) = @_;
307  @$tool_list
308    or return ();
309
310  my $fail;
311  my @tool_version_pair;
312  foreach my $t (@$tool_list)
313    {
314      if ($t eq 'gnulib')
315	{
316	  push @tool_version_pair, ucfirst $t . ' ' . $gnulib_version;
317	  next;
318	}
319      # Assume that the last "word" on the first line of
320      # `tool --version` output is the version string.
321      my ($first_line, undef) = split ("\n", `$t --version`);
322      if ($first_line =~ /.* (\d[\w.-]+)$/)
323	{
324	  $t = ucfirst $t;
325	  push @tool_version_pair, "$t $1";
326	}
327      else
328	{
329	  defined $first_line
330	    and $first_line = '';
331	  warn "$ME: $t: unexpected --version output\n:$first_line";
332	  $fail = 1;
333	}
334    }
335
336  $fail
337    and exit 1;
338
339  return @tool_version_pair;
340}
341
342{
343  # Neutralize the locale, so that, for instance, "du" does not
344  # issue "1,2" instead of "1.2", what confuses our regexps.
345  $ENV{LC_ALL} = "C";
346
347  my $release_type;
348  my $package_name;
349  my $prev_version;
350  my $curr_version;
351  my $gpg_key_id;
352  my @url_dir_list;
353  my @news_file;
354  my $bootstrap_tools;
355  my $gnulib_version;
356  my $print_checksums_p = 1;
357
358  GetOptions
359    (
360     'release-type=s'     => \$release_type,
361     'package-name=s'     => \$package_name,
362     'previous-version=s' => \$prev_version,
363     'current-version=s'  => \$curr_version,
364     'gpg-key-id=s'       => \$gpg_key_id,
365     'url-directory=s'    => \@url_dir_list,
366     'news=s'             => \@news_file,
367     'bootstrap-tools=s'  => \$bootstrap_tools,
368     'gnulib-version=s'   => \$gnulib_version,
369     'print-checksums!'   => \$print_checksums_p,
370     'archive-suffix=s'   => \@archive_suffixes,
371
372     help => sub { usage 0 },
373     version => sub { print "$ME version $VERSION\n"; exit },
374    ) or usage 1;
375
376  my $fail = 0;
377  # Ensure that sure each required option is specified.
378  $release_type
379    or (warn "$ME: release type not specified\n"), $fail = 1;
380  $package_name
381    or (warn "$ME: package name not specified\n"), $fail = 1;
382  $prev_version
383    or (warn "$ME: previous version string not specified\n"), $fail = 1;
384  $curr_version
385    or (warn "$ME: current version string not specified\n"), $fail = 1;
386  $gpg_key_id
387    or (warn "$ME: GnuPG key ID not specified\n"), $fail = 1;
388  @url_dir_list
389    or (warn "$ME: URL directory name(s) not specified\n"), $fail = 1;
390
391  my @tool_list = split ',', $bootstrap_tools;
392
393  grep (/^gnulib$/, @tool_list) ^ defined $gnulib_version
394    and (warn "$ME: when specifying gnulib as a tool, you must also specify\n"
395	. "--gnulib-version=V, where V is the result of running git describe\n"
396	. "in the gnulib source directory.\n"), $fail = 1;
397
398  exists $valid_release_types{$release_type}
399    or (warn "$ME: `$release_type': invalid release type\n"), $fail = 1;
400
401  @ARGV
402    and (warn "$ME: too many arguments:\n", join ("\n", @ARGV), "\n"),
403      $fail = 1;
404  $fail
405    and usage 1;
406
407  my $my_distdir = "$package_name-$curr_version";
408
409  my $xd = "$package_name-$prev_version-$curr_version.xdelta";
410
411  my @candidates = map { "$my_distdir.$_" } @archive_suffixes;
412  my @tarballs = grep {-f $_} @candidates;
413
414  @tarballs
415    or die "$ME: none of " . join(', ', @candidates) . " were found\n";
416  my @sizable = @tarballs;
417  -f $xd
418    and push @sizable, $xd;
419  my %size = sizes (@sizable);
420  %size
421    or exit 1;
422
423  # The markup is escaped as <\# so that when this script is sent by
424  # mail (or part of a diff), Gnus is not triggered.
425  print <<EOF;
426
427Subject: $my_distdir released
428
429<\#secure method=pgpmime mode=sign>
430
431FIXME: put comments here
432
433EOF
434
435  print_locations ("compressed sources", @url_dir_list, %size, @tarballs);
436  -f $xd
437    and print_locations ("xdelta diffs (useful? if so, "
438			 . "please tell bug-gnulib\@gnu.org)",
439			 @url_dir_list, %size, $xd);
440  my @sig_files = map { "$_.sig" } @tarballs;
441  print_locations ("GPG detached signatures[*]", @url_dir_list, %size,
442		   @sig_files);
443
444  $print_checksums_p
445    and print_checksums (@sizable);
446
447  print <<EOF;
448[*] You can use either of the above signature files to verify that
449the corresponding file (without the .sig suffix) is intact.  First,
450be sure to download both the .sig file and the corresponding tarball.
451Then, run a command like this:
452
453  gpg --verify $tarballs[0].sig
454
455If that command fails because you don't have the required public key,
456then run this command to import it:
457
458  gpg --keyserver keys.gnupg.net --recv-keys $gpg_key_id
459
460and rerun the \`gpg --verify' command.
461EOF
462
463  my @tool_versions = get_tool_versions (\@tool_list, $gnulib_version);
464  @tool_versions
465    and print "\nThis release was bootstrapped with the following tools:",
466      join ('', map {"\n  $_"} @tool_versions), "\n";
467
468  print_news_deltas ($_, $prev_version, $curr_version)
469    foreach @news_file;
470
471  $release_type eq 'major'
472    or print_changelog_deltas ($package_name, $prev_version);
473
474  exit 0;
475}
476
477### Setup "GNU" style for perl-mode and cperl-mode.
478## Local Variables:
479## perl-indent-level: 2
480## perl-continued-statement-offset: 2
481## perl-continued-brace-offset: 0
482## perl-brace-offset: 0
483## perl-brace-imaginary-offset: 0
484## perl-label-offset: -2
485## cperl-indent-level: 2
486## cperl-brace-offset: 0
487## cperl-continued-brace-offset: 0
488## cperl-label-offset: -2
489## cperl-extra-newline-before-brace: t
490## cperl-merge-trailing-else: nil
491## cperl-continued-statement-offset: 2
492## eval: (add-hook 'write-file-hooks 'time-stamp)
493## time-stamp-start: "my $VERSION = '"
494## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
495## time-stamp-time-zone: "UTC"
496## time-stamp-end: "'; # UTC"
497## End:
498