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