Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 506 lines (444 sloc) 14.069 kb
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
1 #!/usr/bin/perl -w
2
3 use strict;
4 use Cwd;
5
93e7418 @igfoo Add some comments to sync-all, based on darcs-all's comments
igfoo authored
6 # Usage:
7 #
8 # ./sync-all [-q] [-s] [--ignore-failure] [-r repo]
9 # [--nofib] [--testsuite] [--checked-out] cmd [git flags]
10 #
11 # Applies the command "cmd" to each repository in the tree.
12 # sync-all will try to do the right thing for both git and darcs repositories.
13 #
14 # e.g.
15 # ./sync-all -r http://darcs.haskell.org/ghc get
16 # To get any repos which do not exist in the local tree
17 #
18 # ./sync-all pull
19 # To pull everything from the default repos
20 #
21 # -------------- Flags -------------------
22 # -q says to be quite, and -s to be silent.
23 #
24 # --ignore-failure says to ignore errors and move on to the next repository
25 #
26 # -r repo says to use repo as the location of package repositories
27 #
28 # --checked-out says that the remote repo is in checked-out layout, as
29 # opposed to the layout used for the main repo. By default a repo on
30 # the local filesystem is assumed to be checked-out, and repos accessed
31 # via HTTP or SSH are assumed to be in the main repo layout; use
32 # --checked-out to override the latter.
33 #
34 # --nofib, --testsuite also get the nofib and testsuite repos respectively
35 #
36 # ------------ Which repos to use -------------
37 # sync-all uses the following algorithm to decide which remote repos to use
38 #
39 # It always computes the remote repos from a single base, $repo_base
40 # How is $repo_base set?
41 # If you say "-r repo", then that's $repo_base
42 # otherwise $repo_base is set by asking git where the ghc repo came
43 # from, and removing the last component (e.g. /ghc.git/ of /ghc/).
44 #
45 # Then sync-all iterates over the package found in the file
46 # ./packages; see that file for a description of the contents.
47 #
48 # If $repo_base looks like a local filesystem path, or if you give
49 # the --checked-out flag, sync-all works on repos of form
50 # $repo_base/<local-path>
51 # otherwise sync-all works on repos of form
52 # $repo_base/<remote-path>
53 # This logic lets you say
54 # both sync-all -r http://darcs.haskell.org/ghc-6.12 pull
55 # and sync-all -r ../HEAD pull
56 # The latter is called a "checked-out tree".
57
58 # NB: sync-all *ignores* the defaultrepo of all repos other than the
59 # root one. So the remote repos must be laid out in one of the two
60 # formats given by <local-path> and <remote-path> in the file 'packages'.
61
2fe9913 @igfoo Turn on autoflush in sync-all
igfoo authored
62 $| = 1; # autoflush stdout after each print, to avoid output after die
63
dd8816c @simonmar fix for remote repos without -r
simonmar authored
64 my $defaultrepo;
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
65 my @packages;
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
66 my $verbose = 2;
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
67 my $ignore_failure = 0;
68 my $checked_out_flag = 0;
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
69 my $get_mode;
70
71 # Flags specific to a particular command
72 my $local_repo_unnecessary = 0;
73
74 my %tags;
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
75
76 # Figure out where to get the other repositories from.
77 sub getrepo {
78 my $basedir = ".";
dd8816c @simonmar fix for remote repos without -r
simonmar authored
79 my $repo;
80
81 if (defined($defaultrepo)) {
82 $repo = $defaultrepo;
83 chomp $repo;
84 } else {
85 # Figure out where to get the other repositories from,
86 # based on where this GHC repo came from.
87 my $branch = `git branch | grep "\* " | sed "s/^\* //"`; chomp $branch;
88 my $remote = `git config branch.$branch.remote`; chomp $remote;
89 $repo = `git config remote.$remote.url`; chomp $repo;
90 }
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
91
92 my $repo_base;
93 my $checked_out_tree;
94
95 if ($repo =~ /^...*:/) {
96 # HTTP or SSH
97 # Above regex says "at least two chars before the :", to avoid
98 # catching Win32 drives ("C:\").
99 $repo_base = $repo;
100
101 # --checked-out is needed if you want to use a checked-out repo
102 # over SSH or HTTP
103 if ($checked_out_flag) {
104 $checked_out_tree = 1;
105 } else {
106 $checked_out_tree = 0;
107 }
108
109 # Don't drop the last part of the path if specified with -r, as
110 # it expects repos of the form:
111 #
112 # http://darcs.haskell.org
113 #
114 # rather than
115 #
116 # http://darcs.haskell.org/ghc
117 #
118 if (!$defaultrepo) {
119 $repo_base =~ s#/[^/]+/?$##;
120 }
121 }
122 elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
123 # Local filesystem, either absolute or relative path
124 # (assumes a checked-out tree):
125 $repo_base = $repo;
126 $checked_out_tree = 1;
127 }
128 else {
129 die "Couldn't work out repo";
130 }
131
132 return $repo_base, $checked_out_tree;
133 }
134
135 sub parsePackages {
136 my @repos;
137 my $lineNum;
138
90edc9c @igfoo Update meta-repo stuff
igfoo authored
139 open IN, "< packages" or die "Can't open packages file";
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
140 @repos = <IN>;
141 close IN;
142
143 @packages = ();
144 $lineNum = 0;
145 foreach (@repos) {
146 chomp;
147 $lineNum++;
148 if (/^([^# ]+) +([^ ]+) +([^ ]+) +([^ ]+) +([^ ]+)$/) {
149 my %line;
150 $line{"localpath"} = $1;
151 $line{"tag"} = $2;
152 $line{"remotepath"} = $3;
153 $line{"vcs"} = $4;
154 $line{"upstream"} = $5;
155 push @packages, \%line;
156 }
157 elsif (! /^(#.*)?$/) {
158 die "Bad content on line $lineNum of packages file: $_";
159 }
160 }
161 }
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
162
163 sub message {
164 if ($verbose >= 2) {
165 print "@_\n";
166 }
167 }
168
169 sub warning {
170 if ($verbose >= 1) {
171 print "warning: @_\n";
172 }
173 }
174
175 sub scm {
7978575 @simonmar fix 'sync-all pull'
simonmar authored
176 my $dir = shift;
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
177 my $scm = shift;
7978575 @simonmar fix 'sync-all pull'
simonmar authored
178 my $pwd;
179
180 if ($dir eq '.') {
181 message "== running $scm @_";
182 } else {
183 message "== $dir: running $scm @_";
184 $pwd = getcwd();
185 chdir($dir);
186 }
187
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
188 system ($scm, @_) == 0
189 or $ignore_failure
190 or die "$scm failed: $?";
7978575 @simonmar fix 'sync-all pull'
simonmar authored
191
192 if ($dir ne '.') {
193 chdir($pwd);
194 }
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
195 }
196
197 sub scmall {
198 my $command = shift;
199
200 my $localpath;
201 my $tag;
202 my $remotepath;
203 my $scm;
28b45c5 @simonmar update to work with current packages file format
simonmar authored
204 my $upstream;
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
205 my $line;
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
206 my $branch_name;
207 my $subcommand;
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
208
209 my $path;
210 my $wd_before = getcwd;
211
212 my @scm_args;
213
7978575 @simonmar fix 'sync-all pull'
simonmar authored
214 my $pwd;
b61c52d @simonmar remove set-origin and set-push commands; add "remote set-url [--push]" (...
simonmar authored
215 my @args;
7978575 @simonmar fix 'sync-all pull'
simonmar authored
216
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
217 my ($repo_base, $checked_out_tree) = getrepo();
218
e893450 @tibbe Make sync-all work with the GitHub mirror over HTTPS
tibbe authored
219 my $is_github_repo = $repo_base =~ m/(git@|git:\/\/|https:\/\/)github.com/;
2688d8d @nominolo Make sync-all work with the GitHub mirror.
nominolo authored
220
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
221 parsePackages;
222
b61c52d @simonmar remove set-origin and set-push commands; add "remote set-url [--push]" (...
simonmar authored
223 @args = ();
224
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
225 if ($command =~ /^remote$/) {
b61c52d @simonmar remove set-origin and set-push commands; add "remote set-url [--push]" (...
simonmar authored
226 while (@_ > 0 && $_[0] =~ /^-/) {
227 push(@args,shift);
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
228 }
b61c52d @simonmar remove set-origin and set-push commands; add "remote set-url [--push]" (...
simonmar authored
229 if (@_ < 1) { help(); }
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
230 $subcommand = shift;
b61c52d @simonmar remove set-origin and set-push commands; add "remote set-url [--push]" (...
simonmar authored
231 if ($subcommand ne 'add' && $subcommand ne 'rm' && $subcommand ne 'set-url') {
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
232 help();
233 }
b61c52d @simonmar remove set-origin and set-push commands; add "remote set-url [--push]" (...
simonmar authored
234 while (@_ > 0 && $_[0] =~ /^-/) {
235 push(@args,shift);
236 }
237 if (($subcommand eq 'add' || $subcommand eq 'rm') && @_ < 1) {
238 help();
239 } elsif (@_ < 1) { # set-url
240 $branch_name = 'origin';
241 } else {
242 $branch_name = shift;
243 }
c3740c9 @simonmar 'fetch' and 'new' can take branch names as arguments (defaulting to 'ori...
simonmar authored
244 } elsif ($command eq 'new' || $command eq 'fetch') {
245 if (@_ < 1) {
246 $branch_name = 'origin';
247 } else {
248 $branch_name = shift;
249 }
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
250 }
251
b61c52d @simonmar remove set-origin and set-push commands; add "remote set-url [--push]" (...
simonmar authored
252 push(@args, @_);
253
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
254 for $line (@packages) {
255
0885017 @igfoo Refactor sync-all a bit
igfoo authored
256 $localpath = $$line{"localpath"};
257 $tag = $$line{"tag"};
258 $remotepath = $$line{"remotepath"};
259 $scm = $$line{"vcs"};
260 $upstream = $$line{"upstream"};
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
261
0885017 @igfoo Refactor sync-all a bit
igfoo authored
262 # Check the SCM is OK as early as possible
263 die "Unknown SCM: $scm" if (($scm ne "darcs") and ($scm ne "git"));
2688d8d @nominolo Make sync-all work with the GitHub mirror.
nominolo authored
264
0885017 @igfoo Refactor sync-all a bit
igfoo authored
265 # We can't create directories on GitHub, so we translate
266 # "package/foo" into "package-foo".
267 if ($is_github_repo) {
268 $remotepath =~ s/\//-/;
269 }
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
270
0885017 @igfoo Refactor sync-all a bit
igfoo authored
271 # Work out the path for this package in the repo we pulled from
272 if ($checked_out_tree) {
273 $path = "$repo_base/$localpath";
274 }
275 else {
276 $path = "$repo_base/$remotepath";
277 }
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
278
0885017 @igfoo Refactor sync-all a bit
igfoo authored
279 if ($command =~ /^(?:g|ge|get)$/) {
280 # Skip any repositories we have not included the tag for
281 if (not defined($tags{$tag})) {
282 $tags{$tag} = 0;
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
283 }
0885017 @igfoo Refactor sync-all a bit
igfoo authored
284 if ($tags{$tag} == 0) {
285 next;
0cb84f3 @simonmar add "./sync-all fetch" and "./sync-all new"
simonmar authored
286 }
0885017 @igfoo Refactor sync-all a bit
igfoo authored
287
288 if (-d $localpath) {
289 warning("$localpath already present; omitting")
290 if $localpath ne ".";
291 next;
0cb84f3 @simonmar add "./sync-all fetch" and "./sync-all new"
simonmar authored
292 }
0885017 @igfoo Refactor sync-all a bit
igfoo authored
293
294 # The first time round the loop, default the get-mode
295 if ($scm eq "darcs" && not defined($get_mode)) {
296 warning("adding --partial, to override use --complete");
297 $get_mode = "--partial";
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
298 }
0885017 @igfoo Refactor sync-all a bit
igfoo authored
299
300 # The only command that doesn't need a repo
301 $local_repo_unnecessary = 1;
302
303 if ($scm eq "darcs") {
304 # Note: we can only use the get-mode with darcs for now
305 @scm_args = ("get", $get_mode, $path, $localpath);
78946b2 @tibbe Add 'sync-all grep'
tibbe authored
306 }
0885017 @igfoo Refactor sync-all a bit
igfoo authored
307 else {
308 @scm_args = ("clone", $path, $localpath);
95ba531 @igfoo Add "./sync-all reset" command
igfoo authored
309 }
0885017 @igfoo Refactor sync-all a bit
igfoo authored
310
311 # Note that we use "." as the path, as $localpath
312 # doesn't exist yet.
313 scm (".", $scm, @scm_args, @args);
314 next;
315 }
316
317 if (-d "$localpath/_darcs") {
318 if (-d "$localpath/.git") {
319 die "Found both _darcs and .git in $localpath";
b100191 @igfoo Add "./sync-all config" command
igfoo authored
320 }
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
321 else {
0885017 @igfoo Refactor sync-all a bit
igfoo authored
322 $scm = "darcs";
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
323 }
0885017 @igfoo Refactor sync-all a bit
igfoo authored
324 }
325 else {
326 if (-d "$localpath/.git") {
327 $scm = "git";
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
328 }
329 elsif ($tag eq "") {
0885017 @igfoo Refactor sync-all a bit
igfoo authored
330 die "Required repo $localpath is missing";
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
331 }
332 else {
333 message "== $localpath repo not present; skipping";
334 }
0885017 @igfoo Refactor sync-all a bit
igfoo authored
335 }
336
337 # Work out the arguments we should give to the SCM
338 if ($command =~ /^(?:w|wh|wha|what|whats|whatsn|whatsne|whatsnew|status)$/) {
339 @scm_args = (($scm eq "darcs" and "whatsnew")
340 or ($scm eq "git" and "status"));
341
342 # Hack around 'darcs whatsnew' failing if there are no changes
343 $ignore_failure = 1;
344 }
345 elsif ($command =~ /^commit$/) {
346 @scm_args = ("commit");
347 # git fails if there is nothing to commit, so ignore failures
348 $ignore_failure = 1;
349 }
350 elsif ($command =~ /^(?:pus|push)$/) {
351 @scm_args = "push";
352 }
353 elsif ($command =~ /^(?:pul|pull)$/) {
354 @scm_args = "pull";
355 }
356 elsif ($command =~ /^(?:s|se|sen|send)$/) {
357 @scm_args = (($scm eq "darcs" and "send")
358 or ($scm eq "git" and "send-email"));
359 }
360 elsif ($command =~ /^fetch$/) {
361 @scm_args = ("fetch", "$branch_name");
362 }
363 elsif ($command =~ /^new$/) {
364 @scm_args = ("log", "$branch_name..");
365 }
366 elsif ($command =~ /^remote$/) {
367 if ($subcommand eq 'add') {
368 @scm_args = ("remote", "add", $branch_name, $path);
369 } elsif ($subcommand eq 'rm') {
370 @scm_args = ("remote", "rm", $branch_name);
371 } elsif ($subcommand eq 'set-url') {
372 @scm_args = ("remote", "set-url", $branch_name, $path);
373 }
374 }
375 elsif ($command =~ /^grep$/) {
376 @scm_args = ("grep");
377 # Hack around 'git grep' failing if there are no matches
378 $ignore_failure = 1;
379 }
380 elsif ($command =~ /^reset$/) {
381 @scm_args = "reset";
382 }
383 elsif ($command =~ /^config$/) {
384 @scm_args = "config";
385 }
386 else {
387 die "Unknown command: $command";
388 }
389
390 # Actually execute the command
391 scm ($localpath, $scm, @scm_args, @args);
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
392 }
393 }
394
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
395
396 sub help()
397 {
398 # Get the built in help
399 my $help = <<END;
400 What do you want to do?
401 Supported commands:
402
403 * whatsnew
2d8b317 @igfoo Add "commit" to the list of commands sync-all supports
igfoo authored
404 * commit
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
405 * push
406 * pull
407 * get, with options:
408 * --<package-tag>
409 * --complete
410 * --partial
411 * fetch
412 * send
413 * new
414 * remote add <branch-name>
415 * remote rm <branch-name>
b61c52d @simonmar remove set-origin and set-push commands; add "remote set-url [--push]" (...
simonmar authored
416 * remote set-url [--push] <branch-name>
78946b2 @tibbe Add 'sync-all grep'
tibbe authored
417 * grep
95ba531 @igfoo Add "./sync-all reset" command
igfoo authored
418 * reset
b100191 @igfoo Add "./sync-all config" command
igfoo authored
419 * config
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
420
421 Available package-tags are:
422 END
423
424 # Collect all the tags in the packages file
425 my %available_tags;
426 open IN, "< packages" or die "Can't open packages file";
427 while (<IN>) {
428 chomp;
429 if (/^([^# ]+) +(?:([^ ]+) +)?([^ ]+) +([^ ]+)/) {
430 if (defined($2) && $2 ne "-") {
431 $available_tags{$2} = 1;
432 }
433 }
434 elsif (! /^(#.*)?$/) {
435 die "Bad line: $_";
436 }
437 }
438 close IN;
439
440 # Show those tags and the help text
441 my @available_tags = keys %available_tags;
442 print "$help@available_tags\n";
443 exit 1;
444 }
445
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
446 sub main {
447 if (! -d ".git" || ! -d "compiler") {
448 die "error: sync-all must be run from the top level of the ghc tree."
449 }
450
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
451 $tags{"-"} = 1;
452 $tags{"dph"} = 1;
453
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
454 while ($#_ ne -1) {
455 my $arg = shift;
456 # We handle -q here as well as lower down as we need to skip over it
457 # if it comes before the source-control command
458 if ($arg eq "-q") {
459 $verbose = 1;
460 }
461 elsif ($arg eq "-s") {
462 $verbose = 0;
463 }
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
464 elsif ($arg eq "-r") {
465 $defaultrepo = shift;
466 }
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
467 elsif ($arg eq "--ignore-failure") {
468 $ignore_failure = 1;
469 }
c5a514d @igfoo Fix sync-all: Check for --complete/partial before --<anything>
igfoo authored
470 elsif ($arg eq "--complete" || $arg eq "--partial") {
471 $get_mode = $arg;
472 }
ed9482b @simonmar add the -r flag from darcs-all
simonmar authored
473 # Use --checked-out if the remote repos are a checked-out tree,
474 # rather than the master trees.
475 elsif ($arg eq "--checked-out") {
476 $checked_out_flag = 1;
477 }
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
478 # --<tag> says we grab the libs tagged 'tag' with
479 # 'get'. It has no effect on the other commands.
f298598 @simonmar add --no-<tag>, so e.g. we can omit DPH with --no-dph
simonmar authored
480 elsif ($arg =~ m/^--no-(.*)$/) {
481 $tags{$1} = 0;
482 }
483 elsif ($arg =~ m/^--(.*)$/) {
484 $tags{$1} = 1;
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
485 }
486 else {
487 unshift @_, $arg;
488 if (grep /^-q$/, @_) {
489 $verbose = 1;
490 }
491 last;
492 }
493 }
494
495 if ($#_ eq -1) {
db48557 @simonmar Add "remote add" and "remote rm" commands
simonmar authored
496 help();
99daef8 @batterseapower Prepare GHC for building with Git
batterseapower authored
497 }
498 else {
499 # Give the command and rest of the arguments to the main loop
500 scmall @_;
501 }
502 }
503
504 main(@ARGV);
505
Something went wrong with that request. Please try again.