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