sync-all

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