From: Akim Demaille Date: Mon, 24 Nov 2003 16:11:41 +0000 (+0000) Subject: * config/announce-gen (&print_locations, &print_signatures) X-Git-Tag: AUTOCONF-2.59c~781 X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=90f031cf0b5b12940d2c113775e8f590ea617e22;p=thirdparty%2Fautoconf.git * config/announce-gen (&print_locations, &print_signatures) (&sizes): New. Use them. No longer rely on Gnus to inline the list of signatures: compute them on the fly. --- diff --git a/ChangeLog b/ChangeLog index 7bf53fd85..c0f559351 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2003-11-24 Akim Demaille + + * config/announce-gen (&print_locations, &print_signatures) + (&sizes): New. + Use them. + No longer rely on Gnus to inline the list of signatures: compute + them on the fly. + 2003-11-24 Akim Demaille * doc/autoconf.texi (Particular Programs): AC_PROG_LEX can diff --git a/config/announce-gen b/config/announce-gen index a66e975e7..1c133e971 100755 --- a/config/announce-gen +++ b/config/announce-gen @@ -72,6 +72,97 @@ EOF exit $exit_code; } + +=item C<%size> = C + +Compute the sizes of the C<@file> and return them as a hash. Return +C if one of the computation failed. + +=cut + +sub sizes (@) +{ + my (@file) = @_; + + my $fail = 0; + my %res; + foreach my $f (@file) + { + my $cmd = "du --human $f"; + my $t = `$cmd`; + # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS + $@ + and (warn "$ME: command failed: `$cmd'\n"), $fail = 1; + chomp $t; + $t =~ s/^([\d.]+[MkK]).*/${1}B/; + $res{$f} = $t; + } + return $fail ? undef : %res; +} + +=item C dedicated to the list of <@file>, which +sizes are stored in C<%size>, and which are available from the C<@url>. + +=cut + +sub print_locations ($\@\%@) +{ + my ($title, $url, $size, @file) = @_; + print "Here are the $title:\n"; + foreach my $url (@{$url}) + { + for my $file (@file) + { + print " $url/$file"; + print " (", $$size{$file}, ")" + if exists $$size{$file}; + print "\n"; + } + } + print "\n"; +} + +=item C. + +=cut + +sub print_signatures (@) +{ + my (@file) = @_; + + print "Here are the MD5 and SHA1 signatures:\n"; + print "\n"; + + foreach my $meth (qw (md5 sha1)) + { + foreach my $f (@file) + { + open IN, '<', $f + or die "$ME: $f: cannot open for reading: $!\n"; + binmode IN; + my $dig = + ($meth eq 'md5' + ? Digest::MD5->new->addfile(*IN)->hexdigest + : Digest::SHA1->new->addfile(*IN)->hexdigest); + close IN; + print "$dig $f\n"; + } + } + + +} + +=item C addressing changes +between versions C<$prev_version> and C<$curr_version>. + +=cut + sub print_news_deltas ($$$) { my ($news_file, $prev_version, $curr_version) = @_; @@ -113,6 +204,7 @@ sub print_news_deltas ($$$) or die "$ME: $news_file: no matching lines for `$curr_version'\n"; } + sub print_changelog_deltas ($$) { my ($package_name, $prev_version) = @_; @@ -200,6 +292,10 @@ sub print_changelog_deltas ($$) } { + # Neutralize the locale, so that, for instance, "du" does not + # issue "1,2" instead of "1.2", what confuses our regexps. + $ENV{LC_ALL} = "C"; + my $release_type; my $package_name; my $prev_version; @@ -250,22 +346,9 @@ sub print_changelog_deltas ($$) my $tbz = "$my_distdir.tar.bz2"; my $xd = "$package_name-$prev_version-$curr_version.xdelta"; - my %size; - - foreach my $f ($tgz, $tbz, $xd) - { - my $cmd = "du --human $f"; - my $t = `$cmd`; - # FIXME-someday: give a better diagnostic, a la $PROCESS_STATUS - $@ - and (warn "$ME: command failed: `$cmd'\n"), $fail = 1; - chomp $t; - $t =~ s/^([\d.]+[MkK]).*/${1}B/; - $size{$f} = $t; - } - - $fail - and exit 1; + my %size = sizes ($tgz, $tbz, $xd); + %size + or exit 1; # The markup is escaped as <\# so that when this script is sent by # mail (or part of a diff), Gnus is not triggered. @@ -279,60 +362,14 @@ FIXME: put comments here EOF - print "Here are the compressed sources:\n"; - foreach my $url (@url_dir_list) - { - print " $url/$tgz ($size{$tgz})\n"; - print " $url/$tbz ($size{$tbz})\n"; - } - - print "\nAnd here are xdelta-style diffs:\n"; - foreach my $url (@url_dir_list) - { - print " $url/$xd ($size{$xd})\n"; - } - - print "\nHere are GPG detached signatures:\n"; - foreach my $url (@url_dir_list) - { - print " $url/$tgz.asc\n"; - print " $url/$tbz.asc\n"; - } - - # FIXME: clean up upon interrupt or die - my $tmpdir = $ENV{TMPDIR} || '/tmp'; - my $tmp = "$tmpdir/$ME-$$"; - unlink $tmp; # ignore failure - - print "\nHere are the MD5 and SHA1 signatures:\n"; - print "\n"; - # The markup is escaped as <\# so that when this script is sent by - # mail (or part of a diff), Gnus is not triggered. - print "<\#part type=text/plain filename=\"$tmp\" disposition=inline>\n" - . "<\#/part>\n"; - - open OUT, '>', $tmp - or die "$ME: $tmp: cannot open for writing: $!\n"; - - foreach my $meth (qw (md5 sha1)) - { - foreach my $f ($tgz, $tbz, $xd) - { - open IN, '<', $f - or die "$ME: $f: cannot open for reading: $!\n"; - binmode IN; - my $dig = - ($meth eq 'md5' - ? Digest::MD5->new->addfile(*IN)->hexdigest - : Digest::SHA1->new->addfile(*IN)->hexdigest); - close IN; - print OUT "$dig $f\n"; - } - } + print_locations ("compressed sources", @url_dir_list, %size, + $tgz, $tbz); + print_locations ("xdelta-style diffs", @url_dir_list, %size, + $xd); + print_locations ("GPG detached signatures", @url_dir_list, %size, + "$tgz.asc", "$tbz.asc"); - close OUT - or die "$ME: $tmp: while writing: $!\n"; - chmod 0400, $tmp; # ignore failure + print_signatures ($tgz, $tbz, $xd); print_news_deltas ($_, $prev_version, $curr_version) foreach @news_file;