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