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