PrelNames cleanup
[ghc.git] / sync-all
1 #!/usr/bin/env perl
2
3 use warnings;
4 use strict;
5 use Cwd;
6 use English;
7
8 $| = 1; # autoflush stdout after each print, to avoid output after die
9
10 my $initial_working_directory;
11 my $exit_via_die;
12
13 my $defaultrepo;
14 my @packages;
15 my $verbose = 2;
16 my $try_to_resume = 0;
17 my $ignore_failure = 0;
18 my $checked_out_flag = 0; # NOT the opposite of bare_flag (describes remote repo state)
19 my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo state)
20
21 my %tags;
22
23 my $GITHUB = qr!(?:git@|git://|https://|http://|ssh://git@)github.com!;
24
25 sub inDir {
26     my $dir = shift;
27     my $code = shift;
28
29     if ($dir ne '.') {
30         chdir($dir);
31     }
32
33     my $result = &$code();
34
35     if ($dir ne '.') {
36         chdir($initial_working_directory);
37     }
38     return $result;
39 }
40
41 sub parsePackages {
42     my @repos;
43     my $lineNum;
44
45     open IN, "< packages.conf"
46         or open IN, "< packages" # clashes with packages directory when using --bare
47         or die "Can't open packages file (or packages.conf)";
48     @repos = <IN>;
49     close IN;
50
51     @packages = ();
52     $lineNum = 0;
53     foreach (@repos) {
54         chomp;
55         $lineNum++;
56         if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
57             my %line;
58             $line{"localpath"}  = $1;
59             $line{"tag"}        = $2;
60             $line{"remotepath"} = $3;
61             $line{"upstreamurl"}= $4;
62             push @packages, \%line;
63
64             $tags{$2} = 0;
65         }
66         elsif (! /^(#.*)?$/) {
67             die "Bad content on line $lineNum of packages file: $_";
68         }
69     }
70 }
71
72 sub message {
73     if ($verbose >= 2) {
74         print "@_\n";
75     }
76 }
77
78 sub warning {
79     if ($verbose >= 1) {
80         print "warning: @_\n";
81     }
82 }
83
84 sub gitNewWorkdir {
85     my $dir = shift;
86     my $target = shift;
87     my $target_dir = "$target/$dir";
88
89     if ($dir eq '.') {
90         message "== running git-new-workdir . $target_dir @_";
91     } else {
92         message "== $dir: running git-new-workdir . $target_dir @_";
93         chdir($dir);
94     }
95
96     system ("git-new-workdir", ".", $target_dir, @_) == 0
97         or $ignore_failure
98         or die "git-new-workdir failed: $?";
99
100     if ($dir ne '.') {
101         chdir($initial_working_directory);
102     }
103 }
104
105 sub git {
106     my $dir = shift;
107     my @args = @_;
108
109     &inDir($dir, sub {
110         my $prefix = $dir eq '.' ? "" : "$dir: ";
111         message "== ${prefix}running git @args";
112
113         system ("git", @args) == 0
114             or $ignore_failure
115             or die "git failed: $?";
116     });
117 }
118
119 sub readgitline {
120     my $dir = shift;
121     my @args = @_;
122
123     &inDir($dir, sub {
124         open my $fh, '-|', 'git', @args
125             or die "Executing git @args failed: $!";
126         my $line = <$fh>;
127         $line = "" unless defined($line);
128         chomp $line;
129         close $fh;
130         return $line;
131     });
132 }
133
134 sub readgit {
135     my $dir = shift;
136     my @args = @_;
137
138     &inDir($dir, sub {
139         open my $fh, '-|', 'git', @args
140             or die "Executing git @args failed: $!";
141         my $ret;
142         $ret .= $_ while <$fh>;
143         close $fh;
144         return $ret;
145     });
146 }
147
148 sub configure_repository {
149     my $localpath = shift;
150
151     &git($localpath, "config", "core.ignorecase", "true");
152
153     my $autocrlf = &readgitline($localpath, 'config', '--get', 'core.autocrlf');
154     if ($autocrlf eq "true") {
155         &git($localpath, "config", "core.autocrlf", "false");
156         &git($localpath, "reset", "--hard");
157     }
158 }
159
160 # Figure out where to get the other repositories from.
161 sub getrepo {
162     my $repo;
163
164     if (defined($defaultrepo)) {
165         $repo = $defaultrepo;
166         chomp $repo;
167     } else {
168         # Figure out where to get the other repositories from,
169         # based on where this GHC repo came from.
170         my $git_dir = $bare_flag ? "ghc.git" : ".";
171         my $branch = &readgitline($git_dir, "rev-parse", "--abbrev-ref", "HEAD");
172         die "Bad branch: $branch"
173             unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
174         my $remote = &readgitline($git_dir, "config", "--get", "branch.$branch.remote");
175         if ($remote eq "") {
176             # remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
177             $remote = "origin";
178         }
179         die "Bad remote: $remote"
180             unless $remote =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
181         $repo = &readgitline($git_dir, "config", "--get", "remote.$remote.url");
182     }
183
184     my $repo_base;
185     my $checked_out_tree;
186     my $repo_local = 0;
187
188     if ($repo =~ /^...*:/) {
189         # HTTP or SSH
190         # Above regex says "at least two chars before the :", to avoid
191         # catching Win32 drives ("C:\").
192         $repo_base = $repo;
193
194         # --checked-out is needed if you want to use a checked-out repo
195         # over SSH or HTTP
196         $checked_out_tree = $checked_out_flag;
197
198         # Don't drop the last part of the path if specified with -r, as
199         # it expects repos of the form:
200         #
201         #   http://git.haskell.org
202         #
203         # rather than
204         #
205         #   http://git.haskell.org/ghc
206         #
207         if (!$defaultrepo) {
208             $repo_base =~ s#/[^/]+/?$##;
209         }
210     }
211     elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
212         # Local filesystem, either absolute (C:/ or /) or relative (../) path
213         $repo_local = 1;
214         $repo_base = $repo;
215         if (-f "$repo/HEAD") {
216             # assume a local mirror:
217             $checked_out_tree = 0;
218             $repo_base =~ s#/[^/]+/?$##;
219         } elsif (-d "$repo/ghc.git") {
220             # assume a local mirror:
221             $checked_out_tree = 0;
222         } else {
223             # assume a checked-out tree:
224             $checked_out_tree = 1;
225         }
226     }
227     else {
228         die "Couldn't work out repo";
229     }
230
231     return $repo_base, $checked_out_tree, $repo_local;
232 }
233
234 sub gitall {
235     my $command = shift;
236
237     my $localpath;
238     my $tag;
239     my $remotepath;
240     my $line;
241     my $repo_is_submodule;
242     my $branch_name;
243     my $subcommand;
244
245     my $path;
246
247     my @args;
248
249     my $started;
250     my $doing;
251     my $start_repo;
252
253     my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
254
255     my $is_github_repo = $repo_base =~ $GITHUB;
256
257     @args = ();
258
259     if ($command =~ /^remote$/) {
260         while (@_ > 0 && $_[0] =~ /^-/) {
261             push(@args,shift);
262         }
263         if (@_ < 1) { help(1); }
264         $subcommand = shift;
265         if ($subcommand ne 'add' &&
266             $subcommand ne 'rm' &&
267             $subcommand ne 'set-branches' &&
268             $subcommand ne 'set-url') {
269             help(1);
270         }
271         while (@_ > 0 && $_[0] =~ /^-/) {
272             push(@args,shift);
273         }
274         if (($subcommand eq 'add' || $subcommand eq 'rm') && @_ < 1) {
275             help(1);
276         } elsif (@_ < 1) { # set-url
277             $branch_name = 'origin';
278         } else {
279             $branch_name = shift;
280         }
281     } elsif ($command eq 'new') {
282         if (@_ < 1) {
283             $branch_name = 'origin';
284         } else {
285             $branch_name = shift;
286         }
287     }
288
289     push(@args, @_);
290
291     # $doing is a good enough approximation to what we are doing that
292     # we can use it to check that --resume is resuming the right command
293     $doing = join(" ", ($command, @args));
294     $started = 1;
295     if ($try_to_resume && -f "resume") {
296         my $what;
297         open RESUME, "< resume"
298             or die "Can't open resume file";
299         $start_repo = <RESUME>;
300         chomp $start_repo;
301         $what = <RESUME>;
302         chomp $what;
303         close RESUME;
304         if ($what eq $doing) {
305             $started = 0;
306         }
307     }
308
309     for $line (@packages) {
310         $tag        = $$line{"tag"};
311         if ($tags{$tag} == 0) {
312             next;
313         }
314
315         # Use the "remote" structure for bare git repositories
316         $localpath  = ($bare_flag) ?
317                       $$line{"remotepath"} : $$line{"localpath"};
318
319         if (!$started) {
320             if ($start_repo eq $localpath) {
321                 $started = 1;
322             }
323             else {
324                 next;
325             }
326         }
327
328         open RESUME, "> resume.tmp";
329         print RESUME "$localpath\n";
330         print RESUME "$doing\n";
331         close RESUME;
332         rename "resume.tmp", "resume";
333
334         $repo_is_submodule = $$line{"remotepath"} eq "-";
335
336         if ($checked_out_tree) {
337             $remotepath = $$line{"localpath"};
338         }
339         elsif ($repo_is_submodule) {
340             $remotepath = &readgitline(".", 'config', '-f', '.gitmodules', '--get', "submodule.$localpath.url");
341             $remotepath =~ s/\.\.\///;
342         }
343         else {
344             $remotepath = $$line{"remotepath"};
345         }
346
347         # We can't create directories on GitHub, so we translate
348         # "packages/foo" into "package-foo".
349         if ($is_github_repo) {
350             $remotepath =~ s/\//-/;
351         }
352
353         # Construct the path for this package in the repo we pulled from
354         $path = "$repo_base/$remotepath";
355
356         if ($command eq "get") {
357             next if $repo_is_submodule; # "git submodule init/update" will get this later
358
359             if (-d $localpath) {
360                 warning("$localpath already present; omitting")
361                     if $localpath ne ".";
362                 &configure_repository($localpath);
363                 next;
364             }
365
366             # Note that we use "." as the path, as $localpath
367             # doesn't exist yet.
368             my @argsWithBare = @args;
369             push @argsWithBare, $bare_flag if $bare_flag;
370             &git(".", "clone", $path, $localpath, @argsWithBare);
371             &configure_repository($localpath);
372             next;
373         }
374
375         my $git_repo_present = 1 if -e "$localpath/.git" || ($bare_flag && -d "$localpath");
376         if (not $git_repo_present) {
377             if ($tag eq "-") {
378                 die "Required repo $localpath is missing. Please first run './sync-all get'.\n";
379             }
380             else {
381                  message "== $localpath repo not present; skipping";
382                  next;
383             }
384         }
385
386         # Work out the arguments we should give to the SCM
387         if ($command eq "status") {
388             &git($localpath, $command, @args);
389         }
390         elsif ($command eq "commit") {
391             # git fails if there is nothing to commit, so ignore failures
392             $ignore_failure = 1;
393             &git($localpath, "commit", @args);
394         }
395         elsif ($command eq "check_submodules") {
396             # If we have a submodule then check whether it is up-to-date
397             if ($repo_is_submodule) {
398                 my %remote_heads;
399
400                 message "== Checking sub-module $localpath";
401
402                 chdir($localpath);
403
404                 open my $lsremote, '-|', 'git', 'ls-remote', '--heads', '-q'
405                     or die "Executing ls-remote failed: $!";
406                 while (<$lsremote>) {
407                     if (/^([0-9a-f]{40})\s*refs\/heads\//) {
408                         $remote_heads{$1} = 1;
409                     }
410                     else {
411                         die "Bad output from ls-remote: $_";
412                     }
413                 }
414                 close($lsremote);
415
416                 my $myhead = &readgitline('.', 'rev-parse', '--verify', 'HEAD');
417
418                 if (not defined($remote_heads{$myhead})) {
419                     die "Sub module $localpath needs to be pushed; see http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream";
420                 }
421                 
422                 chdir($initial_working_directory);
423             }
424         }
425         elsif ($command eq "push") {
426             # We don't automatically push to the submodules. If you want
427             # to push to them then you need to use a special command, as
428             # described on
429             # http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream
430             if (!$repo_is_submodule) {
431                 &git($localpath, "push", @args);
432             }
433         }
434         elsif ($command eq "pull") {
435             my $realcmd;
436             my @realargs;
437             if ($repo_is_submodule) {
438                 # Only fetch for the submodules. "git submodule update"
439                 # will take care of making us point to the right commit.
440                 $realcmd = "fetch";
441                 # we like "sync-all pull --rebase" to work:
442                 @realargs = grep(!/--rebase/,@args);
443             }
444             else {
445                 $realcmd = "pull";
446                 @realargs = @args;
447             }
448             &git($localpath, $realcmd, @realargs);
449         }
450         elsif ($command eq "new-workdir") {
451             gitNewWorkdir ($localpath, @args);
452         }
453         elsif ($command eq "send") {
454             $command = "send-email";
455             &git($localpath, $command, @args);
456         }
457         elsif ($command eq "fetch") {
458             &git($localpath, "fetch", @args);
459         }
460         elsif ($command eq "new") {
461             my @scm_args = ("log", "$branch_name..");
462             &git($localpath, @scm_args, @args);
463         }
464         elsif ($command eq "log") {
465             &git($localpath, "log", @args);
466         }
467         elsif ($command eq "remote") {
468             my @scm_args;
469             $ignore_failure = 1;
470             if ($subcommand eq 'add') {
471                 @scm_args = ("remote", "add", $branch_name, $path);
472             } elsif ($subcommand eq 'rm') {
473                 @scm_args = ("remote", "rm", $branch_name);
474             } elsif ($subcommand eq 'set-branches') {
475                 @scm_args = ("remote", "set-branches", $branch_name);
476             } elsif ($subcommand eq 'set-url') {
477                 @scm_args = ("remote", "set-url", $branch_name, $path);
478             }
479             &git($localpath, @scm_args, @args);
480         }
481         elsif ($command eq "checkout") {
482             # Not all repos are necessarily branched, so ignore failure
483             $ignore_failure = 1;
484             &git($localpath, "checkout", @args);
485         }
486         elsif ($command eq "grep") {
487             # Hack around 'git grep' failing if there are no matches
488             $ignore_failure = 1;
489             &git($localpath, "grep", @args);
490         }
491         elsif ($command eq "diff") {
492             &git($localpath, "diff", @args);
493         }
494         elsif ($command eq "clean") {
495             &git($localpath, "clean", @args);
496         }
497         elsif ($command eq "reset") {
498             &git($localpath, "reset", @args);
499         }
500         elsif ($command eq "branch") {
501             &git($localpath, "branch", @args);
502         }
503         elsif ($command eq "config") {
504             &git($localpath, "config", @args);
505         }
506         elsif ($command eq "repack") {
507             &git($localpath, "repack", @args);
508         }
509         elsif ($command eq "format-patch") {
510             &git($localpath, "format-patch", @args);
511         }
512         elsif ($command eq "gc") {
513             &git($localpath, "gc", @args);
514         }
515         elsif ($command eq "tag") {
516             &git($localpath, "tag", @args);
517         }
518         elsif ($command eq "compare") {
519             # Don't compare the subrepos; it doesn't work properly as
520             # they aren't on a branch.
521             next if $repo_is_submodule;
522
523             my $compareto;
524             if ($#args eq -1) {
525                 $compareto = $path;
526             }
527             elsif ($#args eq 0) {
528                 $compareto = "$args[0]/$localpath";
529             }
530             elsif ($#args eq 1 && $args[0] eq "-b") {
531                 $compareto = "$args[1]/$remotepath";
532             }
533             else {
534                 die "Bad args for compare";
535             }
536             print "$localpath";
537             print (' ' x (40 - length($localpath)));
538             my $branch = &readgitline($localpath, "rev-parse", "--abbrev-ref", "HEAD");
539             die "Bad branch: $branch"
540                 unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
541             my $us   = &readgitline(".", "ls-remote", $localpath, "refs/heads/$branch");
542             my $them = &readgitline(".", "ls-remote", $compareto, "refs/heads/$branch");
543             $us   =~ s/[[:space:]].*//;
544             $them =~ s/[[:space:]].*//;
545             die "Bad commit of mine: $us"     unless (length($us)   eq 40);
546             die "Bad commit of theirs: $them" unless (length($them) eq 40);
547             if ($us eq $them) {
548                 print "same\n";
549             }
550             else {
551                 print "DIFFERENT\n";
552             }
553         }
554         else {
555             die "Unknown command: $command";
556         }
557     }
558
559     unlink "resume";
560 }
561
562 sub gitInitSubmodules {
563     &git(".", "submodule", "init", @_);
564
565     my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
566
567     my $submodulespaths = &readgit(".", "config", "--get-regexp", "^submodule[.].*[.]url");
568     # if we came from github, change the urls appropriately
569     while ($submodulespaths =~ m!^(submodule.(?:libraries/|utils/)?[a-zA-Z0-9-]+.url) ($GITHUB)/ghc/packages/([a-zA-Z0-9-]+).git$!gm) {
570         &git(".", "config", $1, "$2/ghc/packages-$3");
571     }
572
573     # if we came from a local repository, grab our submodules from their
574     # checkouts over there, if they exist.
575     if ($repo_local) {
576         while ($submodulespaths =~ m!^(submodule.((?:libraries/|utils/)?[a-zA-Z0-9-]+).url) .*$!gm) {
577             if (-e "$repo_base/$2/.git") {
578                 &git(".", "config", $1, "$repo_base/$2");
579             }
580         }
581     }
582 }
583
584 sub checkCurrentBranchIsMaster {
585     my $branch = &readgitline(".", "rev-parse", "--abbrev-ref", "HEAD");
586
587     if ($branch !~ /master/) {
588         print "\nWarning: You are trying to 'pull' while on branch '$branch'.\n"
589             . "Updates to this script will happen on the master branch which\n"
590             . "means the version on this branch may be out of date.\n\n";
591     }
592 }
593
594 sub help
595 {
596         my $exit = shift;
597
598         my $tags = join ' ', sort (grep !/^-$/, keys %tags);
599
600         print <<END;
601 Usage:
602
603 ./sync-all [-q] [-s] [--ignore-failure] [-r repo] [--checked-out] [--bare]
604            [--<tag>] [--no-<tag>] [--resume]
605            cmd [git flags]
606
607     where <tag> is one of: $tags
608
609 Applies the command "cmd" to each repository in the tree.
610
611 A full repository tree is obtained by first cloning the ghc
612 repository, then getting the subrepositories with "sync-all get":
613
614   \$ git clone http://git.haskell.org/ghc.git
615   \$ cd ghc
616   \$ ./sync-all get
617
618 After this, "./sync-all pull" will pull from the original repository
619 tree.
620
621 A remote pointing to another local repository tree can be added like
622 this:
623
624   \$ ./sync-all -r /path/to/ghc remote add otherlocal
625
626 and then we can pull from this other tree with
627
628   \$ ./sync-all pull otherlocal
629
630 -------------- Commands -----------------
631 get
632
633     Clones all sub-repositories from the same place that the ghc
634     repository was cloned from. See "which repos to use" below
635     for details of how the subrepositories are laid out.
636
637     There are various --<package-tag> options that can be given
638     before "get" that enable extra repositories. The full list is
639     given at the end of this help. For example:
640
641     ./sync-all --nofib get
642
643     would get the nofib repository in addition to the usual set of
644     subrepositories.
645
646 remote add <remote-name>
647 remote rm <remote-name>
648 remote set-url [--push] <remote-name>
649
650     Runs a "git remote" command on each subrepository, adjusting the
651     repository location in each case appropriately. For example, to
652     add a new remote pointing to the upstream repositories:
653
654     ./sync-all -r http://git.haskell.org remote add upstream
655
656     The -r flag points to the root of the repository tree (see "which
657     repos to use" below). For a repository on the local filesystem it
658     would point to the ghc repository, and for a remote repository it
659     points to the directory containing "ghc.git".
660
661 compare
662 compare reporoot
663 compare -b reporoot
664
665     Compare the git HEADs of the repos to the origin repos, or the
666     repos under reporoot (which is assumde to be a checked-out tree
667     unless the -b flag is used).
668
669     1 line is printed for each repo, indicating whether the repo is
670     at the "same" or a "DIFFERENT" commit.
671
672 These commands just run the equivalent git command on each repository, passing
673 any extra arguments to git:
674
675   branch
676   checkout
677   clean
678   commit
679   config
680   diff
681   fetch
682   format-patch
683   gc
684   grep
685   log
686   new
687   new-workdir
688   pull
689   push
690   repack
691   reset
692   send
693   status
694   tag
695
696 -------------- Flags -------------------
697 These flags are given *before* the command and modify the way sync-all behaves.
698 Flags given *after* the command are passed to git.
699
700   -q says to be quiet, and -s to be silent.
701
702   --resume will restart a command that failed, from the repo at which it
703   failed. This means you don't need to wait while, e.g., "pull" goes through
704   all the repos it's just pulled, and tries to pull them again.
705
706   --ignore-failure says to ignore errors and move on to the next repository
707
708   -r repo says to use repo as the location of package repositories
709
710   --checked-out says that the remote repo is in checked-out layout, as opposed
711   to the layout used for the main repo. By default a repo on the local
712   filesystem is assumed to be checked-out, and repos accessed via HTTP or SSH
713   are assumed to be in the main repo layout; use --checked-out to override the
714   latter.
715
716   --bare says that the local repo is in bare layout, same as the main repo. It
717   also means that these repos are bare. You only have to use this flag if you
718   don't have a bare ghc.git in the current directory and would like to 'get'
719   all of the repos bare. Requires packages.conf to be present in the current
720   directory (a renamed packages file from the main ghc repo).
721
722   Note: --checked-out and --bare flags are NOT the opposite of each other.
723         --checked-out: describes the layout of the remote repository tree.
724         --bare:        describes the layout of the local repository tree.
725
726   --nofib also clones the nofib benchmark suite
727
728   --extra also clone some extra library packages
729
730   --no-dph avoids cloning the dph packages
731
732
733 ------------ Checking out a branch -------------
734 To check out a branch you can run the following command:
735
736   \$ ./sync-all checkout ghc-7.4
737
738
739 ------------ Which repos to use -------------
740 sync-all uses the following algorithm to decide which remote repos to use
741
742 It always computes the remote repos from a single base, <repo_base> How is
743 <repo_base> set? If you say "-r repo", then that's <repo_base> otherwise
744 <repo_base> is set by asking git where the ghc repo came from, and removing the
745 last component (e.g. /ghc.git/ or /ghc/).
746
747 Then sync-all iterates over the package found in the file ./packages; see that
748 file for a description of the contents.
749
750 If <repo_base> looks like a local filesystem path, or if you give the
751 --checked-out flag, sync-all works on repos of form:
752
753   <repo_base>/<local-path>
754
755 otherwise sync-all works on repos of form:
756
757   <repo_base>/<remote-path>
758
759 This logic lets you say
760   both    sync-all -r http://example.org/ghc-6.12 remote add ghc-6.12
761   and     sync-all -r ../working remote add working
762 The latter is called a "checked-out tree".
763
764 sync-all *ignores* the defaultrepo of all repos other than the root one. So the
765 remote repos must be laid out in one of the two formats given by <local-path>
766 and <remote-path> in the file 'packages'.
767
768 Available package-tags are: $tags
769
770 END
771         exit $exit;
772 }
773
774 sub main {
775
776     &parsePackages();
777
778     $tags{"-"} = 1;
779     $tags{"dph"} = 1;
780     if ($OSNAME =~ /^(MSWin32|Cygwin|msys)$/) {
781         $tags{"windows"} = 1;
782     }
783
784     while ($#_ ne -1) {
785         my $arg = shift;
786         # We handle -q here as well as lower down as we need to skip over it
787         # if it comes before the source-control command
788         if ($arg eq "-q") {
789             $verbose = 1;
790         }
791         elsif ($arg eq "-s") {
792             $verbose = 0;
793         }
794         elsif ($arg eq "-r") {
795             $defaultrepo = shift;
796         }
797         elsif ($arg eq "--resume") {
798             $try_to_resume = 1;
799         }
800         elsif ($arg eq "--ignore-failure") {
801             $ignore_failure = 1;
802         }
803         # Use --checked-out if the _remote_ repos are a checked-out tree,
804         # rather than the master trees.
805         elsif ($arg eq "--checked-out") {
806             $checked_out_flag = 1;
807         }
808         # Use --bare if the _local_ repos are bare repos,
809         # rather than a checked-out tree.
810         elsif ($arg eq "--bare") {
811             $bare_flag = $arg;
812         }
813         elsif ($arg eq "--help") {
814             help(0);
815         }
816         # --<tag> says we grab the libs tagged 'tag' with
817         # 'get'. It has no effect on the other commands.
818         elsif ($arg =~ m/^--no-(.*)$/ && defined($tags{$1})) {
819             $tags{$1} = 0;
820         }
821         elsif ($arg =~ m/^--(.*)$/ && defined($tags{$1})) {
822             $tags{$1} = 1;
823         }
824         elsif ($arg =~ m/^-/) {
825             die "Unrecognised flag: $arg";
826         }
827         else {
828             unshift @_, $arg;
829             if (grep /^-q$/, @_) {
830                 $verbose = 1;
831             }
832             last;
833         }
834     }
835
836     # check for ghc repositories in cwd
837     my $checked_out_found = 1 if (-d ".git" && -d "compiler");
838     my $bare_found = 1 if (-d "ghc.git");
839
840     if ($bare_flag && ! $bare_found && ! $defaultrepo) {
841         die "error: bare repository ghc.git not found.\n"
842           . "       Either clone a bare ghc repo first or specify the repo location. E.g.:\n"
843           . "       ./sync-all --bare [--nofib --extra] -r http://git.haskell.org get\n"
844     }
845     elsif ($bare_found) {
846         $bare_flag = "--bare";
847     }
848     elsif (! $bare_flag && ! $checked_out_found) {
849         die "error: sync-all must be run from the top level of the ghc tree.";
850     }
851
852     if ($#_ eq -1) {
853         help(1);
854     }
855     else {
856         # Give the command and rest of the arguments to the main loop
857         # We normalise command names here to avoid duplicating the
858         # abbreviations that we allow.
859         my $command = shift;
860
861         if ($command =~ /^(?:g|ge|get)$/) {
862             $command = "get";
863         }
864         elsif ($command =~ /^(?:pus|push)$/) {
865             $command = "push";
866         }
867         elsif ($command =~ /^(?:pul|pull)$/) {
868             $command = "pull";
869         }
870         elsif ($command =~ /^(?:s|se|sen|send)$/) {
871             $command = "send";
872         }
873         elsif ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew|status)$/) {
874             $command = "status";
875         }
876
877         if ($command eq "push") {
878             &gitall("check_submodules", @_);
879         }
880
881         &gitall($command, @_);
882
883         my @submodule_args = grep(/^-q/,@_);
884
885         if ($command eq "get") {
886             &gitInitSubmodules(@submodule_args);
887         }
888
889         if ($command eq "get" or $command eq "pull") {
890             &git(".", "submodule", "update", @submodule_args);
891         }
892     }
893 }
894
895 BEGIN {
896     my %argvHash = map { $_, 1 } @ARGV;
897     if ($argvHash {"pull"}) {
898         checkCurrentBranchIsMaster();
899     }
900     $initial_working_directory = getcwd();
901
902     $SIG{__DIE__} = sub {
903       die @_ if $^S;
904       $exit_via_die = 1;
905     };
906
907     my @obsolete_dirs = qw!
908         testsuite
909         libraries/base
910         libraries/ghc-prim
911         libraries/template-haskell
912         libraries/integer-gmp
913         libraries/integer-simple
914         !;
915     for my $dir (@obsolete_dirs) {
916         if (-d "$dir/.git") {
917             print <<EOF;
918 ============================
919 ATTENTION!
920
921 You have a left-over $dir/.git folder in your GHC tree!
922
923 Please backup or remove it (e.g. "rm -r $dir/.git") before
924 proceeding as the aforesaid Git repository is now tracked as part of
925 the ghc Git repository (see #8545 for more details)
926 ============================
927 EOF
928             die "detected obsolete $dir/.git folder"
929         }
930     }
931 }
932
933 END {
934     return if $exit_via_die;
935     my $ec = $?;
936
937     chdir($initial_working_directory);
938
939     my @obsolete_dirs = (
940         ["utils/haddock",    "87e2ca11c3d1b1bc49900fba0b5c5c6f85650718"],
941         ["libraries/binary", "749ac0efbde3b14901417364a872796598747aaf"],
942         ["libraries/mtl",    "c67d8f7247c612dc35242bc67e616f7ea35eadb9"],
943         ["libraries/Cabal",  "c8ebd66a32865f72ae03ee0663c62df3d77f08fe"],
944         );
945     for (@obsolete_dirs) {
946         my ($dir, $hash) = @$_;
947         my ($name) = $dir =~ m!/([^/]+)$!;
948         message "== Checking for old $name repo";
949         if (-d "$dir/.git") {
950             chdir($dir);
951             if ((system "git log -1 $hash > /dev/null 2> /dev/null") == 0) {
952                 print <<EOF;
953 ============================
954 ATTENTION!
955
956 You have an old $name repository in your GHC tree!
957
958 Please remove it (e.g. "rm -r $dir"), and then run
959 "./sync-all get" to get the new repository.
960 ============================
961 EOF
962             }
963             chdir($initial_working_directory);
964         }
965     }
966     message "== Checking for old time from tarball";
967     if (-d "libraries/time" and ! -e "libraries/time/.git") {
968             print <<EOF;
969 ============================
970 ATTENTION!
971
972 You have an old time package in your GHC tree!
973
974 Please remove it (e.g. "rm -r libraries/time"), and then run
975 "./sync-all get" to get the new repository.
976 ============================
977 EOF
978     }
979
980     message "== Checking for obsolete Git repo URL";
981     my $repo_url = &readgitline(".", 'config', '--get', 'remote.origin.url');
982     if ($repo_url =~ /^http:\/\/darcs.haskell.org/) {
983             print <<EOF;
984 ============================
985 ATTENTION!
986
987 You seem to be using obsolete Git repository URLs.
988
989 Please run
990
991   ./sync-all -r git://git.haskell.org remote set-url
992
993 or (in case port 9418/tcp is filtered by your firewall)
994
995   ./sync-all -r http://git.haskell.org remote set-url
996
997 to update your local checkout to use the new Git URLs.
998 ============================
999 EOF
1000     }
1001
1002     $? = $ec;
1003 }
1004
1005 main(@ARGV);