diff options
Diffstat (limited to 'build-aux/fetch.pl')
| -rwxr-xr-x | build-aux/fetch.pl | 243 |
1 files changed, 243 insertions, 0 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: |