diff options
author | Thomas Miedema <thomasmiedema@gmail.com> | 2015-08-21 00:47:16 +0200 |
---|---|---|
committer | Thomas Miedema <thomasmiedema@gmail.com> | 2015-08-21 00:47:16 +0200 |
commit | 98f8c9e597bc54b16f588a4641d8fe3bad36c7bb (patch) | |
tree | 312473e5de11365f692270cf88496a91c8a81de8 | |
parent | b6be81b841e34ca45b3549c4c79e886a8761e59a (diff) | |
download | haskell-98f8c9e597bc54b16f588a4641d8fe3bad36c7bb.tar.gz |
Delete sync-all
-rwxr-xr-x | sync-all | 1023 |
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); |