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