diff options
Diffstat (limited to 'sync-all')
| -rwxr-xr-x | sync-all | 314 |
1 files changed, 210 insertions, 104 deletions
@@ -2,6 +2,7 @@ use strict; use Cwd; +use English; $| = 1; # autoflush stdout after each print, to avoid output after die @@ -18,76 +19,20 @@ my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo my %tags; -# Figure out where to get the other repositories from. -sub getrepo { - my $repo; +sub inDir { + my $dir = shift; + my $code = shift; - 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. - my $git_dir = $bare_flag ? "--git-dir=ghc.git" : ""; - my $branch = `git $git_dir branch | grep "\* " | sed "s/^\* //"`; chomp $branch; - 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; + if ($dir ne '.') { + chdir($dir); } - 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; - } + my $result = &$code(); - # 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 - # - # http://darcs.haskell.org/ghc - # - if (!$defaultrepo) { - $repo_base =~ s#/[^/]+/?$##; - } - } - elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) { - # Local filesystem, either absolute (C:/ or /) or relative (../) path - $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"; + if ($dir ne '.') { + chdir($initial_working_directory); } - - return $repo_base, $checked_out_tree; + return $result; } sub parsePackages { @@ -111,6 +56,8 @@ sub parsePackages { $line{"tag"} = $2; $line{"remotepath"} = $3; push @packages, \%line; + + $tags{$2} = 0; } elsif (! /^(#.*)?$/) { die "Bad content on line $lineNum of packages file: $_"; @@ -161,42 +108,121 @@ sub gitNewWorkdir { } } +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; + }); +} + sub configure_repository { my $localpath = shift; &git($localpath, "config", "--local", "core.ignorecase", "true"); - 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); + my $autocrlf = &readgit($localpath, 'config', '--get', 'core.autocrlf'); if ($autocrlf eq "true") { &git($localpath, "config", "--local", "core.autocrlf", "false"); &git($localpath, "reset", "--hard"); } } -sub git { - my $dir = shift; +# Figure out where to get the other repositories from. +sub getrepo { + my $repo; - if ($dir eq '.') { - message "== running git @_"; + if (defined($defaultrepo)) { + $repo = $defaultrepo; + chomp $repo; } else { - message "== $dir: running git @_"; - chdir($dir); + # 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" + unless $branch =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/; + 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" + unless $remote =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/; + $repo = &readgit($git_dir, "config", "remote.$remote.url"); } - system ("git", @_) == 0 - or $ignore_failure - or die "git failed: $?"; + my $repo_base; + my $checked_out_tree; - if ($dir ne '.') { - chdir($initial_working_directory); + 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://git.haskell.org + # + # rather than + # + # http://git.haskell.org/ghc + # + if (!$defaultrepo) { + $repo_base =~ s#/[^/]+/?$##; + } } + elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) { + # Local filesystem, either absolute (C:/ or /) or relative (../) path + $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"; + } + + return $repo_base, $checked_out_tree; } sub gitall { @@ -221,8 +247,6 @@ sub gitall { my $is_github_repo = $repo_base =~ m/(git@|git:\/\/|https:\/\/)github.com/; - parsePackages; - @args = (); if ($command =~ /^remote$/) { @@ -292,6 +316,10 @@ sub gitall { } } + # Some extra packages like 'async' may be external URLs, + # e.g. git://... or http://... + my $is_external_url = $remotepath =~ m/^(git:\/\/|https:\/\/|http:\/\/)/; + open RESUME, "> resume.tmp"; print RESUME "$localpath\n"; print RESUME "$doing\n"; @@ -300,12 +328,12 @@ sub gitall { # We can't create directories on GitHub, so we translate # "packages/foo" into "package-foo". - if ($is_github_repo) { + if ($is_github_repo && !defined($is_external_url)) { $remotepath =~ s/\//-/; } # Construct the path for this package in the repo we pulled from - $path = "$repo_base/$remotepath"; + $path = $is_external_url ? $remotepath : "$repo_base/$remotepath"; if ($command eq "get") { next if $remotepath eq "-"; # "git submodule init/update" will get this later @@ -375,13 +403,7 @@ sub gitall { } 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); + my $myhead = &readgit('.', 'rev-parse', '--verify', 'HEAD'); if (not defined($remote_heads{$myhead})) { die "Sub module $localpath needs to be pushed; see http://hackage.haskell.org/trac/ghc/wiki/Repositories/Upstream"; @@ -437,7 +459,16 @@ sub gitall { my $rpath; $ignore_failure = 1; if ($remotepath eq '-') { - $rpath = "$repo_base/$localpath"; + $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"; } else { $rpath = $path; } @@ -489,6 +520,42 @@ sub gitall { elsif ($command eq "tag") { &git($localpath, "tag", @args); } + 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" + unless $branch =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/; + 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"; + } + } else { die "Unknown command: $command"; } @@ -497,24 +564,40 @@ sub gitall { unlink "resume"; } +sub checkCurrentBranchIsMaster { + my $branch = `git symbolic-ref HEAD`; + $branch =~ s/refs\/heads\///; + $branch =~ s/\n//; + + if ($branch !~ /master/) { + print "\nWarning: You trying to 'pull' while on branch '$branch'.\n" + . "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"; + } +} + sub help { my $exit = shift; + my $tags = join ' ', sort (grep !/^-$/, keys %tags); + # Get the built in help my $help = <<END; Usage: ./sync-all [-q] [-s] [--ignore-failure] [-r repo] [--checked-out] [--bare] - [--nofib] [--extra] [--testsuite] [--no-dph] [--resume] + [--<tag>] [--no-<tag>] [--resume] cmd [git flags] + where <tag> is one of: $tags + 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 + \$ git clone http://git.haskell.org/ghc.git \$ cd ghc \$ ./sync-all get @@ -554,13 +637,24 @@ remote set-url [--push] <remote-name> repository location in each case appropriately. For example, to add a new remote pointing to the upstream repositories: - ./sync-all -r http://darcs.haskell.org/ remote add upstream + ./sync-all -r http://git.haskell.org remote add upstream The -r flag points to the root of the repository tree (see "which repos to use" below). For a repository on the local filesystem it would point to the ghc repository, and for a remote repository it points to the directory containing "ghc.git". +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. + These commands just run the equivalent git command on each repository, passing any extra arguments to git: @@ -621,7 +715,7 @@ Flags given *after* the command are passed to git. --extra also clone some extra library packages - --no-dph avoids cloning the dph pacakges + --no-dph avoids cloning the dph packages ------------ Checking out a branch ------------- @@ -651,7 +745,7 @@ 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 + both sync-all -r http://example.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". @@ -688,8 +782,13 @@ END sub main { + &parsePackages(); + $tags{"-"} = 1; $tags{"dph"} = 1; + if ($OSNAME =~ /^(MSWin32|Cygwin)$/) { + $tags{"windows"} = 1; + } while ($#_ ne -1) { my $arg = shift; @@ -728,12 +827,15 @@ sub main { } # --<tag> says we grab the libs tagged 'tag' with # 'get'. It has no effect on the other commands. - elsif ($arg =~ m/^--no-(.*)$/) { + elsif ($arg =~ m/^--no-(.*)$/ && defined($tags{$1})) { $tags{$1} = 0; } - elsif ($arg =~ m/^--(.*)$/) { + elsif ($arg =~ m/^--(.*)$/ && defined($tags{$1})) { $tags{$1} = 1; } + elsif ($arg =~ m/^-/) { + die "Unrecognised flag: $arg"; + } else { unshift @_, $arg; if (grep /^-q$/, @_) { @@ -750,7 +852,7 @@ sub main { 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" + . " ./sync-all --bare [--testsuite --nofib --extra] -r http://git.haskell.org get\n" } elsif ($bare_found) { $bare_flag = "--bare"; @@ -812,6 +914,10 @@ sub main { } BEGIN { + my %argvHash = map { $_, 1 } @ARGV; + if ($argvHash {"pull"}) { + checkCurrentBranchIsMaster(); + } $initial_working_directory = getcwd(); } |