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