summaryrefslogtreecommitdiff
path: root/sync-all
diff options
context:
space:
mode:
authorThomas Miedema <thomasmiedema@gmail.com>2015-08-21 00:47:16 +0200
committerThomas Miedema <thomasmiedema@gmail.com>2015-08-21 00:47:16 +0200
commit98f8c9e597bc54b16f588a4641d8fe3bad36c7bb (patch)
tree312473e5de11365f692270cf88496a91c8a81de8 /sync-all
parentb6be81b841e34ca45b3549c4c79e886a8761e59a (diff)
downloadhaskell-98f8c9e597bc54b16f588a4641d8fe3bad36c7bb.tar.gz
Delete sync-all
Diffstat (limited to 'sync-all')
-rwxr-xr-xsync-all1023
1 files changed, 0 insertions, 1023 deletions
diff --git a/sync-all b/sync-all
deleted file mode 100755
index ef5d24a85d..0000000000
--- a/sync-all
+++ /dev/null
@@ -1,1023 +0,0 @@
-#!/usr/bin/env perl
-
-use warnings;
-use strict;
-use Cwd;
-use English;
-
-$| = 1; # autoflush stdout after each print, to avoid output after die
-
-my $initial_working_directory;
-
-my $default_root;
-my @packages;
-my $verbose = 2;
-my $try_to_resume = 0;
-my $ignore_failure = 0;
-my $checked_out_flag = 0; # NOT the opposite of bare_flag (describes remote repo state)
-my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo state)
-
-my %tags;
-
-my $GITHUB = qr!(?:git@|git://|https://|http://|ssh://git@)github.com!;
-
-sub inDir {
- my $dir = shift;
- my $code = shift;
-
- if ($dir ne '.') {
- chdir($dir);
- }
-
- my $result = &$code();
-
- if ($dir ne '.') {
- chdir($initial_working_directory);
- }
- return $result;
-}
-
-sub parsePackages {
- my @repos;
- my $lineNum;
-
- open IN, "< packages.conf"
- or open IN, "< packages" # clashes with packages directory when using --bare
- or die "Can't open packages file (or packages.conf)";
- @repos = <IN>;
- close IN;
-
- @packages = ();
- $lineNum = 0;
- foreach (@repos) {
- chomp;
- $lineNum++;
- if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
- my %line;
- $line{"localpath"} = $1;
- $line{"tag"} = $2;
- $line{"remotepath"} = $3;
- $line{"upstreamurl"}= $4;
- push @packages, \%line;
-
- $tags{$2} = 0;
- }
- elsif (! /^(#.*)?$/) {
- die "Bad content on line $lineNum of packages file: $_";
- }
- }
-}
-
-sub message {
- if ($verbose >= 2) {
- print "@_\n";
- }
-}
-
-sub warning {
- if ($verbose >= 1) {
- print "warning: @_\n";
- }
-}
-
-sub gitNewWorkdir {
- my $dir = shift;
- my $target = shift;
- my $target_dir = "$target/$dir";
-
- if ($dir eq '.') {
- message "== running git-new-workdir . $target_dir @_";
- } else {
- message "== $dir: running git-new-workdir . $target_dir @_";
- chdir($dir);
- }
-
- system ("git-new-workdir", ".", $target_dir, @_) == 0
- or $ignore_failure
- or die "git-new-workdir failed: $?";
-
- if ($dir ne '.') {
- chdir($initial_working_directory);
- }
-}
-
-sub git {
- my $dir = shift;
- my @args = @_;
-
- &inDir($dir, sub {
- my $prefix = $dir eq '.' ? "" : "$dir: ";
- message "== ${prefix}running git @args";
-
- system ("git", @args) == 0
- or $ignore_failure
- or die "git failed: $?";
- });
-}
-
-sub readgitline {
- my $dir = shift;
- my @args = @_;
-
- &inDir($dir, sub {
- open my $fh, '-|', 'git', @args
- or die "Executing git @args failed: $!";
- my $line = <$fh>;
- $line = "" unless defined($line);
- chomp $line;
- close $fh;
- return $line;
- });
-}
-
-sub readgit {
- my $dir = shift;
- my @args = @_;
-
- &inDir($dir, sub {
- open my $fh, '-|', 'git', @args
- or die "Executing git @args failed: $!";
- my $ret;
- $ret .= $_ while <$fh>;
- close $fh;
- return $ret;
- });
-}
-
-sub configure_repository {
- my $localpath = shift;
-
- &git($localpath, "config", "core.ignorecase", "true");
-
- my $autocrlf = &readgitline($localpath, 'config', '--get', 'core.autocrlf');
- if ($autocrlf eq "true") {
- &git($localpath, "config", "core.autocrlf", "false");
- &git($localpath, "reset", "--hard");
- }
-}
-
-# Figure out where to get the other repositories from.
-sub getrepo {
- my $repo;
-
- if ($default_root) {
- $repo = $default_root;
- } else {
- # Figure out where to get the other repositories from,
- # based on where this GHC repository came from.
- my $git_dir = $bare_flag ? "ghc.git" : ".";
- my $branch = &readgitline($git_dir, "rev-parse", "--abbrev-ref", "HEAD");
- die "Bad branch: $branch"
- unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
- my $remote = &readgitline($git_dir, "config", "--get", "branch.$branch.remote");
- if ($remote eq "") {
- # remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
- $remote = "origin";
- }
- die "Bad remote: $remote"
- unless $remote =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
- $repo = &readgitline($git_dir, "config", "--get", "remote.$remote.url");
- }
-
- my $remote_root;
- my $checked_out_tree;
- my $repo_local = 0;
-
- if ($repo =~ /^...*:/) {
- # HTTP or SSH
- # Above regex says "at least two chars before the :", to avoid
- # catching Win32 drives ("C:\").
- $remote_root = $repo;
-
- # --checked-out is needed if you want to use a checked-out
- # repository over SSH or HTTP
- $checked_out_tree = $checked_out_flag;
-
- # Don't drop the last part of the path if specified with -r, as
- # it expects repos of the form:
- #
- # git://git.haskell.org
- #
- # rather than
- #
- # git://git.haskell.org/ghc.git
- #
- if (!$default_root) {
- $remote_root =~ s#/[^/]+/?$##;
- }
- }
- elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
- # Local filesystem, either absolute (C:/ or /) or relative (../) path
- $repo_local = 1;
- $remote_root = $repo;
- if (-f "$repo/HEAD") {
- # assume a local mirror:
- $checked_out_tree = 0;
- $remote_root =~ s#/[^/]+/?$##;
- } elsif (-d "$repo/ghc.git") {
- # assume a local mirror:
- $checked_out_tree = 0;
- } else {
- # assume a checked-out tree:
- $checked_out_tree = 1;
- }
- }
- else {
- die "Couldn't work out root of remote repository tree";
- }
-
- return $remote_root, $checked_out_tree, $repo_local;
-}
-
-sub gitall {
- my $command = shift;
-
- my $localpath;
- my $tag;
- my $remotepath;
- my $line;
- my $repo_is_submodule;
- my $remote_name;
- my $subcommand;
-
- my $path;
-
- my @args;
-
- my $started;
- my $doing;
- my $start_repo;
-
- my ($remote_root, $checked_out_tree, $repo_local) = getrepo();
-
- my $is_github_repo = $remote_root =~ $GITHUB;
-
- @args = ();
-
- if ($command =~ /^remote$/) {
- while (@_ > 0 && $_[0] =~ /^-/) {
- push(@args,shift);
- }
- if (@_ < 1) { help(1); }
- $subcommand = shift;
- if ($subcommand ne 'add' &&
- $subcommand ne 'rm' &&
- $subcommand ne 'set-branches' &&
- $subcommand ne 'set-url') {
- help(1);
- }
- while (@_ > 0 && $_[0] =~ /^-/) {
- push(@args,shift);
- }
- if (($subcommand eq 'set-branches') && @_ < 2) {
- help(1);
- } elsif (($subcommand eq 'add' || $subcommand eq 'rm') && @_ < 1) {
- help(1);
- } elsif (@_ < 1) { # set-url
- $remote_name = 'origin';
- } else {
- $remote_name = shift;
- }
- } elsif ($command eq 'new') {
- if (@_ < 1) {
- $remote_name = 'origin';
- } else {
- $remote_name = shift;
- }
- }
-
- push(@args, @_);
-
- # $doing is a good enough approximation to what we are doing that
- # we can use it to check that --resume is resuming the right command
- $doing = join(" ", ($command, @args));
- $started = 1;
- if ($try_to_resume && -f "resume") {
- my $what;
- open RESUME, "< resume"
- or die "Can't open resume file";
- $start_repo = <RESUME>;
- chomp $start_repo;
- $what = <RESUME>;
- chomp $what;
- close RESUME;
- if ($what eq $doing) {
- $started = 0;
- }
- }
-
- for $line (@packages) {
- $tag = $$line{"tag"};
- if ($tags{$tag} == 0) {
- next;
- }
-
- # Use the "remote" structure for bare git repositories
- $localpath = ($bare_flag) ?
- $$line{"remotepath"} : $$line{"localpath"};
-
- if (!$started) {
- if ($start_repo eq $localpath) {
- $started = 1;
- }
- else {
- next;
- }
- }
-
- open RESUME, "> resume.tmp";
- print RESUME "$localpath\n";
- print RESUME "$doing\n";
- close RESUME;
- rename "resume.tmp", "resume";
-
- $repo_is_submodule = $$line{"remotepath"} eq "-";
-
- if ($checked_out_tree) {
- $remotepath = $$line{"localpath"};
- }
- elsif ($repo_is_submodule) {
- $remotepath = &readgitline(".", 'config', '-f', '.gitmodules', '--get', "submodule.$localpath.url");
- $remotepath =~ s/\.\.\///;
- }
- else {
- $remotepath = $$line{"remotepath"};
- }
-
- # We can't create directories on GitHub, so we translate
- # "packages/foo" into "package-foo".
- if ($is_github_repo) {
- $remotepath =~ s/\//-/;
- }
-
- # Construct the path or url of the remote repository.
- $path = "$remote_root/$remotepath";
-
- if ($command eq "get") {
- next if $repo_is_submodule; # "git submodule init/update" will get this later
-
- if (-d $localpath) {
- warning("$localpath already present; omitting")
- if $localpath ne ".";
- &configure_repository($localpath);
- next;
- }
-
- # Note that we use "." as the path, as $localpath
- # doesn't exist yet.
- my @argsWithBare = @args;
- push @argsWithBare, $bare_flag if $bare_flag;
- &git(".", "clone", $path, $localpath, @argsWithBare);
- &configure_repository($localpath);
- next;
- }
-
- my $git_repo_present = 1 if -e "$localpath/.git" || ($bare_flag && -d "$localpath");
- if (not $git_repo_present) {
- if ($tag eq "-") {
- die "Required repo $localpath is missing. Please first run './sync-all get'.\n";
- }
- else {
- message "== $localpath repo not present; skipping";
- next;
- }
- }
-
- # Work out the arguments we should give to the SCM
- if ($command eq "status") {
- &git($localpath, $command, @args);
- }
- elsif ($command eq "commit") {
- # git fails if there is nothing to commit, so ignore failures
- $ignore_failure = 1;
- &git($localpath, "commit", @args);
- }
- elsif ($command eq "check_submodules") {
- # If we have a submodule then check whether it is up-to-date
- if ($repo_is_submodule) {
- my %remote_heads;
-
- message "== Checking sub-module $localpath";
-
- chdir($localpath);
-
- open my $lsremote, '-|', 'git', 'ls-remote', '--heads', '-q'
- or die "Executing ls-remote failed: $!";
- while (<$lsremote>) {
- if (/^([0-9a-f]{40})\s*refs\/heads\//) {
- $remote_heads{$1} = 1;
- }
- else {
- die "Bad output from ls-remote: $_";
- }
- }
- close($lsremote);
-
- my $myhead = &readgitline('.', 'rev-parse', '--verify', 'HEAD');
-
- if (not defined($remote_heads{$myhead})) {
- die "Sub module $localpath needs to be pushed; see http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream";
- }
-
- chdir($initial_working_directory);
- }
- }
- elsif ($command eq "push") {
- # We don't automatically push to the submodules. If you want
- # to push to them then you need to use a special command, as
- # described on
- # http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream
- if (!$repo_is_submodule) {
- &git($localpath, "push", @args);
- }
- }
- elsif ($command eq "pull") {
- my $realcmd;
- my @realargs;
- if ($repo_is_submodule) {
- # Only fetch for the submodules. "git submodule update"
- # will take care of making us point to the right commit.
- $realcmd = "fetch";
- # we like "sync-all pull --rebase" to work:
- @realargs = grep(!/--rebase/,@args);
- }
- else {
- $realcmd = "pull";
- @realargs = @args;
- }
- &git($localpath, $realcmd, @realargs);
- }
- elsif ($command eq "new-workdir") {
- gitNewWorkdir ($localpath, @args);
- }
- elsif ($command eq "send") {
- &git($localpath, $command, @args);
- }
- elsif ($command eq "fetch") {
- &git($localpath, "fetch", @args);
- }
- elsif ($command eq "new") {
- my @scm_args = ("log", "$remote_name..");
- &git($localpath, @scm_args, @args);
- }
- elsif ($command eq "log") {
- &git($localpath, "log", @args);
- }
- elsif ($command eq "remote") {
- my @scm_args;
- $ignore_failure = 1;
- if ($subcommand eq 'add') {
- @scm_args = ("remote", "add", $remote_name, $path);
- } elsif ($subcommand eq 'rm') {
- @scm_args = ("remote", "rm", $remote_name);
- } elsif ($subcommand eq 'set-branches') {
- @scm_args = ("remote", "set-branches", $remote_name);
- } elsif ($subcommand eq 'set-url') {
- @scm_args = ("remote", "set-url", $remote_name, $path);
- }
- &git($localpath, @scm_args, @args);
- }
- elsif ($command eq "checkout") {
- # Not all repos are necessarily branched, so ignore failure
- $ignore_failure = 1;
- &git($localpath, "checkout", @args);
- }
- elsif ($command eq "grep") {
- # Hack around 'git grep' failing if there are no matches
- $ignore_failure = 1;
- &git($localpath, "grep", @args);
- }
- elsif ($command eq "diff") {
- &git($localpath, "diff", @args);
- }
- elsif ($command eq "clean") {
- &git($localpath, "clean", @args);
- }
- elsif ($command eq "reset") {
- &git($localpath, "reset", @args);
- }
- elsif ($command eq "branch") {
- &git($localpath, "branch", @args);
- }
- elsif ($command eq "config") {
- &git($localpath, "config", @args);
- }
- elsif ($command eq "repack") {
- &git($localpath, "repack", @args);
- }
- elsif ($command eq "format-patch") {
- &git($localpath, "format-patch", @args);
- }
- elsif ($command eq "gc") {
- &git($localpath, "gc", @args);
- }
- elsif ($command eq "tag") {
- &git($localpath, "tag", @args);
- }
- elsif ($command eq "compare") {
- # Don't compare the submodules; it doesn't work properly as
- # they aren't on a branch.
- next if $repo_is_submodule;
-
- my $compareto;
- if ($#args eq -1) {
- $compareto = $path;
- }
- elsif ($#args eq 0) {
- $compareto = "$args[0]/$localpath";
- }
- elsif ($#args eq 1 && $args[0] eq "-b") {
- $compareto = "$args[1]/$remotepath";
- }
- else {
- die "Bad args for compare";
- }
- printf "%*s", -40, $localpath;
- my $branch = &readgitline($localpath, "rev-parse", "--abbrev-ref", "HEAD");
- die "Bad branch: $branch"
- unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
- my $us = &readgitline(".", "ls-remote", $localpath, "refs/heads/$branch");
- my $them = &readgitline(".", "ls-remote", $compareto, "refs/heads/$branch");
- $us =~ s/[[:space:]].*//;
- $them =~ s/[[:space:]].*//;
- die "Bad commit of mine: $us" unless (length($us) eq 40);
- die "Bad commit of theirs: $them" unless (length($them) eq 40);
- print $us eq $them ? "same" : "DIFFERENT", "\n";
- }
- else {
- die "Unknown command: $command";
- }
- }
-
- unlink "resume", "resume.tmp";
-}
-
-sub gitInitSubmodules {
- &git(".", "submodule", "init", @_);
-
- my ($remote_root, $checked_out_tree, $repo_local) = getrepo();
-
- my $submodulespaths = &readgit(".", "config", "--get-regexp", "^submodule[.].*[.]url");
- # if we came from github, change the urls appropriately
- while ($submodulespaths =~ m!^(submodule.(?:libraries/|utils/)?[a-zA-Z0-9-]+.url) ($GITHUB)/ghc/packages/([a-zA-Z0-9-]+).git$!gm) {
- &git(".", "config", $1, "$2/ghc/packages-$3");
- }
-
- # if we came from a local repository, grab our submodules from their
- # checkouts over there, if they exist.
- if ($repo_local) {
- while ($submodulespaths =~ m!^(submodule.((?:libraries/|utils/)?[a-zA-Z0-9-]+).url) .*$!gm) {
- if (-e "$remote_root/$2/.git") {
- &git(".", "config", $1, "$remote_root/$2");
- }
- }
- }
-}
-
-sub checkCurrentBranchIsMaster {
- my $branch = &readgitline(".", "rev-parse", "--abbrev-ref", "HEAD");
-
- if ($branch !~ /master/) {
- print "\nWarning: You are trying to 'pull' while on branch '$branch'.\n"
- . "Updates to this script will happen on the master branch which\n"
- . "means the version on this branch may be out of date.\n\n";
- }
-}
-
-sub help
-{
- my $exit = shift;
-
- my $tags = join ' ', sort (grep !/^-$/, keys %tags);
-
- print <<END;
-Usage:
-
-./sync-all [-q] [-s] [--ignore-failure] [-r remote-root] [--checked-out]
- [--bare] [--<tag>] [--no-<tag>] [--resume] cmd [git flags]
-
- where <tag> is one of: $tags
-
-Applies the command "cmd" to each repository and submodule in the local
-tree.
-
-A full repository tree is obtained by first cloning the ghc repository,
-then getting the subrepositories and submodules with "sync-all get":
-
- \$ git clone git://git.haskell.org/ghc.git
- \$ cd ghc
- \$ ./sync-all get
-
-After this, "./sync-all pull" will pull from the original repository
-tree.
-
-If you want to clone your own GitHub fork instead, add an argument to
-sync-all to tell it where it can find the other repositories it needs.
-
- \$ git clone <your preferred github.com GHC fork URL> ghc
- \$ cd ghc
- \$ ./sync-all -r git://github.com/ghc get
-
-Another commonly used feature is to add remotes pointing to another
-repository tree like this:
-
- \$ ./sync-all -r /path/to/other/ghc remote add otherghc
-
-and then to pull from that other tree with
-
- \$ ./sync-all pull otherghc
-
--------------- Commands -----------------
-get
-
- Gets all subrepositories and submodules from the same place that the
- ghc repository was cloned from. See "layout of remote tree" below
- for details of how the subrepositories and submodules are laid
- out.
-
- There are various --<package-tag> options that can be given before
- "get" that enable extra subrepositories. The full list is given at
- the end of this help. For example:
-
- ./sync-all --nofib get
-
- would get the nofib subrepository in addition to the usual set of
- subrepositories and submodules.
-
-remote [-r remote-root] add <remote-name>
-remote rm <remote-name>
-remote [-r remote-root] set-url [--push] <remote-name>
-remote set-branches <remote-name> <branch>...
-
- Runs a "git remote" command on each repository and submodule in the
- local tree. For the "add" and "set-url" subcommands, the url the
- remotes will point to are adjusted according to the inferred layout
- of the remote tree (see "layout of remote tree" below). For example,
- to add new remotes pointing to the repositories on GitHub:
-
- ./sync-all -r git://github.com/ghc remote add github
-
- The <remote-root> should be the root of a repository tree (see
- "layout of remote tree" below). For a checked-out tree it would
- point to the ghc directory, otherwise it points to a directory
- containing "ghc.git".
-
-compare
-compare <remote-root>
-compare -b <remote-root>
-
- Compare the git HEADs of the repositories to the origin
- repositories, or the repositories under <remote-root> (which is
- assumed to be a checked-out tree unless the -b flag is used).
-
- 1 line is printed for each repository, indicating whether the
- repository is at the "same" or a "DIFFERENT" commit.
-
-These commands just run the equivalent git command on each repository
-and submodule, passing any extra arguments to git:
-
- branch
- checkout
- clean
- commit
- config
- diff
- fetch
- format-patch
- gc
- grep
- log
- new
- new-workdir
- pull
- push
- repack
- reset
- send
- status
- tag
-
--------------- Flags -------------------
-
-These flags are given *before* the command and modify the way sync-all
-behaves. Flags given *after* the command are passed to git.
-
- -q says to be quiet, and -s to be silent.
-
- --resume will restart a command that failed, from the repository or
- submodule at which it failed. This means you don't need to wait while,
- e.g., "pull" goes through all the repositories it's just pulled, and
- tries to pull them again.
-
- --ignore-failure says to ignore errors and move on to the next
- repository or submodule
-
- -r <remote-root> says that the remote repository tree can be found at
- <remote-root>, instead of where this GHC repository came from. Only
- useful in combination with 'sync-all get' and 'sync-all remote'.
-
- --checked-out says that the remote repositories are a checked-out
- tree, as opposed to a collection of bare repositories. By default a
- repository on the local filesystem is assumed to be
- checked-out, and repositories accessed via HTTP or SSH are assumed to
- be bare; use --checked-out to override the latter.
-
- --bare says that the local repo is in bare layout, same as the main repo. It
- also means that these repos are bare. You only have to use this flag if you
- don't have a bare ghc.git in the current directory and would like to 'get'
- all of the repos bare. Requires packages.conf to be present in the current
- directory (a renamed packages file from the main ghc repo).
-
- Note: --checked-out and --bare flags are NOT the opposite of each other.
- --checked-out: describes the layout of the remote repository tree.
- --bare: describes the layout of the local repository tree.
-
- --nofib also clones the nofib benchmark suite
-
- --extra clones some extra library packages (see the packages file for
- the current list)
-
- --windows also clones the ghc-tarballs repository (enabled by default
- on Windows)
-
- --no-dph avoids cloning the dph repositories
-
-
------------- Checking out a branch -------------
-
-To check out a branch you can run the following command:
-
- \$ ./sync-all checkout ghc-7.4
-
-
------------- Layout of remote tree -------------
-
-sync-all uses the following algorithm to guess the layout of the remote
-tree
-
-It always computes the urls or paths of the remote repositories from a
-single root, <remote-root>. If you say "-r <remote-root>", then that sets
-<remote-root>. Otherwise, <remote-root> is inferred by asking git where
-the local ghc repository came from, and removing the last component
-(e.g. /ghc.git). The last component is not removed when the
-remote repository is checked-out (appears to be on the local filesystem
-or the flag --checked-out is given).
-
-Then sync-all iterates over the repositories found in the file packages;
-see that file for a description of the contents.
-
-If <remote-root> looks like a local filesystem path, or if you give the
---checked-out flag, sync-all works on remote repositories of form:
-
- <remote-root>/<local-path>
-
-Otherwise, if a particular repository is a submodule, sync-all uses:
-
- <remote-root>/<submodule-url>
-
-Else, sync-all works on remote repositories of form:
-
- <remote-root>/<remote-path>
-
-In these, <local-path> and <remote-path> are taken from the packages
-file, and <submodule-url> is taken from the file .gitmodules.
-
-Besides all this, there is special handling for GitHub links.
-
-This logic lets you say
- both sync-all -r http://example.org/ghc-6.12 remote add ghc-6.12
- and sync-all -r ../working remote add working
-
-Available package-tags are: $tags
-
-END
- exit $exit;
-}
-
-sub main {
-
- &parsePackages();
-
- $tags{"-"} = 1;
- $tags{"dph"} = 1;
- if ($OSNAME =~ /^(MSWin32|Cygwin|msys)$/) {
- $tags{"windows"} = 1;
- }
-
- while ($#_ ne -1) {
- my $arg = shift;
- # We handle -q here as well as lower down as we need to skip over it
- # if it comes before the source-control command
- if ($arg eq "-q") {
- $verbose = 1;
- }
- elsif ($arg eq "-s") {
- $verbose = 0;
- }
- elsif ($arg eq "-r") {
- $default_root = shift;
- }
- elsif ($arg eq "--resume") {
- $try_to_resume = 1;
- }
- elsif ($arg eq "--ignore-failure") {
- $ignore_failure = 1;
- }
- # Use --checked-out if the _remote_ repositories are a
- # checked-out tree, rather than a collection of bare
- # repositories.
- elsif ($arg eq "--checked-out") {
- $checked_out_flag = 1;
- }
- # Use --bare if the _local_ repos are bare repos,
- # rather than a checked-out tree.
- elsif ($arg eq "--bare") {
- $bare_flag = $arg;
- }
- elsif ($arg eq "--help") {
- help(0);
- }
- # --<tag> says we grab the libs tagged 'tag' with
- # 'get'. It has no effect on the other commands.
- elsif ($arg =~ m/^--no-(.*)$/ && defined($tags{$1})) {
- $tags{$1} = 0;
- }
- elsif ($arg =~ m/^--(.*)$/ && defined($tags{$1})) {
- $tags{$1} = 1;
- }
- elsif ($arg =~ m/^-/) {
- die "Unrecognised flag: $arg";
- }
- else {
- unshift @_, $arg;
- if (grep /^-q$/, @_) {
- $verbose = 1;
- }
- last;
- }
- }
-
- # check for ghc repositories in cwd
- my $checked_out_found = 1 if (-d ".git" && -d "compiler");
- my $bare_found = 1 if (-d "ghc.git");
-
- if ($bare_flag && ! $bare_found && ! $default_root) {
- die "error: bare repository ghc.git not found.\n"
- . " Either clone a bare ghc repo first or specify the repo location. E.g.:\n"
- . " ./sync-all --bare [--nofib --extra] -r http://git.haskell.org get\n"
- }
- elsif ($bare_found) {
- $bare_flag = "--bare";
- }
- elsif (! $bare_flag && ! $checked_out_found) {
- die "error: sync-all must be run from the top level of the ghc tree.";
- }
-
- if ($#_ eq -1) {
- help(1);
- }
- else {
- # Give the command and rest of the arguments to the main loop
- # We normalise command names here to avoid duplicating the
- # abbreviations that we allow.
- my $command = shift;
-
- if ($command =~ /^(?:g|ge|get)$/) {
- $command = "get";
- }
- elsif ($command =~ /^(?:pus|push)$/) {
- $command = "push";
- }
- elsif ($command =~ /^(?:pul|pull)$/) {
- $command = "pull";
- }
- elsif ($command =~ /^(?:s|se|sen|send|send-email)$/) {
- $command = "send-email";
- }
- elsif ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew|status)$/) {
- $command = "status";
- }
-
- if ($command eq "push") {
- &gitall("check_submodules", @_);
- }
-
- &gitall($command, @_);
-
- my @submodule_args = grep(/^-q/,@_);
-
- if ($command eq "get") {
- &gitInitSubmodules(@submodule_args);
- }
-
- if ($command eq "get" or $command eq "pull") {
- &git(".", "submodule", "update", @submodule_args);
- }
- }
-}
-
-BEGIN {
- my %argvHash = map { $_, 1 } @ARGV;
- if ($argvHash {"pull"}) {
- checkCurrentBranchIsMaster();
- }
- $initial_working_directory = getcwd();
-
- my @obsolete_dirs = qw!
- testsuite
- libraries/base
- libraries/ghc-prim
- libraries/template-haskell
- libraries/integer-gmp
- libraries/integer-simple
- !;
- for my $dir (@obsolete_dirs) {
- if (-e "$dir/.git") {
- print <<EOF;
-============================
-ATTENTION!
-
-You have a left-over $dir/.git folder in your GHC tree!
-
-Please backup or remove it (e.g. "rm -r $dir/.git") before
-proceeding as the aforesaid Git repository is now tracked as part of
-the ghc Git repository (see #8545 for more details)
-============================
-EOF
- die "detected obsolete $dir/.git folder"
- }
- }
-}
-
-END {
- my $ec = $?;
-
- chdir($initial_working_directory);
-
- my @obsolete_dirs = (
- ["utils/haddock", "87e2ca11c3d1b1bc49900fba0b5c5c6f85650718"],
- ["libraries/binary", "749ac0efbde3b14901417364a872796598747aaf"],
- ["libraries/mtl", "c67d8f7247c612dc35242bc67e616f7ea35eadb9"],
- ["libraries/Cabal", "c8ebd66a32865f72ae03ee0663c62df3d77f08fe"],
- );
- for (@obsolete_dirs) {
- my ($dir, $hash) = @$_;
- my ($name) = $dir =~ m!/([^/]+)$!;
- message "== Checking for old $name repo";
- if (-e "$dir/.git") {
- &inDir($dir, sub {
- if ((system "git log -1 --quiet $hash > /dev/null 2> /dev/null") == 0) {
- print <<EOF;
-============================
-ATTENTION!
-
-You have an old $name repository in your GHC tree!
-
-Please remove it (e.g. "rm -r $dir"), and then run
-"./sync-all get" to get the new repository.
-============================
-EOF
- }
- });
- }
- }
- message "== Checking for old time from tarball";
- if (-f "libraries/time/LICENSE" and ! -e "libraries/time/.git") {
- print <<EOF;
-============================
-ATTENTION!
-
-You have an old time repository in your GHC tree!
-
-Please remove it (e.g. "rm -r libraries/time"), and then run
-"./sync-all get" to get the new repository.
-============================
-EOF
- }
-
- message "== Checking for obsolete Git repository URL";
- my $repo_url = &readgitline(".", 'config', '--get', 'remote.origin.url');
- if ($repo_url =~ /^http:\/\/darcs.haskell.org/) {
- print <<EOF;
-============================
-ATTENTION!
-
-You seem to be using obsolete Git repository URLs.
-
-Please run
-
- ./sync-all -r git://git.haskell.org remote set-url
-
-or (in case port 9418/tcp is filtered by your firewall)
-
- ./sync-all -r http://git.haskell.org remote set-url
-
-to update your local checkout to use the new Git URLs.
-============================
-EOF
- }
-
- $? = $ec;
-}
-
-main(@ARGV);