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