sync-all 31.3 KB
Newer Older
1 2 3 4
#!/usr/bin/perl -w

use strict;
use Cwd;
5
use English;
6

Ian Lynagh's avatar
Ian Lynagh committed
7 8
$| = 1; # autoflush stdout after each print, to avoid output after die

9 10
my $initial_working_directory;

Simon Marlow's avatar
Simon Marlow committed
11
my $defaultrepo;
Simon Marlow's avatar
Simon Marlow committed
12
my @packages;
13
my $verbose = 2;
14
my $try_to_resume = 0;
Simon Marlow's avatar
Simon Marlow committed
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;
Simon Marlow's avatar
Simon Marlow committed
21

ian@well-typed.com's avatar
ian@well-typed.com committed
22 23 24
sub inDir {
    my $dir = shift;
    my $code = shift;
Simon Marlow's avatar
Simon Marlow committed
25

ian@well-typed.com's avatar
ian@well-typed.com committed
26 27
    if ($dir ne '.') {
        chdir($dir);
Simon Marlow's avatar
Simon Marlow committed
28
    }
Simon Marlow's avatar
Simon Marlow committed
29

ian@well-typed.com's avatar
ian@well-typed.com committed
30
    my $result = &$code();
Simon Marlow's avatar
Simon Marlow committed
31

ian@well-typed.com's avatar
ian@well-typed.com committed
32 33
    if ($dir ne '.') {
        chdir($initial_working_directory);
Simon Marlow's avatar
Simon Marlow committed
34
    }
ian@well-typed.com's avatar
ian@well-typed.com committed
35
    return $result;
Simon Marlow's avatar
Simon Marlow committed
36 37 38 39 40 41
}

sub parsePackages {
    my @repos;
    my $lineNum;

42 43 44
    open IN, "< packages.conf"
        or open IN, "< packages" # clashes with packages directory when using --bare
        or die "Can't open packages file (or packages.conf)";
Simon Marlow's avatar
Simon Marlow committed
45 46 47 48 49 50 51 52
    @repos = <IN>;
    close IN;

    @packages = ();
    $lineNum = 0;
    foreach (@repos) {
        chomp;
        $lineNum++;
53
        if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
Simon Marlow's avatar
Simon Marlow committed
54 55 56 57
            my %line;
            $line{"localpath"}  = $1;
            $line{"tag"}        = $2;
            $line{"remotepath"} = $3;
58
            $line{"upstreamurl"}= $4;
Simon Marlow's avatar
Simon Marlow committed
59
            push @packages, \%line;
60 61

            $tags{$2} = 0;
Simon Marlow's avatar
Simon Marlow committed
62 63 64 65 66 67
        }
        elsif (! /^(#.*)?$/) {
            die "Bad content on line $lineNum of packages file: $_";
        }
    }
}
68

69 70 71 72 73 74 75 76 77 78
sub tryReadFile {
    my $filename = shift;
    my @lines;

    open (FH, $filename) or return "";
    @lines = <FH>;
    close FH;
    return join('', @lines);
}

79 80 81 82 83 84 85 86 87 88 89 90
sub message {
    if ($verbose >= 2) {
        print "@_\n";
    }
}

sub warning {
    if ($verbose >= 1) {
        print "warning: @_\n";
    }
}

tibbe's avatar
tibbe committed
91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
sub gitNewWorkdir {
    my $dir = shift;
    my $target = shift;
    my $target_dir = "$target/$dir";

    if ($dir eq '.') {
        message "== running git-new-workdir . $target_dir @_";
    } else {
        message "== $dir: running git-new-workdir . $target_dir @_";
        chdir($dir);
    }

    system ("git-new-workdir", ".", $target_dir, @_) == 0
        or $ignore_failure
        or die "git-new-workdir failed: $?";

    if ($dir ne '.') {
108
        chdir($initial_working_directory);
tibbe's avatar
tibbe committed
109 110 111
    }
}

ian@well-typed.com's avatar
ian@well-typed.com committed
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
sub git {
    my $dir = shift;
    my @args = @_;

    &inDir($dir, sub {
        my $prefix = $dir eq '.' ? "" : "$dir: ";
        message "== ${prefix}running git @args";

        system ("git", @args) == 0
            or $ignore_failure
            or die "git failed: $?";
    });
}

sub readgit {
    my $dir = shift;
    my @args = @_;

    &inDir($dir, sub {
        open my $fh, '-|', 'git', @args
            or die "Executing git @args failed: $!";
        my $line = <$fh>;
        $line = "" unless defined($line);
        chomp $line;
        close $fh;
        return $line;
    });
}

141 142 143
sub configure_repository {
    my $localpath = shift;

144
    &git($localpath, "config", "--local", "core.ignorecase", "true");
145

ian@well-typed.com's avatar
ian@well-typed.com committed
146
    my $autocrlf = &readgit($localpath, 'config', '--get', 'core.autocrlf');
147
    if ($autocrlf eq "true") {
148 149
        &git($localpath, "config", "--local", "core.autocrlf", "false");
        &git($localpath, "reset", "--hard");
150 151 152
    }
}

ian@well-typed.com's avatar
ian@well-typed.com committed
153 154 155
# Figure out where to get the other repositories from.
sub getrepo {
    my $repo;
Simon Marlow's avatar
Simon Marlow committed
156

ian@well-typed.com's avatar
ian@well-typed.com committed
157 158 159
    if (defined($defaultrepo)) {
        $repo = $defaultrepo;
        chomp $repo;
Simon Marlow's avatar
Simon Marlow committed
160
    } else {
ian@well-typed.com's avatar
ian@well-typed.com committed
161 162 163 164 165
        # Figure out where to get the other repositories from,
        # based on where this GHC repo came from.
        my $git_dir = $bare_flag ? "ghc.git" : ".";
        my $branch = &readgit($git_dir, "rev-parse", "--abbrev-ref", "HEAD");
        die "Bad branch: $branch"
166
            unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
ian@well-typed.com's avatar
ian@well-typed.com committed
167 168 169 170 171 172
        my $remote = &readgit($git_dir, "config", "branch.$branch.remote");
        if ($remote eq "") {
            # remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
            $remote = "origin";
        }
        die "Bad remote: $remote"
173
            unless $remote =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
ian@well-typed.com's avatar
ian@well-typed.com committed
174
        $repo = &readgit($git_dir, "config", "remote.$remote.url");
Simon Marlow's avatar
Simon Marlow committed
175 176
    }

ian@well-typed.com's avatar
ian@well-typed.com committed
177 178
    my $repo_base;
    my $checked_out_tree;
179
    my $repo_local = 0;
Simon Marlow's avatar
Simon Marlow committed
180

ian@well-typed.com's avatar
ian@well-typed.com committed
181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
    if ($repo =~ /^...*:/) {
        # HTTP or SSH
        # Above regex says "at least two chars before the :", to avoid
        # catching Win32 drives ("C:\").
        $repo_base = $repo;

        # --checked-out is needed if you want to use a checked-out repo
        # over SSH or HTTP
        if ($checked_out_flag) {
            $checked_out_tree = 1;
        } else {
            $checked_out_tree = 0;
        }

        # Don't drop the last part of the path if specified with -r, as
        # it expects repos of the form:
        #
198
        #   http://git.haskell.org
ian@well-typed.com's avatar
ian@well-typed.com committed
199 200 201
        #
        # rather than
        #
202
        #   http://git.haskell.org/ghc
ian@well-typed.com's avatar
ian@well-typed.com committed
203 204 205 206
        #
        if (!$defaultrepo) {
            $repo_base =~ s#/[^/]+/?$##;
        }
Simon Marlow's avatar
Simon Marlow committed
207
    }
ian@well-typed.com's avatar
ian@well-typed.com committed
208 209
    elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
        # Local filesystem, either absolute (C:/ or /) or relative (../) path
210
        $repo_local = 1;
ian@well-typed.com's avatar
ian@well-typed.com committed
211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227
        $repo_base = $repo;
        if (-f "$repo/HEAD") {
            # assume a local mirror:
            $checked_out_tree = 0;
            $repo_base =~ s#/[^/]+/?$##;
        } elsif (-d "$repo/ghc.git") {
            # assume a local mirror:
            $checked_out_tree = 0;
        } else {
            # assume a checked-out tree:
            $checked_out_tree = 1;
        }
    }
    else {
        die "Couldn't work out repo";
    }

228
    return $repo_base, $checked_out_tree, $repo_local;
229 230
}

231
sub gitall {
232
    my $command = shift;
daniel.is.fischer's avatar
daniel.is.fischer committed
233

234 235 236
    my $localpath;
    my $tag;
    my $remotepath;
Simon Marlow's avatar
Simon Marlow committed
237
    my $line;
238 239
    my $branch_name;
    my $subcommand;
240 241 242

    my $path;

243
    my @args;
Simon Marlow's avatar
Simon Marlow committed
244

245 246 247 248
    my $started;
    my $doing;
    my $start_repo;

249
    my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
Simon Marlow's avatar
Simon Marlow committed
250

251
    my $is_github_repo = $repo_base =~ m/(git@|git:\/\/|https:\/\/)github.com/;
252

253 254
    @args = ();

255
    if ($command =~ /^remote$/) {
256 257
        while (@_ > 0 && $_[0] =~ /^-/) {
            push(@args,shift);
258
        }
259
        if (@_ < 1) { help(1); }
260
        $subcommand = shift;
261 262 263 264
        if ($subcommand ne 'add' &&
            $subcommand ne 'rm' &&
            $subcommand ne 'set-branches' &&
            $subcommand ne 'set-url') {
265
            help(1);
266
        }
267 268 269 270
        while (@_ > 0 && $_[0] =~ /^-/) {
            push(@args,shift);
        }
        if (($subcommand eq 'add' || $subcommand eq 'rm') && @_ < 1) {
271
            help(1);
272 273 274 275 276
        } elsif (@_ < 1) { # set-url
            $branch_name = 'origin';
        } else {
            $branch_name = shift;
        }
Ian Lynagh's avatar
Ian Lynagh committed
277
    } elsif ($command eq 'new') {
278 279 280 281 282
        if (@_ < 1) {
            $branch_name = 'origin';
        } else {
            $branch_name = shift;
        }
283 284
    }

285 286
    push(@args, @_);

287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304
    # $doing is a good enough approximation to what we are doing that
    # we can use it to check that --resume is resuming the right command
    $doing = join(" ", ($command, @args));
    $started = 1;
    if ($try_to_resume && -f "resume") {
        my $what;
        open RESUME, "< resume"
            or die "Can't open resume file";
        $start_repo = <RESUME>;
        chomp $start_repo;
        $what = <RESUME>;
        chomp $what;
        close RESUME;
        if ($what eq $doing) {
            $started = 0;
        }
    }

Simon Marlow's avatar
Simon Marlow committed
305
    for $line (@packages) {
Ian Lynagh's avatar
Ian Lynagh committed
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 314 315 316 317 318 319 320 321 322 323 324 325 326 327
        if (!$started) {
            if ($start_repo eq $localpath) {
                $started = 1;
            }
            else {
                next;
            }
        }

        open RESUME, "> resume.tmp";
        print RESUME "$localpath\n";
        print RESUME "$doing\n";
        close RESUME;
        rename "resume.tmp", "resume";

Ian Lynagh's avatar
Ian Lynagh committed
328
        # We can't create directories on GitHub, so we translate
329
        # "packages/foo" into "package-foo".
330
        if ($is_github_repo) {
Ian Lynagh's avatar
Ian Lynagh committed
331 332
            $remotepath =~ s/\//-/;
        }
333

334
        # Construct the path for this package in the repo we pulled from
335
        $path = "$repo_base/$remotepath";
Simon Marlow's avatar
Simon Marlow committed
336

337
        if ($command eq "get") {
338 339
            next if $remotepath eq "-"; # "git submodule init/update" will get this later

Ian Lynagh's avatar
Ian Lynagh committed
340 341 342
            # Skip any repositories we have not included the tag for
            if (not defined($tags{$tag})) {
                $tags{$tag} = 0;
343
            }
Ian Lynagh's avatar
Ian Lynagh committed
344 345
            if ($tags{$tag} == 0) {
                next;
346
            }
daniel.is.fischer's avatar
daniel.is.fischer committed
347

Ian Lynagh's avatar
Ian Lynagh committed
348 349 350
            if (-d $localpath) {
                warning("$localpath already present; omitting")
                    if $localpath ne ".";
351
                &configure_repository($localpath);
Ian Lynagh's avatar
Ian Lynagh committed
352
                next;
353
            }
354

Ian Lynagh's avatar
Ian Lynagh committed
355 356
            # Note that we use "." as the path, as $localpath
            # doesn't exist yet.
357 358
            my @argsWithBare = @args;
            push @argsWithBare, $bare_flag if $bare_flag;
359 360
            &git(".", "clone", $path, $localpath, @argsWithBare);
            &configure_repository($localpath);
Ian Lynagh's avatar
Ian Lynagh committed
361 362 363
            next;
        }

364
        my $git_repo_present = 1 if -e "$localpath/.git" || ($bare_flag && -d "$localpath");
365 366 367 368 369 370 371 372
        if (not $git_repo_present) {
            if ($tag eq "") {
                die "Required repo $localpath is missing";
            }
            else {
                 message "== $localpath repo not present; skipping";
                 next;
            }
Ian Lynagh's avatar
Ian Lynagh committed
373 374 375
        }

        # Work out the arguments we should give to the SCM
376
        if ($command eq "status") {
377
            &git($localpath, $command, @args);
Ian Lynagh's avatar
Ian Lynagh committed
378
        }
379
        elsif ($command eq "commit") {
Ian Lynagh's avatar
Ian Lynagh committed
380 381
            # git fails if there is nothing to commit, so ignore failures
            $ignore_failure = 1;
382
            &git($localpath, "commit", @args);
Ian Lynagh's avatar
Ian Lynagh committed
383
        }
384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404
        elsif ($command eq "check_submodules") {
            # If we have a submodule then check whether it is up-to-date
            if ($remotepath eq "-") {
                my %remote_heads;

                message "== Checking sub-module $localpath";

                chdir($localpath);

                open my $lsremote, '-|', 'git', 'ls-remote', '--heads', '-q'
                    or die "Executing ls-remote failed: $!";
                while (<$lsremote>) {
                    if (/^([0-9a-f]{40})\s*refs\/heads\//) {
                        $remote_heads{$1} = 1;
                    }
                    else {
                        die "Bad output from ls-remote: $_";
                    }
                }
                close($lsremote);

ian@well-typed.com's avatar
ian@well-typed.com committed
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://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream";
409 410 411 412 413
                }
                
                chdir($initial_working_directory);
            }
        }
414
        elsif ($command eq "push") {
415 416 417
            # We don't automatically push to the submodules. If you want
            # to push to them then you need to use a special command, as
            # described on
418
            # http://ghc.haskell.org/trac/ghc/wiki/Repositories/Upstream
419
            if ($remotepath ne "-") {
420
                &git($localpath, "push", @args);
421
            }
Ian Lynagh's avatar
Ian Lynagh committed
422
        }
423
        elsif ($command eq "pull") {
424
            my $realcmd;
425
            my @realargs;
426 427 428 429
            if ($remotepath eq "-") {
                # Only fetch for the submodules. "git submodule update"
                # will take care of making us point to the right commit.
                $realcmd = "fetch";
430 431
                # we like "sync-all pull --rebase" to work:
                @realargs = grep(!/--rebase/,@args);
432 433 434
            }
            else {
                $realcmd = "pull";
435
                @realargs = @args;
436
            }
437
            &git($localpath, $realcmd, @realargs);
Ian Lynagh's avatar
Ian Lynagh committed
438
        }
439
        elsif ($command eq "new-workdir") {
tibbe's avatar
tibbe committed
440 441
            gitNewWorkdir ($localpath, @args);
        }
442
        elsif ($command eq "send") {
443
            $command = "send-email";
444
            &git($localpath, $command, @args);
Ian Lynagh's avatar
Ian Lynagh committed
445
        }
446
        elsif ($command eq "fetch") {
447
            &git($localpath, "fetch", @args);
Ian Lynagh's avatar
Ian Lynagh committed
448
        }
449
        elsif ($command eq "new") {
Ian Lynagh's avatar
Ian Lynagh committed
450
            my @scm_args = ("log", "$branch_name..");
451
            &git($localpath, @scm_args, @args);
Ian Lynagh's avatar
Ian Lynagh committed
452
        }
453
        elsif ($command eq "log") {
454
            &git($localpath, "log", @args);
Simon Marlow's avatar
Simon Marlow committed
455
        }
456
        elsif ($command eq "remote") {
Ian Lynagh's avatar
Ian Lynagh committed
457
            my @scm_args;
458
            my $rpath;
459
            $ignore_failure = 1;
460
            if ($remotepath eq '-') {
461 462 463 464 465 466 467 468 469 470
                $rpath = "$localpath.git"; # N.B.: $localpath lacks the .git suffix
                if ($localpath =~ /^libraries\//) {
                    # FIXME: This is just a simple heuristic to
                    # infer the remotepath for Git submodules. A
                    # proper solution would require to parse the
                    # .gitmodules file to obtain the actual
                    # localpath<->remotepath mapping.
                    $rpath =~ s/^libraries\//packages\//;
                }
                $rpath = "$repo_base/$rpath";
471 472 473
            } else {
                $rpath = $path;
            }
Ian Lynagh's avatar
Ian Lynagh committed
474
            if ($subcommand eq 'add') {
475
                @scm_args = ("remote", "add", $branch_name, $rpath);
Ian Lynagh's avatar
Ian Lynagh committed
476 477
            } elsif ($subcommand eq 'rm') {
                @scm_args = ("remote", "rm", $branch_name);
478 479
            } elsif ($subcommand eq 'set-branches') {
                @scm_args = ("remote", "set-branches", $branch_name);
Ian Lynagh's avatar
Ian Lynagh committed
480
            } elsif ($subcommand eq 'set-url') {
481
                @scm_args = ("remote", "set-url", $branch_name, $rpath);
Ian Lynagh's avatar
Ian Lynagh committed
482
            }
483
            &git($localpath, @scm_args, @args);
Ian Lynagh's avatar
Ian Lynagh committed
484
        }
485
        elsif ($command eq "checkout") {
486 487
            # Not all repos are necessarily branched, so ignore failure
            $ignore_failure = 1;
488
            &git($localpath, "checkout", @args);
Ian Lynagh's avatar
Ian Lynagh committed
489
        }
490
        elsif ($command eq "grep") {
Ian Lynagh's avatar
Ian Lynagh committed
491 492
            # Hack around 'git grep' failing if there are no matches
            $ignore_failure = 1;
493
            &git($localpath, "grep", @args);
Ian Lynagh's avatar
Ian Lynagh committed
494
        }
495
        elsif ($command eq "diff") {
496
            &git($localpath, "diff", @args);
Ian Lynagh's avatar
Ian Lynagh committed
497
        }
498
        elsif ($command eq "clean") {
499
            &git($localpath, "clean", @args);
kili's avatar
kili committed
500
        }
501
        elsif ($command eq "reset") {
502
            &git($localpath, "reset", @args);
Ian Lynagh's avatar
Ian Lynagh committed
503
        }
504
        elsif ($command eq "branch") {
505
            &git($localpath, "branch", @args);
506
        }
507
        elsif ($command eq "config") {
508
            &git($localpath, "config", @args);
Ian Lynagh's avatar
Ian Lynagh committed
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);
Edward Z. Yang's avatar
Edward Z. Yang committed
518
        }
519
        elsif ($command eq "tag") {
520
            &git($localpath, "tag", @args);
Ian Lynagh's avatar
Ian Lynagh committed
521
        }
522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543
        elsif ($command eq "compare") {
            # Don't compare the subrepos; it doesn't work properly as
            # they aren't on a branch.
            next if $remotepath eq "-";

            my $compareto;
            if ($#args eq -1) {
                $compareto = $path;
            }
            elsif ($#args eq 0) {
                $compareto = "$args[0]/$localpath";
            }
            elsif ($#args eq 1 && $args[0] eq "-b") {
                $compareto = "$args[1]/$remotepath";
            }
            else {
                die "Bad args for compare";
            }
            print "$localpath";
            print (' ' x (40 - length($localpath)));
            my $branch = &readgit($localpath, "rev-parse", "--abbrev-ref", "HEAD");
            die "Bad branch: $branch"
544
                unless $branch =~ m!^[a-zA-Z][a-zA-Z0-9./-]*$!;
545 546 547 548 549 550 551 552 553 554 555 556 557
            my $us   = &readgit(".", "ls-remote", $localpath, "refs/heads/$branch");
            my $them = &readgit(".", "ls-remote", $compareto, "refs/heads/$branch");
            $us   =~ s/[[:space:]].*//;
            $them =~ s/[[:space:]].*//;
            die "Bad commit of mine: $us"     unless (length($us)   eq 40);
            die "Bad commit of theirs: $them" unless (length($them) eq 40);
            if ($us eq $them) {
                print "same\n";
            }
            else {
                print "DIFFERENT\n";
            }
        }
Ian Lynagh's avatar
Ian Lynagh committed
558 559 560
        else {
            die "Unknown command: $command";
        }
561
    }
562 563

    unlink "resume";
564 565
}

566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581
sub gitInitSubmodules {
    &git(".", "submodule", "init", @_);

    my ($repo_base, $checked_out_tree, $repo_local) = getrepo();
    # if we came from a local repository, grab our submodules from their
    # checkouts over there, if they exist.
    if ($repo_local) {
        my $gitConfig = &tryReadFile(".git/config");
        foreach $_ (split /^/, $gitConfig) {
            if ($_ =~ /^\[submodule "(.*)"\]$/ and -e "$repo_base/$1/.git") {
                &git(".", "config", "submodule.$1.url", "$repo_base/$1");
            }
        }
    }
}

582 583 584 585 586 587
sub checkCurrentBranchIsMaster {
    my $branch = `git symbolic-ref HEAD`;
    $branch =~ s/refs\/heads\///;
    $branch =~ s/\n//;

    if ($branch !~ /master/) {
leroux's avatar
leroux committed
588
        print "\nWarning: You are trying to 'pull' while on branch '$branch'.\n"
589 590 591 592 593
            . "Updates to this script will happen on the master branch which\n"
            . "means the version on this branch may be out of date.\n\n";
    }
}

594
sub help
595
{
596 597
        my $exit = shift;

598 599
        my $tags = join ' ', sort (grep !/^-$/, keys %tags);

600 601
        # Get the built in help
        my $help = <<END;
602 603
Usage:

604
./sync-all [-q] [-s] [--ignore-failure] [-r repo] [--checked-out] [--bare]
605
           [--<tag>] [--no-<tag>] [--resume]
dterei's avatar
dterei committed
606
           cmd [git flags]
607

608 609
    where <tag> is one of: $tags

610 611 612 613 614
Applies the command "cmd" to each repository in the tree.

A full repository tree is obtained by first cloning the ghc
repository, then getting the subrepositories with "sync-all get":

615
  \$ git clone http://git.haskell.org/ghc.git
616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634
  \$ cd ghc
  \$ ./sync-all get

After this, "./sync-all pull" will pull from the original repository
tree.

A remote pointing to another local repository tree can be added like
this:

  \$ ./sync-all -r /path/to/ghc remote add otherlocal

and then we can pull from this other tree with

  \$ ./sync-all pull otherlocal

-------------- Commands -----------------
get

    Clones all sub-repositories from the same place that the ghc
dterei's avatar
dterei committed
635
    repository was cloned from. See "which repos to use" below
636 637 638
    for details of how the subrepositories are laid out.

    There are various --<package-tag> options that can be given
dterei's avatar
dterei committed
639 640
    before "get" that enable extra repositories. The full list is
    given at the end of this help. For example:
641

642
    ./sync-all --nofib get
643

644
    would get the nofib repository in addition to the usual set of
645 646 647 648 649 650 651
    subrepositories.

remote add <remote-name>
remote rm <remote-name>
remote set-url [--push] <remote-name>

    Runs a "git remote" command on each subrepository, adjusting the
dterei's avatar
dterei committed
652
    repository location in each case appropriately. For example, to
653 654
    add a new remote pointing to the upstream repositories:

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
dterei's avatar
dterei committed
658
    repos to use" below). For a repository on the local filesystem it
Simon Marlow's avatar
typo  
Simon Marlow committed
659
    would point to the ghc repository, and for a remote repository it
660 661
    points to the directory containing "ghc.git".

662 663 664 665 666 667 668 669 670 671 672
compare
compare reporoot
compare -b reporoot

    Compare the git HEADs of the repos to the origin repos, or the
    repos under reporoot (which is assumde to be a checked-out tree
    unless the -b flag is used).

    1 line is printed for each repo, indicating whether the repo is
    at the "same" or a "DIFFERENT" commit.

673 674 675
These commands just run the equivalent git command on each repository, passing
any extra arguments to git:

676
  branch
677 678 679 680
  checkout
  clean
  commit
  config
Ian Lynagh's avatar
Ian Lynagh committed
681
  diff
682
  fetch
683
  format-patch
684
  gc
685 686 687
  grep
  log
  new
tibbe's avatar
tibbe committed
688
  new-workdir
689 690
  pull
  push
691
  repack
692 693 694
  reset
  send
  status
Ian Lynagh's avatar
Ian Lynagh committed
695
  tag
696 697

-------------- Flags -------------------
dterei's avatar
dterei committed
698 699
These flags are given *before* the command and modify the way sync-all behaves.
Flags given *after* the command are passed to git.
700

daniel.is.fischer's avatar
daniel.is.fischer committed
701
  -q says to be quiet, and -s to be silent.
702

dterei's avatar
dterei committed
703 704 705
  --resume will restart a command that failed, from the repo at which it
  failed. This means you don't need to wait while, e.g., "pull" goes through
  all the repos it's just pulled, and tries to pull them again.
706 707 708 709 710

  --ignore-failure says to ignore errors and move on to the next repository

  -r repo says to use repo as the location of package repositories

dterei's avatar
dterei committed
711 712 713 714 715
  --checked-out says that the remote repo is in checked-out layout, as opposed
  to the layout used for the main repo. By default a repo on the local
  filesystem is assumed to be checked-out, and repos accessed via HTTP or SSH
  are assumed to be in the main repo layout; use --checked-out to override the
  latter.
716

dterei's avatar
dterei committed
717 718 719
  --bare says that the local repo is in bare layout, same as the main repo. It
  also means that these repos are bare. You only have to use this flag if you
  don't have a bare ghc.git in the current directory and would like to 'get'
720 721 722
  all of the repos bare. Requires packages.conf to be present in the current
  directory (a renamed packages file from the main ghc repo).

daniel.is.fischer's avatar
daniel.is.fischer committed
723
  Note: --checked-out and --bare flags are NOT the opposite of each other.
724 725 726
        --checked-out: describes the layout of the remote repository tree.
        --bare:        describes the layout of the local repository tree.

dterei's avatar
dterei committed
727 728 729 730
  --nofib also clones the nofib benchmark suite

  --extra also clone some extra library packages

Gabor Greif's avatar
Gabor Greif committed
731
  --no-dph avoids cloning the dph packages
dterei's avatar
dterei committed
732 733 734 735 736 737


------------ Checking out a branch -------------
To check out a branch you can run the following command:

  \$ ./sync-all checkout ghc-7.4
738 739 740


------------ Which repos to use -------------
dterei's avatar
dterei committed
741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760
sync-all uses the following algorithm to decide which remote repos to use

It always computes the remote repos from a single base, <repo_base> How is
<repo_base> set? If you say "-r repo", then that's <repo_base> otherwise
<repo_base> is set by asking git where the ghc repo came from, and removing the
last component (e.g. /ghc.git/ or /ghc/).

Then sync-all iterates over the package found in the file ./packages; see that
file for a description of the contents.

If <repo_base> looks like a local filesystem path, or if you give the
--checked-out flag, sync-all works on repos of form:

  <repo_base>/<local-path>

otherwise sync-all works on repos of form:

  <repo_base>/<remote-path>

This logic lets you say
761
  both    sync-all -r http://example.org/ghc-6.12 remote add ghc-6.12
dterei's avatar
dterei committed
762 763 764 765 766 767
  and     sync-all -r ../working remote add working
The latter is called a "checked-out tree".

sync-all *ignores* the defaultrepo of all repos other than the root one. So the
remote repos must be laid out in one of the two formats given by <local-path>
and <remote-path> in the file 'packages'.
768

769 770 771 772 773
Available package-tags are:
END

        # Collect all the tags in the packages file
        my %available_tags;
774 775 776
        open IN, "< packages.conf"
            or open IN, "< packages" # clashes with packages directory when using --bare
            or die "Can't open packages file (or packages.conf)";
777 778 779 780 781 782 783 784 785 786 787 788
        while (<IN>) {
            chomp;
            if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
                if (defined($2) && $2 ne "-") {
                    $available_tags{$2} = 1;
                }
            }
            elsif (! /^(#.*)?$/) {
                die "Bad line: $_";
            }
        }
        close IN;
daniel.is.fischer's avatar
daniel.is.fischer committed
789

790 791
        # Show those tags and the help text
        my @available_tags = keys %available_tags;
792 793
        print "$help@available_tags\n\n";
        exit $exit;
794 795
}

796 797
sub main {

798 799
    &parsePackages();

Simon Marlow's avatar
Simon Marlow committed
800 801
    $tags{"-"} = 1;
    $tags{"dph"} = 1;
802
    if ($OSNAME =~ /^(MSWin32|Cygwin|msys)$/) {
803 804
        $tags{"windows"} = 1;
    }
Simon Marlow's avatar
Simon Marlow committed
805

806 807 808 809 810 811 812 813 814 815
    while ($#_ ne -1) {
        my $arg = shift;
        # We handle -q here as well as lower down as we need to skip over it
        # if it comes before the source-control command
        if ($arg eq "-q") {
            $verbose = 1;
        }
        elsif ($arg eq "-s") {
            $verbose = 0;
        }
Simon Marlow's avatar
Simon Marlow committed
816 817 818
        elsif ($arg eq "-r") {
            $defaultrepo = shift;
        }
819 820 821
        elsif ($arg eq "--resume") {
            $try_to_resume = 1;
        }
822 823 824
        elsif ($arg eq "--ignore-failure") {
            $ignore_failure = 1;
        }
825 826 827
        elsif ($arg eq "--complete" || $arg eq "--partial") {
            $get_mode = $arg;
        }
828
        # Use --checked-out if the _remote_ repos are a checked-out tree,
Simon Marlow's avatar
Simon Marlow committed
829 830 831 832
        # rather than the master trees.
        elsif ($arg eq "--checked-out") {
            $checked_out_flag = 1;
        }
833 834 835 836 837
        # Use --bare if the _local_ repos are bare repos,
        # rather than a checked-out tree.
        elsif ($arg eq "--bare") {
            $bare_flag = $arg;
        }
838 839 840
        elsif ($arg eq "--help") {
            help(0);
        }
841 842
        # --<tag> says we grab the libs tagged 'tag' with
        # 'get'. It has no effect on the other commands.
843
        elsif ($arg =~ m/^--no-(.*)$/ && defined($tags{$1})) {
844 845
            $tags{$1} = 0;
        }
846
        elsif ($arg =~ m/^--(.*)$/ && defined($tags{$1})) {
847
            $tags{$1} = 1;
848
        }
849 850 851
        elsif ($arg =~ m/^-/) {
            die "Unrecognised flag: $arg";
        }
852 853 854 855 856 857 858 859 860
        else {
            unshift @_, $arg;
            if (grep /^-q$/, @_) {
                $verbose = 1;
            }
            last;
        }
    }

861 862 863 864 865 866 867
    # check for ghc repositories in cwd
    my $checked_out_found = 1 if (-d ".git" && -d "compiler");
    my $bare_found = 1 if (-d "ghc.git");

    if ($bare_flag && ! $bare_found && ! $defaultrepo) {
        die "error: bare repository ghc.git not found.\n"
          . "       Either clone a bare ghc repo first or specify the repo location. E.g.:\n"
868
          . "       ./sync-all --bare [--nofib --extra] -r http://git.haskell.org get\n"
869 870 871 872 873 874 875 876
    }
    elsif ($bare_found) {
        $bare_flag = "--bare";
    }
    elsif (! $bare_flag && ! $checked_out_found) {
        die "error: sync-all must be run from the top level of the ghc tree.";
    }

877
    if ($#_ eq -1) {
878
        help(1);
879 880 881
    }
    else {
        # Give the command and rest of the arguments to the main loop
882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901
        # We normalise command names here to avoid duplicating the
        # abbreviations that we allow.
        my $command = shift;

        if ($command =~ /^(?:g|ge|get)$/) {
            $command = "get";
        }
        elsif ($command =~ /^(?:pus|push)$/) {
            $command = "push";
        }
        elsif ($command =~ /^(?:pul|pull)$/) {
            $command = "pull";
        }
        elsif ($command =~ /^(?:s|se|sen|send)$/) {
            $command = "send";
        }
        elsif ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew|status)$/) {
            $command = "status";
        }

902
        if ($command eq "push") {
903
            &gitall("check_submodules", @_);
904 905
        }

906
        &gitall($command, @_);
907

908 909
        my @submodule_args = grep(/^-q/,@_);

ian@well-typed.com's avatar
ian@well-typed.com committed
910
        if ($command eq "get") {
911
            &gitInitSubmodules(@submodule_args);
ian@well-typed.com's avatar
ian@well-typed.com committed
912
        }
913

ian@well-typed.com's avatar
ian@well-typed.com committed
914 915 916
        if ($command eq "pull") {
            my $gitConfig = &tryReadFile(".git/config");
            if ($gitConfig !~ /submodule/) {
917
                &gitInitSubmodules(@submodule_args);
ian@well-typed.com's avatar
ian@well-typed.com committed
918 919
            }
        }
920 921 922
        if ($command eq "get" or $command eq "pull") {
            my $gitConfig = &tryReadFile(".git/config");
            if ($gitConfig !~ /submodule/) {
923
                &gitInitSubmodules(@submodule_args);
924
            }
925
            &git(".", "submodule", "update", @submodule_args);
926
        }
927 928 929
    }
}

930
BEGIN {
931 932
    my %argvHash = map { $_, 1 } @ARGV;
    if ($argvHash {"pull"}) {
933 934
        checkCurrentBranchIsMaster();
    }
935
    $initial_working_directory = getcwd();
936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951

    #message "== Checking for left-over testsuite/.git folder";
    if (-d "testsuite/.git") {
        print <<EOF;
============================
ATTENTION!

You have a left-over testsuite/.git folder in your GHC tree!

Please backup or remove it (e.g. "rm -r testsuite/.git") before
proceeding as the testsuite Git repository is now tracked as part of
the ghc Git repository (see #8545 for more details)
============================
EOF
        die "detected obsolete testsuite/.git folder"
    }
952 953
}

954 955
END {
    my $ec = $?;
956 957

    chdir($initial_working_directory);
958 959 960 961 962 963 964 965 966 967 968 969

    message "== Checking for old haddock repo";
    if (-d "utils/haddock/.git") {
        chdir("utils/haddock");
        if ((system "git log -1 87e2ca11c3d1b1bc49900fba0b5c5c6f85650718 > /dev/null 2> /dev/null") == 0) {
            print <<EOF;
============================
ATTENTION!

You have an old haddock repository in your GHC tree!

Please remove it (e.g. "rm -r utils/haddock"), and then run
daniel.is.fischer's avatar
daniel.is.fischer committed
970
"./sync-all get" to get the new repository.
971 972 973
============================
EOF
        }
974
        chdir($initial_working_directory);
975 976 977 978 979 980 981 982 983 984 985 986 987
    }

    message "== Checking for old binary repo";
    if (-d "libraries/binary/.git") {
        chdir("libraries/binary");
        if ((system "git log -1 749ac0efbde3b14901417364a872796598747aaf > /dev/null 2> /dev/null") == 0) {
            print <<EOF;
============================
ATTENTION!

You have an old binary repository in your GHC tree!

Please remove it (e.g. "rm -r libraries/binary"), and then run
daniel.is.fischer's avatar
daniel.is.fischer committed
988
"./sync-all get" to get the new repository.
989 990 991
============================
EOF
        }
992
        chdir($initial_working_directory);
993 994
    }

995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009
    message "== Checking for old mtl repo";
    if (-d "libraries/mtl/.git") {
        chdir("libraries/mtl");
        if ((system "git log -1 c67d8f7247c612dc35242bc67e616f7ea35eadb9 > /dev/null 2> /dev/null") == 0) {
            print <<EOF;
============================
ATTENTION!

You have an old mtl repository in your GHC tree!

Please remove it (e.g. "rm -r libraries/mtl"), and then run
"./sync-all get" to get the new repository.
============================
EOF
        }
1010
        chdir($initial_working_directory);
1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027
    }

    message "== Checking for old Cabal repo";
    if (-d "libraries/Cabal/.git") {
        chdir("libraries/Cabal");
        if ((system "git log -1 c8ebd66a32865f72ae03ee0663c62df3d77f08fe > /dev/null 2> /dev/null") == 0) {
            print <<EOF;
============================
ATTENTION!

You have an old Cabal repository in your GHC tree!

Please remove it (e.g. "rm -r libraries/Cabal"), and then run
"./sync-all get" to get the new repository.
============================
EOF
        }
1028
        chdir($initial_working_directory);
1029 1030
    }

1031
    message "== Checking for old time from tarball";
1032
    if (-d "libraries/time" and ! -e "libraries/time/.git") {
1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044
            print <<EOF;
============================
ATTENTION!

You have an old time package in your GHC tree!

Please remove it (e.g. "rm -r libraries/time"), and then run
"./sync-all get" to get the new repository.
============================
EOF
    }

1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066
    message "== Checking for obsolete Git repo URL";
    my $repo_url = &readgit(".", 'config', '--get', 'remote.origin.url');
    if ($repo_url =~ /^http:\/\/darcs.haskell.org/) {
            print <<EOF;
============================
ATTENTION!

You seem to be using obsolete Git repository URLs.

Please run

  ./sync-all -r git://git.haskell.org remote set-url

or (in case port 9418/tcp is filtered by your firewall)

  ./sync-all -r http://git.haskell.org remote set-url

to update your local checkout to use the new Git URLs.
============================
EOF
    }

1067 1068 1069
    $? = $ec;
}

1070