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