summaryrefslogtreecommitdiff
path: root/sync-all
diff options
context:
space:
mode:
Diffstat (limited to 'sync-all')
-rwxr-xr-xsync-all1100
1 files changed, 1100 insertions, 0 deletions
diff --git a/sync-all b/sync-all
new file mode 100755
index 0000000000..70c9639d1c
--- /dev/null
+++ b/sync-all
@@ -0,0 +1,1100 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Cwd;
+use English;
+
+$| = 1; # autoflush stdout after each print, to avoid output after die
+
+my $initial_working_directory;
+my $exit_via_die;
+
+my $defaultrepo;
+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 $get_mode;
+my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo state)
+
+my %tags;
+
+my $GITHUB = qr!(?:git@|git://|https://|http://)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 tryReadFile {
+ my $filename = shift;
+ my @lines;
+
+ open (FH, $filename) or return "";
+ @lines = <FH>;
+ close FH;
+ return join('', @lines);
+}
+
+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", "--local", "core.ignorecase", "true");
+
+ my $autocrlf = &readgitline($localpath, 'config', '--get', 'core.autocrlf');
+ if ($autocrlf eq "true") {
+ &git($localpath, "config", "--local", "core.autocrlf", "false");
+ &git($localpath, "reset", "--hard");
+ }
+}
+
+# Figure out where to get the other repositories from.
+sub getrepo {
+ my $repo;
+
+ if (defined($defaultrepo)) {
+ $repo = $defaultrepo;
+ chomp $repo;
+ } else {
+ # Figure out where to get the other repositories from,
+ # based on where this GHC repo 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", "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", "remote.$remote.url");
+ }
+
+ my $repo_base;
+ 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:\").
+ $repo_base = $repo;
+
+ # --checked-out is needed if you want to use a checked-out repo
+ # over SSH or HTTP
+ if ($checked_out_flag) {
+ $checked_out_tree = 1;
+ } else {
+ $checked_out_tree = 0;
+ }
+
+ # Don't drop the last part of the path if specified with -r, as
+ # it expects repos of the form:
+ #
+ # http://git.haskell.org
+ #
+ # rather than
+ #
+ # http://git.haskell.org/ghc
+ #
+ if (!$defaultrepo) {
+ $repo_base =~ s#/[^/]+/?$##;
+ }
+ }
+ elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
+ # Local filesystem, either absolute (C:/ or /) or relative (../) path
+ $repo_local = 1;
+ $repo_base = $repo;
+ if (-f "$repo/HEAD") {
+ # assume a local mirror:
+ $checked_out_tree = 0;
+ $repo_base =~ 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 repo";
+ }
+
+ return $repo_base, $checked_out_tree, $repo_local;
+}
+
+sub gitall {
+ my $command = shift;
+
+ my $localpath;
+ my $tag;
+ my $remotepath;
+ my $line;
+ my $branch_name;
+ my $subcommand;
+
+ my $path;
+
+ my @args;
+
+ my $started;
+ my $doing;
+ my $start_repo;
+
+ my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
+
+ my $is_github_repo = $repo_base =~ $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 'add' || $subcommand eq 'rm') && @_ < 1) {
+ help(1);
+ } elsif (@_ < 1) { # set-url
+ $branch_name = 'origin';
+ } else {
+ $branch_name = shift;
+ }
+ } elsif ($command eq 'new') {
+ if (@_ < 1) {
+ $branch_name = 'origin';
+ } else {
+ $branch_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"};
+ # Use the "remote" structure for bare git repositories
+ $localpath = ($bare_flag) ?
+ $$line{"remotepath"} : $$line{"localpath"};
+ $remotepath = ($checked_out_tree) ?
+ $$line{"localpath"} : $$line{"remotepath"};
+
+ 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";
+
+ # We can't create directories on GitHub, so we translate
+ # "packages/foo" into "package-foo".
+ if ($is_github_repo) {
+ $remotepath =~ s/\//-/;
+ }
+
+ # Construct the path for this package in the repo we pulled from
+ $path = "$repo_base/$remotepath";
+
+ if ($command eq "get") {
+ next if $remotepath eq "-"; # "git submodule init/update" will get this later
+
+ # Skip any repositories we have not included the tag for
+ if (not defined($tags{$tag})) {
+ $tags{$tag} = 0;
+ }
+ if ($tags{$tag} == 0) {
+ next;
+ }
+
+ 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";
+ }
+ 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 ($remotepath eq "-") {
+ 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 ($remotepath ne "-") {
+ &git($localpath, "push", @args);
+ }
+ }
+ elsif ($command eq "pull") {
+ my $realcmd;
+ my @realargs;
+ if ($remotepath eq "-") {
+ # 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") {
+ $command = "send-email";
+ &git($localpath, $command, @args);
+ }
+ elsif ($command eq "fetch") {
+ &git($localpath, "fetch", @args);
+ }
+ elsif ($command eq "new") {
+ my @scm_args = ("log", "$branch_name..");
+ &git($localpath, @scm_args, @args);
+ }
+ elsif ($command eq "log") {
+ &git($localpath, "log", @args);
+ }
+ elsif ($command eq "remote") {
+ my @scm_args;
+ my $rpath;
+ $ignore_failure = 1;
+ if ($remotepath eq '-') {
+ $rpath = "$localpath.git"; # N.B.: $localpath lacks the .git suffix
+ if ($localpath =~ /^libraries\//) {
+ # FIXME: This is just a simple heuristic to
+ # infer the remotepath for Git submodules. A
+ # proper solution would require to parse the
+ # .gitmodules file to obtain the actual
+ # localpath<->remotepath mapping.
+ $rpath =~ s/^libraries\//packages\//;
+ }
+ $rpath = "$repo_base/$rpath";
+ } else {
+ $rpath = $path;
+ }
+ if ($subcommand eq 'add') {
+ @scm_args = ("remote", "add", $branch_name, $rpath);
+ } elsif ($subcommand eq 'rm') {
+ @scm_args = ("remote", "rm", $branch_name);
+ } elsif ($subcommand eq 'set-branches') {
+ @scm_args = ("remote", "set-branches", $branch_name);
+ } elsif ($subcommand eq 'set-url') {
+ @scm_args = ("remote", "set-url", $branch_name, $rpath);
+ }
+ &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 subrepos; it doesn't work properly as
+ # they aren't on a branch.
+ next if $remotepath eq "-";
+
+ 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";
+ }
+ print "$localpath";
+ print (' ' x (40 - length($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);
+ if ($us eq $them) {
+ print "same\n";
+ }
+ else {
+ print "DIFFERENT\n";
+ }
+ }
+ else {
+ die "Unknown command: $command";
+ }
+ }
+
+ unlink "resume";
+}
+
+sub gitInitSubmodules {
+ &git(".", "submodule", "init", @_);
+
+ my ($repo_base, $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/[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/[a-zA-Z0-9]+).url) .*$!gm) {
+ if (-e "$repo_base/$2/.git") {
+ &git(".", "config", $1, "$repo_base/$2");
+ }
+ }
+ }
+}
+
+sub checkCurrentBranchIsMaster {
+ my $branch = `git symbolic-ref HEAD`;
+ $branch =~ s/refs\/heads\///;
+ $branch =~ s/\n//;
+
+ 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);
+
+ # Get the built in help
+ my $help = <<END;
+Usage:
+
+./sync-all [-q] [-s] [--ignore-failure] [-r repo] [--checked-out] [--bare]
+ [--<tag>] [--no-<tag>] [--resume]
+ cmd [git flags]
+
+ where <tag> is one of: $tags
+
+Applies the command "cmd" to each repository in the tree.
+
+A full repository tree is obtained by first cloning the ghc
+repository, then getting the subrepositories with "sync-all get":
+
+ \$ git clone http://git.haskell.org/ghc.git
+ \$ cd ghc
+ \$ ./sync-all get
+
+After this, "./sync-all pull" will pull from the original repository
+tree.
+
+A remote pointing to another local repository tree can be added like
+this:
+
+ \$ ./sync-all -r /path/to/ghc remote add otherlocal
+
+and then we can pull from this other tree with
+
+ \$ ./sync-all pull otherlocal
+
+-------------- Commands -----------------
+get
+
+ Clones all sub-repositories from the same place that the ghc
+ repository was cloned from. See "which repos to use" below
+ for details of how the subrepositories are laid out.
+
+ There are various --<package-tag> options that can be given
+ before "get" that enable extra repositories. The full list is
+ given at the end of this help. For example:
+
+ ./sync-all --nofib get
+
+ would get the nofib repository in addition to the usual set of
+ subrepositories.
+
+remote add <remote-name>
+remote rm <remote-name>
+remote set-url [--push] <remote-name>
+
+ Runs a "git remote" command on each subrepository, adjusting the
+ repository location in each case appropriately. For example, to
+ add a new remote pointing to the upstream repositories:
+
+ ./sync-all -r http://git.haskell.org remote add upstream
+
+ The -r flag points to the root of the repository tree (see "which
+ repos to use" below). For a repository on the local filesystem it
+ would point to the ghc repository, and for a remote repository it
+ points to the directory containing "ghc.git".
+
+compare
+compare reporoot
+compare -b reporoot
+
+ Compare the git HEADs of the repos to the origin repos, or the
+ repos under reporoot (which is assumde to be a checked-out tree
+ unless the -b flag is used).
+
+ 1 line is printed for each repo, indicating whether the repo is
+ at the "same" or a "DIFFERENT" commit.
+
+These commands just run the equivalent git command on each repository, 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 repo at which it
+ failed. This means you don't need to wait while, e.g., "pull" goes through
+ all the repos it's just pulled, and tries to pull them again.
+
+ --ignore-failure says to ignore errors and move on to the next repository
+
+ -r repo says to use repo as the location of package repositories
+
+ --checked-out says that the remote repo is in checked-out layout, as opposed
+ to the layout used for the main repo. By default a repo on the local
+ filesystem is assumed to be checked-out, and repos accessed via HTTP or SSH
+ are assumed to be in the main repo layout; 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 also clone some extra library packages
+
+ --no-dph avoids cloning the dph packages
+
+
+------------ Checking out a branch -------------
+To check out a branch you can run the following command:
+
+ \$ ./sync-all checkout ghc-7.4
+
+
+------------ Which repos to use -------------
+sync-all uses the following algorithm to decide which remote repos to use
+
+It always computes the remote repos from a single base, <repo_base> How is
+<repo_base> set? If you say "-r repo", then that's <repo_base> otherwise
+<repo_base> is set by asking git where the ghc repo came from, and removing the
+last component (e.g. /ghc.git/ or /ghc/).
+
+Then sync-all iterates over the package found in the file ./packages; see that
+file for a description of the contents.
+
+If <repo_base> looks like a local filesystem path, or if you give the
+--checked-out flag, sync-all works on repos of form:
+
+ <repo_base>/<local-path>
+
+otherwise sync-all works on repos of form:
+
+ <repo_base>/<remote-path>
+
+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
+The latter is called a "checked-out tree".
+
+sync-all *ignores* the defaultrepo of all repos other than the root one. So the
+remote repos must be laid out in one of the two formats given by <local-path>
+and <remote-path> in the file 'packages'.
+
+Available package-tags are:
+END
+
+ # Collect all the tags in the packages file
+ my %available_tags;
+ 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)";
+ while (<IN>) {
+ chomp;
+ if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
+ if (defined($2) && $2 ne "-") {
+ $available_tags{$2} = 1;
+ }
+ }
+ elsif (! /^(#.*)?$/) {
+ die "Bad line: $_";
+ }
+ }
+ close IN;
+
+ # Show those tags and the help text
+ my @available_tags = keys %available_tags;
+ print "$help@available_tags\n\n";
+ 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") {
+ $defaultrepo = shift;
+ }
+ elsif ($arg eq "--resume") {
+ $try_to_resume = 1;
+ }
+ elsif ($arg eq "--ignore-failure") {
+ $ignore_failure = 1;
+ }
+ elsif ($arg eq "--complete" || $arg eq "--partial") {
+ $get_mode = $arg;
+ }
+ # Use --checked-out if the _remote_ repos are a checked-out tree,
+ # rather than the master trees.
+ 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 && ! $defaultrepo) {
+ 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)$/) {
+ $command = "send";
+ }
+ 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 "pull") {
+ my $gitConfig = &tryReadFile(".git/config");
+ if ($gitConfig !~ /submodule/) {
+ &gitInitSubmodules(@submodule_args);
+ }
+ }
+ if ($command eq "get" or $command eq "pull") {
+ my $gitConfig = &tryReadFile(".git/config");
+ if ($gitConfig !~ /submodule/) {
+ &gitInitSubmodules(@submodule_args);
+ }
+ &git(".", "submodule", "update", @submodule_args);
+ }
+ }
+}
+
+BEGIN {
+ my %argvHash = map { $_, 1 } @ARGV;
+ if ($argvHash {"pull"}) {
+ checkCurrentBranchIsMaster();
+ }
+ $initial_working_directory = getcwd();
+
+ $SIG{__DIE__} = sub {
+ die @_ if $^S;
+ $exit_via_die = 1;
+ };
+
+ #message "== Checking for left-over testsuite/.git folder";
+ if (-d "testsuite/.git") {
+ print <<EOF;
+============================
+ATTENTION!
+
+You have a left-over testsuite/.git folder in your GHC tree!
+
+Please backup or remove it (e.g. "rm -r testsuite/.git") before
+proceeding as the testsuite Git repository is now tracked as part of
+the ghc Git repository (see #8545 for more details)
+============================
+EOF
+ die "detected obsolete testsuite/.git folder"
+ }
+}
+
+END {
+ return if $exit_via_die;
+ my $ec = $?;
+
+ chdir($initial_working_directory);
+
+ message "== Checking for old haddock repo";
+ if (-d "utils/haddock/.git") {
+ chdir("utils/haddock");
+ if ((system "git log -1 87e2ca11c3d1b1bc49900fba0b5c5c6f85650718 > /dev/null 2> /dev/null") == 0) {
+ print <<EOF;
+============================
+ATTENTION!
+
+You have an old haddock repository in your GHC tree!
+
+Please remove it (e.g. "rm -r utils/haddock"), and then run
+"./sync-all get" to get the new repository.
+============================
+EOF
+ }
+ chdir($initial_working_directory);
+ }
+
+ message "== Checking for old binary repo";
+ if (-d "libraries/binary/.git") {
+ chdir("libraries/binary");
+ if ((system "git log -1 749ac0efbde3b14901417364a872796598747aaf > /dev/null 2> /dev/null") == 0) {
+ print <<EOF;
+============================
+ATTENTION!
+
+You have an old binary repository in your GHC tree!
+
+Please remove it (e.g. "rm -r libraries/binary"), and then run
+"./sync-all get" to get the new repository.
+============================
+EOF
+ }
+ chdir($initial_working_directory);
+ }
+
+ message "== Checking for old mtl repo";
+ if (-d "libraries/mtl/.git") {
+ chdir("libraries/mtl");
+ if ((system "git log -1 c67d8f7247c612dc35242bc67e616f7ea35eadb9 > /dev/null 2> /dev/null") == 0) {
+ print <<EOF;
+============================
+ATTENTION!
+
+You have an old mtl repository in your GHC tree!
+
+Please remove it (e.g. "rm -r libraries/mtl"), and then run
+"./sync-all get" to get the new repository.
+============================
+EOF
+ }
+ chdir($initial_working_directory);
+ }
+
+ message "== Checking for old Cabal repo";
+ if (-d "libraries/Cabal/.git") {
+ chdir("libraries/Cabal");
+ if ((system "git log -1 c8ebd66a32865f72ae03ee0663c62df3d77f08fe > /dev/null 2> /dev/null") == 0) {
+ print <<EOF;
+============================
+ATTENTION!
+
+You have an old Cabal repository in your GHC tree!
+
+Please remove it (e.g. "rm -r libraries/Cabal"), and then run
+"./sync-all get" to get the new repository.
+============================
+EOF
+ }
+ chdir($initial_working_directory);
+ }
+
+ message "== Checking for old time from tarball";
+ if (-d "libraries/time" and ! -e "libraries/time/.git") {
+ print <<EOF;
+============================
+ATTENTION!
+
+You have an old time package 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 repo 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);
+
View Lorry Controller Status