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