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