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