Rewrite fetch.sh in Perl.

Using HTTP::Tiny to talk to the network, instead of wget, means that
we can make just one TCP connection to git.savannah.gnu.org to do the
whole job, which is quite a bit faster.  It should also be more
robust against weird characters in filenames / URLs and stuff.

The script has a higher requirement for Perl than is the standard in
autoconf -- 5.14 (first version with HTTP::Tiny), with IO::Socket::SSL
installed -- but that’s ok, I hope, because it’s maintainer-only and
not installed.

fetch.sh was the sole user of move-if-change, and the Perl script does
that job itself, but I left move-if-change in build-aux and on the fetch
list anyway, in case we discover another use for it in the future.

* build-aux/fetch.sh: Replace with...
* build-aux/fetch.pl: ... reimplementation in Perl.
* cfg.mk (fetch): Update to match.

3 files changed, 244 insertions, 83 deletions

diff --git a/build-aux/fetch.pl b/build-aux/fetch.pl
new file mode 100755
index 00000000..b2d41055
--- /dev/null
+++ b/build-aux/fetch.pl
@@ -0,0 +1,243 @@
+#! /usr/bin/perl
+# Copyright (C) 2020 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+use 5.014;  # first version with HTTP::Tiny
+use strict;
+use utf8;
+use feature 'unicode_strings';
+use warnings FATAL => 'all';
+
+use Fcntl qw (S_IMODE);
+use File::Spec;
+use File::stat;
+use File::Temp qw (tempfile);
+use Getopt::Long;
+use HTTP::Tiny;
+
+our @gnulib_files = qw(
+  build-aux/announce-gen
+  build-aux/config.guess
+  build-aux/config.sub
+  build-aux/gendocs.sh
+  build-aux/git-version-gen
+  build-aux/gitlog-to-changelog
+  build-aux/gnupload
+  build-aux/install-sh
+  build-aux/mdate-sh
+  build-aux/move-if-change
+  build-aux/texinfo.tex
+  build-aux/update-copyright
+  build-aux/useless-if-before-free
+  build-aux/vc-list-files
+  doc/fdl.texi
+  doc/gendocs_template
+  doc/gnu-oids.texi
+  doc/make-stds.texi
+  doc/standards.texi
+  m4/autobuild.m4
+  top/GNUmakefile
+  top/maint.mk
+);
+
+our @automake_files = qw(
+  lib/Automake/Channels.pm
+  lib/Automake/Configure_ac.pm
+  lib/Automake/FileUtils.pm
+  lib/Automake/Getopt.pm
+  lib/Automake/XFile.pm
+);
+
+
+# Shorthands for catpath and splitpath.
+# File::Spec::Functions was only added in 5.30, which is much too new.
+sub catpath
+{
+  return File::Spec->catpath (@_);
+}
+
+sub splitpath
+{
+  return File::Spec->splitpath (@_);
+}
+
+
+# urlquote($s)
+# Returns $s, %-quoted appropriately for interpolation into the
+# path or query component of a URL.  Assumes that non-ASCII characters
+# should be encoded in UTF-8 before quoting.
+sub urlquote($)
+{
+  my ($s) = @_;
+
+  utf8::encode($s);
+  use bytes;
+  $s =~ s!
+    [^./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz~-]
+   !
+    sprintf("%%%02X", ord($&))
+   !egx;
+  return $s;
+}
+
+
+# savannah_url($repo, $filename)
+# Returns the URL from which the contents of $filename within $repo
+# can be retrieved, assuming $repo is the name of a savannah.gnu.org
+# Git repository.
+sub savannah_url($$)
+{
+  my ($repo, $filename) = @_;
+
+  my $gitweb_base = 'https://git.savannah.gnu.org/gitweb/?p=';
+  my $gitweb_op   = '.git;a=blob_plain;hb=HEAD;f=';
+
+  return $gitweb_base . urlquote ($repo) . $gitweb_op . urlquote ($filename);
+}
+
+
+# slurp ($filename)
+# Read the contents of $filename into a scalar and return them.
+sub slurp ($)
+{
+  my ($filename) = @_;
+  local $/; # engage slurp mode
+  open my $fh, '<', $filename
+    or die "$filename: $!\n";
+  return scalar <$fh>;
+}
+
+
+# replace_if_change ($file, $newcontents, $quiet)
+# If $newcontents is different from the contents of $file,
+# atomically replace $file's contents with $newcontents.
+# This function assumes POSIX semantics for rename over an existing
+# file (i.e.  atomic replacement, not an error).
+sub replace_if_change ($$$)
+{
+  my ($file, $newcontents, $quiet) = @_;
+  my $oldcontents = slurp $file;
+
+  if ($oldcontents eq $newcontents)
+    {
+      print STDERR "$file is unchanged\n" unless $quiet;
+      return;
+    }
+
+  my ($vol, $subdir, $base) = splitpath $file;
+  my ($tmp_fh, $tmp_name) = tempfile (DIR => catpath ($vol, $subdir));
+
+  {
+    local $\;
+    local $,;
+    print $tmp_fh $newcontents;
+  }
+  close $tmp_fh
+    or die "$0: writing to $tmp_name: $!\n";
+
+  # Preserve the permissions of the original file.
+  my $st = stat $file;
+  chmod (S_IMODE ($st->mode), $tmp_name)
+    or die "$0: setting permissions on $tmp_name: $!\n";
+
+  rename $tmp_name, $file
+    or die "$0: rename($tmp_name, $file): $!\n";
+
+  print STDERR "$file updated\n" unless $quiet;
+}
+
+
+# fetch ($path, $repo, $topdestdir, $edit, $quiet, $client)
+# Retrieve $path from repository $repo, writing it to $topdestdir/$path.
+# As a special case, if the dirname of $path is "top/", then write it
+# to $topdestdir/$(basename $file) instead.
+# If $edit is true, perform s/\bAutomake::/Autom4te::/g on the file's
+# contents.
+# If $quiet is true, don't print progress reports.
+# $client must be a HTTP::Tiny instance.
+sub fetch ($$$$$$)
+{
+  my ($path, $repo, $topdestdir, $edit, $quiet, $client) = @_;
+  my ($vol, $subdir, $file) = splitpath ($path);
+  my $destpath = ($subdir eq 'top/')
+    ? catpath($topdestdir, $file)
+    : catpath($topdestdir, $path);
+
+  $destpath =~ s!/Automake/!/Autom4te/!g if $edit;
+
+  my $uri = savannah_url ($repo, $path);
+  print STDERR "fetch $path <- $uri ...\n" unless $quiet;
+
+  my $resp = $client->get ($uri);
+
+  die "$uri: $resp->{status} $resp->{reason}\n"
+    unless $resp->{success};
+
+  my $content = $resp->{content};
+  $content =~ s/\bAutomake::/Autom4te::/g if $edit;
+
+  replace_if_change ($destpath, $content, $quiet);
+}
+
+
+sub main
+{
+  my $quiet = 0;
+  GetOptions ('quiet|q' => \$quiet)
+    or die "usage: $0 [-q] destination-directory\n";
+
+  my $topdestdir = shift @ARGV
+    or die "usage: $0 [-q] destination-directory\n";
+
+  $#ARGV == -1
+    or die "usage: $0 [-q] destination-directory\n";
+
+  my $client = HTTP::Tiny->new(
+    agent => 'autoconf-fetch.pl/1.0 ',
+    keep_alive => 1,
+    verify_SSL => 1
+  );
+
+  my ($can_ssl, $whynot) = $client->can_ssl;
+  die "$0: HTTPS support not available"
+    . " (do you need to install IO::Socket::SSL?\n"
+    . $whynot . "\n"
+    unless $can_ssl;
+
+  fetch $_, 'gnulib', $topdestdir, 0, $quiet, $client
+    foreach @gnulib_files;
+
+  fetch $_, 'automake', $topdestdir, 1, $quiet, $client
+    foreach @automake_files;
+}
+
+main ();
+
+### Setup "GNU" style for perl-mode and cperl-mode.
+## Local Variables:
+## perl-indent-level: 2
+## perl-continued-statement-offset: 2
+## perl-continued-brace-offset: 0
+## perl-brace-offset: 0
+## perl-brace-imaginary-offset: 0
+## perl-label-offset: -2
+## cperl-indent-level: 2
+## cperl-brace-offset: 0
+## cperl-continued-brace-offset: 0
+## cperl-label-offset: -2
+## cperl-extra-newline-before-brace: t
+## cperl-merge-trailing-else: nil
+## cperl-continued-statement-offset: 2
+## End:
diff --git a/build-aux/fetch.sh b/build-aux/fetch.sh
deleted file mode 100755
index f5a5537a..00000000
--- a/build-aux/fetch.sh
+++ /dev/null
@@ -1,78 +0,0 @@
-#! /bin/sh
-
-: "${WGET=wget}"
-: "${PERL=perl}"
-
-gitweb_base="https://git.savannah.gnu.org/gitweb/?p="
-gitweb_op=";a=blob_plain;hb=HEAD;f="
-
-gnulib_gitweb="${gitweb_base}gnulib.git${gitweb_op}"
-automake_gitweb="${gitweb_base}automake.git${gitweb_op}"
-
-# This list should be in alphabetical order, *except* that this script
-# uses move-if-change itself, so that one should be first.
-gnulib_files="
-	build-aux/move-if-change
-	build-aux/announce-gen
-	build-aux/config.guess
-	build-aux/config.sub
-	build-aux/gendocs.sh
-	build-aux/git-version-gen
-	build-aux/gitlog-to-changelog
-	build-aux/gnupload
-	build-aux/install-sh
-	build-aux/mdate-sh
-	build-aux/texinfo.tex
-	build-aux/update-copyright
-	build-aux/useless-if-before-free
-	build-aux/vc-list-files
-	doc/fdl.texi
-	doc/gendocs_template
-	doc/gnu-oids.texi
-	doc/make-stds.texi
-	doc/standards.texi
-	m4/autobuild.m4
-	top/GNUmakefile
-	top/maint.mk
-"
-
-automake_files="
-        lib/Automake/Channels.pm
-        lib/Automake/Configure_ac.pm
-        lib/Automake/FileUtils.pm
-        lib/Automake/Getopt.pm
-        lib/Automake/XFile.pm
-"
-
-srcdir="$1"
-shift
-
-move_if_change="${srcdir}/build-aux/move-if-change"
-
-scratch="$(mktemp -p . -d fetch.XXXXXXXXX)"
-trap "rm -rf '$scratch'" 0
-
-run () {
-    printf '+ %s\n' "$*"
-    "$@" || exit 1
-}
-
-for file in $gnulib_files; do
-    fbase="${file##*/}"
-    destdir="${file%/*}"
-    if [ "$destdir" = top ]; then
-        dest="${srcdir}/${fbase}"
-    else
-        dest="${srcdir}/${file}"
-    fi
-    run "$WGET" -nv -O "${scratch}/${fbase}" "${gnulib_gitweb}${file}"
-    run "$move_if_change" "${scratch}/${fbase}" "$dest"
-done
-
-for file in $automake_files; do
-    fbase="${file##*/}"
-    dest="${srcdir}/lib/Autom4te/${fbase}"
-    run "$WGET" -nv -O "${scratch}/${fbase}" "${automake_gitweb}${file}"
-    run "$PERL" -pi -e 's/Automake::/Autom4te::/g' "${scratch}/${fbase}"
-    run "$move_if_change" "${scratch}/${fbase}" "$dest"
-done
diff --git a/cfg.mk b/cfg.mk
index e6dc4996..33ad6e06 100644
--- a/cfg.mk
+++ b/cfg.mk
@@ -48,12 +48,8 @@ Mail-Followup-To: autoconf@gnu.org
 
 # Update files maintained in gnulib and autom4te.
 .PHONY: fetch
-
-WGET = wget
-
 fetch:
-	WGET="$(WGET)" PERL="$(PERL)" \
-	    $(SHELL) $(srcdir)/build-aux/fetch.sh "$(abs_top_srcdir)"
+	$(PERL) $(srcdir)/build-aux/fetch.pl "$(abs_top_srcdir)"
 
 # Tests not to run.
 local-checks-to-skip ?= \