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

use strict;
use Cwd;

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

8
9
my $initial_working_directory;

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

# Figure out where to get the other repositories from.
sub getrepo {
Simon Marlow's avatar
Simon Marlow committed
23
24
25
26
27
28
29
30
    my $repo;

    if (defined($defaultrepo)) {
        $repo = $defaultrepo;
        chomp $repo;
    } else {
        # Figure out where to get the other repositories from,
        # based on where this GHC repo came from.
31
        my $git_dir = $bare_flag ? "--git-dir=ghc.git" : "";
32
        my $branch  = `git $git_dir rev-parse --abbrev-ref HEAD`;          chomp $branch;
33
34
35
36
37
38
        my $remote  = `git $git_dir config branch.$branch.remote`;         chomp $remote;
        if ($remote eq "") {
            # remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
            $remote = "origin";
        }
        $repo       = `git $git_dir config remote.$remote.url`;            chomp $repo;
Simon Marlow's avatar
Simon Marlow committed
39
    }
Simon Marlow's avatar
Simon Marlow committed
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

    my $repo_base;
    my $checked_out_tree;

    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:
        #
        #   http://darcs.haskell.org
        #
        # rather than
daniel.is.fischer's avatar
daniel.is.fischer committed
64
        #
Simon Marlow's avatar
Simon Marlow committed
65
66
67
68
69
70
71
        #   http://darcs.haskell.org/ghc
        #
        if (!$defaultrepo) {
            $repo_base =~ s#/[^/]+/?$##;
        }
    }
    elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
72
        # Local filesystem, either absolute (C:/ or /) or relative (../) path
Simon Marlow's avatar
Simon Marlow committed
73
        $repo_base = $repo;
74
75
76
77
78
79
80
81
82
83
84
        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;
        }
Simon Marlow's avatar
Simon Marlow committed
85
86
87
88
89
90
91
92
93
94
95
96
    }
    else {
        die "Couldn't work out repo";
    }

    return $repo_base, $checked_out_tree;
}

sub parsePackages {
    my @repos;
    my $lineNum;

97
98
99
    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
100
101
102
103
104
105
106
107
    @repos = <IN>;
    close IN;

    @packages = ();
    $lineNum = 0;
    foreach (@repos) {
        chomp;
        $lineNum++;
108
        if (/^([^# ]+) +([^ ]+) +([^ ]+)$/) {
Simon Marlow's avatar
Simon Marlow committed
109
110
111
112
113
114
115
116
117
118
119
            my %line;
            $line{"localpath"}  = $1;
            $line{"tag"}        = $2;
            $line{"remotepath"} = $3;
            push @packages, \%line;
        }
        elsif (! /^(#.*)?$/) {
            die "Bad content on line $lineNum of packages file: $_";
        }
    }
}
120

121
122
123
124
125
126
127
128
129
130
sub tryReadFile {
    my $filename = shift;
    my @lines;

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

131
132
133
134
135
136
137
138
139
140
141
142
sub message {
    if ($verbose >= 2) {
        print "@_\n";
    }
}

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

tibbe's avatar
tibbe committed
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
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 '.') {
160
        chdir($initial_working_directory);
tibbe's avatar
tibbe committed
161
162
163
    }
}

164
165
166
sub configure_repository {
    my $localpath = shift;

167
    &git($localpath, "config", "--local", "core.ignorecase", "true");
168
169
170
171
172
173
174
175
176
177

    chdir($localpath);
    open my $git_autocrlf, '-|', 'git', 'config', '--get', 'core.autocrlf'
        or die "Executing git config failed: $!";
    my $autocrlf = <$git_autocrlf>;
    $autocrlf = "" unless defined($autocrlf);
    chomp $autocrlf;
    close($git_autocrlf);
    chdir($initial_working_directory);
    if ($autocrlf eq "true") {
178
179
        &git($localpath, "config", "--local", "core.autocrlf", "false");
        &git($localpath, "reset", "--hard");
180
181
182
    }
}

183
sub git {
Simon Marlow's avatar
Simon Marlow committed
184
185
186
    my $dir = shift;

    if ($dir eq '.') {
187
        message "== running git @_";
Simon Marlow's avatar
Simon Marlow committed
188
    } else {
189
        message "== $dir: running git @_";
Simon Marlow's avatar
Simon Marlow committed
190
191
192
        chdir($dir);
    }

193
    system ("git", @_) == 0
194
        or $ignore_failure
195
        or die "git failed: $?";
Simon Marlow's avatar
Simon Marlow committed
196
197

    if ($dir ne '.') {
198
        chdir($initial_working_directory);
Simon Marlow's avatar
Simon Marlow committed
199
    }
200
201
}

202
sub gitall {
203
    my $command = shift;
daniel.is.fischer's avatar
daniel.is.fischer committed
204

205
206
207
    my $localpath;
    my $tag;
    my $remotepath;
Simon Marlow's avatar
Simon Marlow committed
208
    my $line;
209
210
    my $branch_name;
    my $subcommand;
211
212
213

    my $path;

214
    my @args;
Simon Marlow's avatar
Simon Marlow committed
215

216
217
218
219
    my $started;
    my $doing;
    my $start_repo;

Simon Marlow's avatar
Simon Marlow committed
220
221
    my ($repo_base, $checked_out_tree) = getrepo();

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

Simon Marlow's avatar
Simon Marlow committed
224
225
    parsePackages;

226
227
    @args = ();

228
    if ($command =~ /^remote$/) {
229
230
        while (@_ > 0 && $_[0] =~ /^-/) {
            push(@args,shift);
231
        }
232
        if (@_ < 1) { help(1); }
233
        $subcommand = shift;
234
235
236
237
        if ($subcommand ne 'add' &&
            $subcommand ne 'rm' &&
            $subcommand ne 'set-branches' &&
            $subcommand ne 'set-url') {
238
            help(1);
239
        }
240
241
242
243
        while (@_ > 0 && $_[0] =~ /^-/) {
            push(@args,shift);
        }
        if (($subcommand eq 'add' || $subcommand eq 'rm') && @_ < 1) {
244
            help(1);
245
246
247
248
249
        } elsif (@_ < 1) { # set-url
            $branch_name = 'origin';
        } else {
            $branch_name = shift;
        }
Ian Lynagh's avatar
Ian Lynagh committed
250
    } elsif ($command eq 'new') {
251
252
253
254
255
        if (@_ < 1) {
            $branch_name = 'origin';
        } else {
            $branch_name = shift;
        }
256
257
    }

258
259
    push(@args, @_);

260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
    # $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
278
    for $line (@packages) {
Ian Lynagh's avatar
Ian Lynagh committed
279
        $tag        = $$line{"tag"};
280
        # Use the "remote" structure for bare git repositories
281
        $localpath  = ($bare_flag) ?
282
                      $$line{"remotepath"} : $$line{"localpath"};
283
        $remotepath = ($checked_out_tree) ?
284
                      $$line{"localpath"}  : $$line{"remotepath"};
285

286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
        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
301
        # We can't create directories on GitHub, so we translate
302
        # "packages/foo" into "package-foo".
Ian Lynagh's avatar
Ian Lynagh committed
303
304
305
        if ($is_github_repo) {
            $remotepath =~ s/\//-/;
        }
306

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

310
        if ($command eq "get") {
311
312
            next if $remotepath eq "-"; # "git submodule init/update" will get this later

Ian Lynagh's avatar
Ian Lynagh committed
313
314
315
            # Skip any repositories we have not included the tag for
            if (not defined($tags{$tag})) {
                $tags{$tag} = 0;
316
            }
Ian Lynagh's avatar
Ian Lynagh committed
317
318
            if ($tags{$tag} == 0) {
                next;
319
            }
daniel.is.fischer's avatar
daniel.is.fischer committed
320

Ian Lynagh's avatar
Ian Lynagh committed
321
322
323
            if (-d $localpath) {
                warning("$localpath already present; omitting")
                    if $localpath ne ".";
324
                &configure_repository($localpath);
Ian Lynagh's avatar
Ian Lynagh committed
325
                next;
326
            }
327

Ian Lynagh's avatar
Ian Lynagh committed
328
329
            # Note that we use "." as the path, as $localpath
            # doesn't exist yet.
330
331
            my @argsWithBare = @args;
            push @argsWithBare, $bare_flag if $bare_flag;
332
333
            &git(".", "clone", $path, $localpath, @argsWithBare);
            &configure_repository($localpath);
Ian Lynagh's avatar
Ian Lynagh committed
334
335
336
            next;
        }

337
        my $git_repo_present = 1 if -e "$localpath/.git" || ($bare_flag && -d "$localpath");
338
339
340
341
342
343
344
345
        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
346
347
348
        }

        # Work out the arguments we should give to the SCM
349
        if ($command eq "status") {
350
            &git($localpath, $command, @args);
Ian Lynagh's avatar
Ian Lynagh committed
351
        }
352
        elsif ($command eq "commit") {
Ian Lynagh's avatar
Ian Lynagh committed
353
354
            # git fails if there is nothing to commit, so ignore failures
            $ignore_failure = 1;
355
            &git($localpath, "commit", @args);
Ian Lynagh's avatar
Ian Lynagh committed
356
        }
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
        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);

                open my $revparse, '-|', 'git', 'rev-parse', '--verify', 'HEAD'
                    or die "Executing rev-parse failed: $!";
                my $myhead;
                $myhead = <$revparse>;
                    # or die "Failed to read from rev-parse: $!";
                chomp $myhead;
                close($revparse);

                if (not defined($remote_heads{$myhead})) {
                    die "Sub module $localpath needs to be pushed; see http://hackage.haskell.org/trac/ghc/wiki/Repositories/Upstream";
                }
                
                chdir($initial_working_directory);
            }
        }
393
        elsif ($command eq "push") {
394
395
396
397
398
            # 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
            # http://hackage.haskell.org/trac/ghc/wiki/Repositories/Upstream
            if ($remotepath ne "-") {
399
                &git($localpath, "push", @args);
400
            }
Ian Lynagh's avatar
Ian Lynagh committed
401
        }
402
        elsif ($command eq "pull") {
403
            my $realcmd;
404
            my @realargs;
405
406
407
408
            if ($remotepath eq "-") {
                # Only fetch for the submodules. "git submodule update"
                # will take care of making us point to the right commit.
                $realcmd = "fetch";
409
410
                # we like "sync-all pull --rebase" to work:
                @realargs = grep(!/--rebase/,@args);
411
412
413
            }
            else {
                $realcmd = "pull";
414
                @realargs = @args;
415
            }
416
            &git($localpath, $realcmd, @realargs);
Ian Lynagh's avatar
Ian Lynagh committed
417
        }
418
        elsif ($command eq "new-workdir") {
tibbe's avatar
tibbe committed
419
420
            gitNewWorkdir ($localpath, @args);
        }
421
        elsif ($command eq "send") {
422
            $command = "send-email";
423
            &git($localpath, $command, @args);
Ian Lynagh's avatar
Ian Lynagh committed
424
        }
425
        elsif ($command eq "fetch") {
426
            &git($localpath, "fetch", @args);
Ian Lynagh's avatar
Ian Lynagh committed
427
        }
428
        elsif ($command eq "new") {
Ian Lynagh's avatar
Ian Lynagh committed
429
            my @scm_args = ("log", "$branch_name..");
430
            &git($localpath, @scm_args, @args);
Ian Lynagh's avatar
Ian Lynagh committed
431
        }
432
        elsif ($command eq "log") {
433
            &git($localpath, "log", @args);
Simon Marlow's avatar
Simon Marlow committed
434
        }
435
        elsif ($command eq "remote") {
Ian Lynagh's avatar
Ian Lynagh committed
436
            my @scm_args;
437
            my $rpath;
438
            $ignore_failure = 1;
439
440
441
442
443
            if ($remotepath eq '-') {
                $rpath = "$repo_base/$localpath";
            } else {
                $rpath = $path;
            }
Ian Lynagh's avatar
Ian Lynagh committed
444
            if ($subcommand eq 'add') {
445
                @scm_args = ("remote", "add", $branch_name, $rpath);
Ian Lynagh's avatar
Ian Lynagh committed
446
447
            } elsif ($subcommand eq 'rm') {
                @scm_args = ("remote", "rm", $branch_name);
448
449
            } elsif ($subcommand eq 'set-branches') {
                @scm_args = ("remote", "set-branches", $branch_name);
Ian Lynagh's avatar
Ian Lynagh committed
450
            } elsif ($subcommand eq 'set-url') {
451
                @scm_args = ("remote", "set-url", $branch_name, $rpath);
Ian Lynagh's avatar
Ian Lynagh committed
452
            }
453
            &git($localpath, @scm_args, @args);
Ian Lynagh's avatar
Ian Lynagh committed
454
        }
455
        elsif ($command eq "checkout") {
456
457
            # Not all repos are necessarily branched, so ignore failure
            $ignore_failure = 1;
458
            &git($localpath, "checkout", @args);
Ian Lynagh's avatar
Ian Lynagh committed
459
        }
460
        elsif ($command eq "grep") {
Ian Lynagh's avatar
Ian Lynagh committed
461
462
            # Hack around 'git grep' failing if there are no matches
            $ignore_failure = 1;
463
            &git($localpath, "grep", @args);
Ian Lynagh's avatar
Ian Lynagh committed
464
        }
465
        elsif ($command eq "diff") {
466
            &git($localpath, "diff", @args);
Ian Lynagh's avatar
Ian Lynagh committed
467
        }
468
        elsif ($command eq "clean") {
469
            &git($localpath, "clean", @args);
kili's avatar
kili committed
470
        }
471
        elsif ($command eq "reset") {
472
            &git($localpath, "reset", @args);
Ian Lynagh's avatar
Ian Lynagh committed
473
        }
474
        elsif ($command eq "branch") {
475
            &git($localpath, "branch", @args);
476
        }
477
        elsif ($command eq "config") {
478
            &git($localpath, "config", @args);
Ian Lynagh's avatar
Ian Lynagh committed
479
        }
480
        elsif ($command eq "repack") {
481
            &git($localpath, "repack", @args);
482
        }
483
        elsif ($command eq "format-patch") {
484
            &git($localpath, "format-patch", @args);
485
        }
486
        elsif ($command eq "gc") {
487
            &git($localpath, "gc", @args);
Edward Z. Yang's avatar
Edward Z. Yang committed
488
        }
489
        elsif ($command eq "tag") {
490
            &git($localpath, "tag", @args);
Ian Lynagh's avatar
Ian Lynagh committed
491
        }
Ian Lynagh's avatar
Ian Lynagh committed
492
493
494
        else {
            die "Unknown command: $command";
        }
495
    }
496
497

    unlink "resume";
498
499
}

500
sub help
501
{
502
503
        my $exit = shift;

504
505
        # Get the built in help
        my $help = <<END;
506
507
Usage:

508
./sync-all [-q] [-s] [--ignore-failure] [-r repo] [--checked-out] [--bare]
dterei's avatar
dterei committed
509
510
           [--nofib] [--extra] [--testsuite] [--no-dph] [--resume]
           cmd [git flags]
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536

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":

  \$ git clone http://darcs.haskell.org/ghc.git
  \$ 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
537
    repository was cloned from. See "which repos to use" below
538
539
540
    for details of how the subrepositories are laid out.

    There are various --<package-tag> options that can be given
dterei's avatar
dterei committed
541
542
    before "get" that enable extra repositories. The full list is
    given at the end of this help. For example:
543
544
545
546
547
548
549
550
551
552
553

    ./sync-all --testsuite get

    would get the testsuite repository in addition to the usual set of
    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
554
    repository location in each case appropriately. For example, to
555
556
557
558
559
    add a new remote pointing to the upstream repositories:

    ./sync-all -r http://darcs.haskell.org/ remote add upstream

    The -r flag points to the root of the repository tree (see "which
dterei's avatar
dterei committed
560
    repos to use" below). For a repository on the local filesystem it
Simon Marlow's avatar
typo    
Simon Marlow committed
561
    would point to the ghc repository, and for a remote repository it
562
563
564
565
566
    points to the directory containing "ghc.git".

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

567
  branch
568
569
570
571
  checkout
  clean
  commit
  config
Ian Lynagh's avatar
Ian Lynagh committed
572
  diff
573
  fetch
574
  format-patch
575
  gc
576
577
578
  grep
  log
  new
tibbe's avatar
tibbe committed
579
  new-workdir
580
581
  pull
  push
582
  repack
583
584
585
  reset
  send
  status
Ian Lynagh's avatar
Ian Lynagh committed
586
  tag
587
588

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

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

dterei's avatar
dterei committed
594
595
596
  --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.
597
598
599
600
601

  --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
602
603
604
605
606
  --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.
607

dterei's avatar
dterei committed
608
609
610
  --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'
611
612
613
  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
614
  Note: --checked-out and --bare flags are NOT the opposite of each other.
615
616
617
        --checked-out: describes the layout of the remote repository tree.
        --bare:        describes the layout of the local repository tree.

dterei's avatar
dterei committed
618
619
620
621
622
623
624
625
626
627
628
629
630
  --nofib also clones the nofib benchmark suite

  --testsuite also clones the ghc testsuite 

  --extra also clone some extra library packages

  --no-dph avoids cloning the dph pacakges


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

  \$ ./sync-all checkout ghc-7.4
631
632
633


------------ Which repos to use -------------
dterei's avatar
dterei committed
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
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
  both    sync-all -r http://darcs.haskell.org/ghc-6.12 remote add ghc-6.12
  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'.
661

662
663
664
665
666
Available package-tags are:
END

        # Collect all the tags in the packages file
        my %available_tags;
667
668
669
        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)";
670
671
672
673
674
675
676
677
678
679
680
681
        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
682

683
684
        # Show those tags and the help text
        my @available_tags = keys %available_tags;
685
686
        print "$help@available_tags\n\n";
        exit $exit;
687
688
}

689
690
sub main {

Simon Marlow's avatar
Simon Marlow committed
691
692
693
    $tags{"-"} = 1;
    $tags{"dph"} = 1;

694
695
696
697
698
699
700
701
702
703
    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
704
705
706
        elsif ($arg eq "-r") {
            $defaultrepo = shift;
        }
707
708
709
        elsif ($arg eq "--resume") {
            $try_to_resume = 1;
        }
710
711
712
        elsif ($arg eq "--ignore-failure") {
            $ignore_failure = 1;
        }
713
714
715
        elsif ($arg eq "--complete" || $arg eq "--partial") {
            $get_mode = $arg;
        }
716
        # Use --checked-out if the _remote_ repos are a checked-out tree,
Simon Marlow's avatar
Simon Marlow committed
717
718
719
720
        # rather than the master trees.
        elsif ($arg eq "--checked-out") {
            $checked_out_flag = 1;
        }
721
722
723
724
725
        # Use --bare if the _local_ repos are bare repos,
        # rather than a checked-out tree.
        elsif ($arg eq "--bare") {
            $bare_flag = $arg;
        }
726
727
728
        elsif ($arg eq "--help") {
            help(0);
        }
729
730
        # --<tag> says we grab the libs tagged 'tag' with
        # 'get'. It has no effect on the other commands.
731
732
733
734
735
        elsif ($arg =~ m/^--no-(.*)$/) {
            $tags{$1} = 0;
        }
        elsif ($arg =~ m/^--(.*)$/) {
            $tags{$1} = 1;
736
737
738
739
740
741
742
743
744
745
        }
        else {
            unshift @_, $arg;
            if (grep /^-q$/, @_) {
                $verbose = 1;
            }
            last;
        }
    }

746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
    # 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"
          . "       ./sync-all --bare [--testsuite --nofib --extra] -r http://darcs.haskell.org/ get\n"
    }
    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.";
    }

762
    if ($#_ eq -1) {
763
        help(1);
764
765
766
    }
    else {
        # Give the command and rest of the arguments to the main loop
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
        # 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";
        }

787
        if ($command eq "push") {
788
            &gitall("check_submodules", @_);
789
790
        }

791
        &gitall($command, @_);
792

793
794
        my @submodule_args = grep(/^-q/,@_);

ian@well-typed.com's avatar
ian@well-typed.com committed
795
        if ($command eq "get") {
796
            &git(".", "submodule", "init", @submodule_args);
ian@well-typed.com's avatar
ian@well-typed.com committed
797
798
799
800
        }
        if ($command eq "pull") {
            my $gitConfig = &tryReadFile(".git/config");
            if ($gitConfig !~ /submodule/) {
801
                &git(".", "submodule", "init", @submodule_args);
ian@well-typed.com's avatar
ian@well-typed.com committed
802
803
            }
        }
804
805
806
        if ($command eq "get" or $command eq "pull") {
            my $gitConfig = &tryReadFile(".git/config");
            if ($gitConfig !~ /submodule/) {
807
                &git(".", "submodule", "init", @submodule_args);
808
            }
809
            &git(".", "submodule", "update", @submodule_args);
810
        }
811
812
813
    }
}

814
815
816
817
BEGIN {
    $initial_working_directory = getcwd();
}

818
819
END {
    my $ec = $?;
820
821

    chdir($initial_working_directory);
822
823
824
825
826
827
828
829
830
831
832
833

    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
834
"./sync-all get" to get the new repository.
835
836
837
============================
EOF
        }
838
        chdir($initial_working_directory);
839
840
841
842
843
844
845
846
847
848
849
850
851
    }

    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
852
"./sync-all get" to get the new repository.
853
854
855
============================
EOF
        }
856
        chdir($initial_working_directory);
857
858
    }

859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
    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
        }
874
        chdir($initial_working_directory);
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
    }

    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
        }
892
        chdir($initial_working_directory);
893
894
    }

895
    message "== Checking for old time from tarball";
896
    if (-d "libraries/time" and ! -e "libraries/time/.git") {
897
898
899
900
901
902
903
904
905
906
907
908
            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
    }

909
910
911
    $? = $ec;
}

912
913
main(@ARGV);