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