1#!/usr/bin/perl -w 2# 3# This tool is copyright (c) 2005, Martin Langhoff. 4# It is released under the Gnu Public License, version 2. 5# 6# The basic idea is to walk the output of tla abrowse, 7# fetch the changesets and apply them. 8# 9 10=head1 Invocation 11 12 git-archimport [ -h ] [ -v ] [ -T ] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ] 13 14Imports a project from one or more Arch repositories. It will follow branches 15and repositories within the namespaces defined by the <archive/branch> 16parameters suppplied. If it cannot find the remote branch a merge comes from 17it will just import it as a regular commit. If it can find it, it will mark it 18as a merge whenever possible. 19 20See man (1) git-archimport for more details. 21 22=head1 TODO 23 24 - create tag objects instead of ref tags 25 - audit shell-escaping of filenames 26 - hide our private tags somewhere smarter 27 - find a way to make "cat *patches | patch" safe even when patchfiles are missing newlines 28 29=head1 Devel tricks 30 31Add print in front of the shell commands invoked via backticks. 32 33=head1 Devel Notes 34 35There are several places where Arch and git terminology are intermixed 36and potentially confused. 37 38The notion of a "branch" in git is approximately equivalent to 39a "archive/category--branch--version" in Arch. Also, it should be noted 40that the "--branch" portion of "archive/category--branch--version" is really 41optional in Arch although not many people (nor tools!) seem to know this. 42This means that "archive/category--version" is also a valid "branch" 43in git terms. 44 45We always refer to Arch names by their fully qualified variant (which 46means the "archive" name is prefixed. 47 48For people unfamiliar with Arch, an "archive" is the term for "repository", 49and can contain multiple, unrelated branches. 50 51=cut 52 53use strict; 54use warnings; 55use Getopt::Std; 56use File::Temp qw(tempdir); 57use File::Path qw(mkpath rmtree); 58use File::Basename qw(basename dirname); 59use Data::Dumper qw/ Dumper /; 60use IPC::Open2; 61 62$SIG{'PIPE'}="IGNORE"; 63$ENV{'TZ'}="UTC"; 64 65my$git_dir=$ENV{"GIT_DIR"} ||".git"; 66$ENV{"GIT_DIR"} =$git_dir; 67my$ptag_dir="$git_dir/archimport/tags"; 68 69our($opt_h,$opt_v,$opt_T,$opt_t,$opt_D,$opt_a,$opt_o); 70 71sub usage() { 72print STDERR <<END; 73Usage: ${\basename$0} # fetch/update GIT from Arch 74 [ -o ] [ -h ] [ -v ] [ -T ] [ -a ] [ -D depth ] [ -t tempdir ] 75 repository/arch-branch [ repository/arch-branch] ... 76END 77exit(1); 78} 79 80getopts("Thvat:D:")or usage(); 81usage if$opt_h; 82 83@ARGV>=1or usage(); 84# $arch_branches: 85# values associated with keys: 86# =1 - Arch version / git 'branch' detected via abrowse on a limit 87# >1 - Arch version / git 'branch' of an auxilliary branch we've merged 88my%arch_branches=map{$_=>1}@ARGV; 89 90$ENV{'TMPDIR'} =$opt_tif$opt_t;# $ENV{TMPDIR} will affect tempdir() calls: 91my$tmp= tempdir('git-archimport-XXXXXX', TMPDIR =>1, CLEANUP =>1); 92$opt_v&&print"+ Using$tmpas temporary directory\n"; 93 94my%reachable= ();# Arch repositories we can access 95my%unreachable= ();# Arch repositories we can't access :< 96my@psets= ();# the collection 97my%psets= ();# the collection, by name 98 99my%rptags= ();# my reverse private tags 100# to map a SHA1 to a commitid 101my$TLA=$ENV{'ARCH_CLIENT'} ||'tla'; 102 103sub do_abrowse { 104my$stage=shift; 105while(my($limit,$level) =each%arch_branches) { 106next unless$level==$stage; 107 108open ABROWSE,"$TLAabrowse -fkD --merges$limit|" 109or die"Problems with tla abrowse:$!"; 110 111my%ps= ();# the current one 112my$lastseen=''; 113 114while(<ABROWSE>) { 115chomp; 116 117# first record padded w 8 spaces 118if(s/^\s{8}\b//) { 119my($id,$type) =split(m/\s+/,$_,2); 120 121my%last_ps; 122# store the record we just captured 123if(%ps&& !exists$psets{$ps{id} }) { 124%last_ps=%ps;# break references 125push(@psets, \%last_ps); 126$psets{$last_ps{id} } = \%last_ps; 127} 128 129my$branch= extract_versionname($id); 130%ps= ( id =>$id, branch =>$branch); 131if(%last_ps&& ($last_ps{branch}eq$branch)) { 132$ps{parent_id} =$last_ps{id}; 133} 134 135$arch_branches{$branch} =1; 136$lastseen='id'; 137 138# deal with types (should work with baz or tla): 139if($type=~m/\(.*changeset\)/) { 140$ps{type} ='s'; 141}elsif($type=~/\(.*import\)/) { 142$ps{type} ='i'; 143}elsif($type=~m/\(tag.*?(\S+\@\S+).*?\)/) { 144$ps{type} ='t'; 145# read which revision we've tagged when we parse the log 146$ps{tag} =$1; 147}else{ 148warn"Unknown type$type"; 149} 150 151$arch_branches{$branch} =1; 152$lastseen='id'; 153}elsif(s/^\s{10}//) { 154# 10 leading spaces or more 155# indicate commit metadata 156 157# date 158if($lastseeneq'id'&&m/^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d)/){ 159$ps{date} =$1; 160$lastseen='date'; 161}elsif($_eq'merges in:') { 162$ps{merges} = []; 163$lastseen='merges'; 164}elsif($lastseeneq'merges'&&s/^\s{2}//) { 165my$id=$_; 166push(@{$ps{merges}},$id); 167 168# aggressive branch finding: 169if($opt_D) { 170my$branch= extract_versionname($id); 171my$repo= extract_reponame($branch); 172 173if(archive_reachable($repo) && 174!defined$arch_branches{$branch}) { 175$arch_branches{$branch} =$stage+1; 176} 177} 178}else{ 179warn"more metadata after merges!?:$_\n"unless/^\s*$/; 180} 181} 182} 183 184if(%ps&& !exists$psets{$ps{id} }) { 185my%temp=%ps;# break references 186if(@psets&&$psets[$#psets]{branch}eq$ps{branch}) { 187$temp{parent_id} =$psets[$#psets]{id}; 188} 189push(@psets, \%temp); 190$psets{$temp{id} } = \%temp; 191} 192 193close ABROWSE or die"$TLAabrowse failed on$limit\n"; 194} 195}# end foreach $root 196 197do_abrowse(1); 198my$depth=2; 199$opt_D||=0; 200while($depth<=$opt_D) { 201 do_abrowse($depth); 202$depth++; 203} 204 205## Order patches by time 206# FIXME see if we can find a more optimal way to do this by graphing 207# the ancestry data and walking it, that way we won't have to rely on 208# client-supplied dates 209@psets=sort{$a->{date}.$b->{id}cmp$b->{date}.$b->{id}}@psets; 210 211#print Dumper \@psets; 212 213## 214## TODO cleanup irrelevant patches 215## and put an initial import 216## or a full tag 217my$import=0; 218unless(-d $git_dir) {# initial import 219if($psets[0]{type}eq'i'||$psets[0]{type}eq't') { 220print"Starting import from$psets[0]{id}\n"; 221`git-init-db`; 222die$!if$?; 223$import=1; 224}else{ 225die"Need to start from an import or a tag -- cannot use$psets[0]{id}"; 226} 227}else{# progressing an import 228# load the rptags 229opendir(DIR,$ptag_dir) 230||die"can't opendir:$!"; 231while(my$file=readdir(DIR)) { 232# skip non-interesting-files 233next unless-f "$ptag_dir/$file"; 234 235# convert first '--' to '/' from old git-archimport to use 236# as an archivename/c--b--v private tag 237if($file!~m!,!) { 238my$oldfile=$file; 239$file=~s!--!,!; 240print STDERR "converting old tag$oldfileto$file\n"; 241rename("$ptag_dir/$oldfile","$ptag_dir/$file")or die$!; 242} 243my$sha= ptag($file); 244chomp$sha; 245$rptags{$sha} =$file; 246} 247closedir DIR; 248} 249 250# process patchsets 251# extract the Arch repository name (Arch "archive" in Arch-speak) 252sub extract_reponame { 253my$fq_cvbr=shift;# archivename/[[[[category]branch]version]revision] 254return(split(/\//,$fq_cvbr))[0]; 255} 256 257sub extract_versionname { 258my$name=shift; 259$name=~s/--(?:patch|version(?:fix)?|base)-\d+$//; 260return$name; 261} 262 263# convert a fully-qualified revision or version to a unique dirname: 264# normalperson@yhbt.net-05/mpd--uclinux--1--patch-2 265# becomes: normalperson@yhbt.net-05,mpd--uclinux--1 266# 267# the git notion of a branch is closer to 268# archive/category--branch--version than archive/category--branch, so we 269# use this to convert to git branch names. 270# Also, keep archive names but replace '/' with ',' since it won't require 271# subdirectories, and is safer than swapping '--' which could confuse 272# reverse-mapping when dealing with bastard branches that 273# are just archive/category--version (no --branch) 274sub tree_dirname { 275my$revision=shift; 276my$name= extract_versionname($revision); 277$name=~ s#/#,#; 278return$name; 279} 280 281# old versions of git-archimport just use the <category--branch> part: 282sub old_style_branchname { 283my$id=shift; 284my$ret= safe_pipe_capture($TLA,'parse-package-name','-p',$id); 285chomp$ret; 286return$ret; 287} 288 289*git_branchname =$opt_o? *old_style_branchname : *tree_dirname; 290 291# process patchsets 292foreachmy$ps(@psets) { 293$ps->{branch} = git_branchname($ps->{id}); 294 295# 296# ensure we have a clean state 297# 298if(`git-diff-files`) { 299die"Unclean tree when about to process$ps->{id} ". 300" - did we fail to commit cleanly before?"; 301} 302die$!if$?; 303 304# 305# skip commits already in repo 306# 307if(ptag($ps->{id})) { 308$opt_v&&print" * Skipping already imported:$ps->{id}\n"; 309next; 310} 311 312print" * Starting to work on$ps->{id}\n"; 313 314# 315# create the branch if needed 316# 317if($ps->{type}eq'i'&& !$import) { 318die"Should not have more than one 'Initial import' per GIT import:$ps->{id}"; 319} 320 321unless($import) {# skip for import 322if( -e "$git_dir/refs/heads/$ps->{branch}") { 323# we know about this branch 324system('git-checkout',$ps->{branch}); 325}else{ 326# new branch! we need to verify a few things 327die"Branch on a non-tag!"unless$ps->{type}eq't'; 328my$branchpoint= ptag($ps->{tag}); 329die"Tagging from unknown id unsupported:$ps->{tag}" 330unless$branchpoint; 331 332# find where we are supposed to branch from 333system('git-checkout','-b',$ps->{branch},$branchpoint); 334 335# If we trust Arch with the fact that this is just 336# a tag, and it does not affect the state of the tree 337# then we just tag and move on 338 tag($ps->{id},$branchpoint); 339 ptag($ps->{id},$branchpoint); 340print" * Tagged$ps->{id} at$branchpoint\n"; 341next; 342} 343die$!if$?; 344} 345 346# 347# Apply the import/changeset/merge into the working tree 348# 349if($ps->{type}eq'i'||$ps->{type}eq't') { 350 apply_import($ps)or die$!; 351$import=0; 352}elsif($ps->{type}eq's') { 353 apply_cset($ps); 354} 355 356# 357# prepare update git's index, based on what arch knows 358# about the pset, resolve parents, etc 359# 360my$tree; 361 362my@commitlog= safe_pipe_capture($TLA,'cat-archive-log',$ps->{id}); 363die"Error in cat-archive-log:$!"if$?; 364 365 parselog($ps,\@commitlog); 366 367# imports don't give us good info 368# on added files. Shame on them 369if($ps->{type}eq'i'||$ps->{type}eq't') { 370system('git-ls-files --others -z | '. 371'git-update-index --add -z --stdin') ==0or die"$!$?\n"; 372system('git-ls-files --deleted -z | '. 373'git-update-index --remove -z --stdin') ==0or die"$!$?\n"; 374} 375 376# TODO: handle removed_directories and renamed_directories: 377 378if(my$add=$ps->{new_files}) { 379while(@$add) { 380my@slice=splice(@$add,0,100); 381system('git-update-index','--add','--',@slice) ==0or 382die"Error in git-update-index --add:$!$?\n"; 383} 384} 385 386if(my$del=$ps->{removed_files}) { 387unlink@$del; 388while(@$del) { 389my@slice=splice(@$del,0,100); 390system('git-update-index','--remove','--',@slice) ==0or 391die"Error in git-update-index --remove:$!$?\n"; 392} 393} 394 395if(my$ren=$ps->{renamed_files}) {# renamed 396if(@$ren%2) { 397die"Odd number of entries in rename!?"; 398} 399 400while(@$ren) { 401my$from=shift@$ren; 402my$to=shift@$ren; 403 404unless(-d dirname($to)) { 405 mkpath(dirname($to));# will die on err 406} 407print"moving$from$to"; 408rename($from,$to)or die"Error renaming '$from' '$to':$!\n"; 409system('git-update-index','--remove','--',$from) ==0or 410die"Error in git-update-index --remove:$!$?\n"; 411system('git-update-index','--add','--',$to) ==0or 412die"Error in git-update-index --add:$!$?\n"; 413} 414 415} 416 417if(my$mod=$ps->{modified_files}) { 418while(@$mod) { 419my@slice=splice(@$mod,0,100); 420system('git-update-index','--',@slice) ==0or 421die"Error in git-update-index:$!$?\n"; 422} 423} 424 425# warn "errors when running git-update-index! $!"; 426$tree=`git-write-tree`; 427die"cannot write tree$!"if$?; 428chomp$tree; 429 430# 431# Who's your daddy? 432# 433my@par; 434if( -e "$git_dir/refs/heads/$ps->{branch}") { 435if(open HEAD,"<","$git_dir/refs/heads/$ps->{branch}") { 436my$p= <HEAD>; 437close HEAD; 438chomp$p; 439push@par,'-p',$p; 440}else{ 441if($ps->{type}eq's') { 442warn"Could not find the right head for the branch$ps->{branch}"; 443} 444} 445} 446 447if($ps->{merges}) { 448push@par, find_parents($ps); 449} 450 451# 452# Commit, tag and clean state 453# 454$ENV{TZ} ='GMT'; 455$ENV{GIT_AUTHOR_NAME} =$ps->{author}; 456$ENV{GIT_AUTHOR_EMAIL} =$ps->{email}; 457$ENV{GIT_AUTHOR_DATE} =$ps->{date}; 458$ENV{GIT_COMMITTER_NAME} =$ps->{author}; 459$ENV{GIT_COMMITTER_EMAIL} =$ps->{email}; 460$ENV{GIT_COMMITTER_DATE} =$ps->{date}; 461 462my$pid= open2(*READER, *WRITER,'git-commit-tree',$tree,@par) 463or die$!; 464print WRITER $ps->{summary},"\n"; 465print WRITER $ps->{message},"\n"; 466 467# make it easy to backtrack and figure out which Arch revision this was: 468print WRITER 'git-archimport-id: ',$ps->{id},"\n"; 469 470close WRITER; 471my$commitid= <READER>;# read 472chomp$commitid; 473close READER; 474waitpid$pid,0;# close; 475 476if(length$commitid!=40) { 477die"Something went wrong with the commit!$!$commitid"; 478} 479# 480# Update the branch 481# 482open HEAD,">","$git_dir/refs/heads/$ps->{branch}"; 483print HEAD $commitid; 484close HEAD; 485system('git-update-ref','HEAD',"$ps->{branch}"); 486 487# tag accordingly 488 ptag($ps->{id},$commitid);# private tag 489if($opt_T||$ps->{type}eq't'||$ps->{type}eq'i') { 490 tag($ps->{id},$commitid); 491} 492print" * Committed$ps->{id}\n"; 493print" + tree$tree\n"; 494print" + commit$commitid\n"; 495$opt_v&&print" + commit date is$ps->{date}\n"; 496$opt_v&&print" + parents: ",join(' ',@par),"\n"; 497} 498 499sub apply_import { 500my$ps=shift; 501my$bname= git_branchname($ps->{id}); 502 503 mkpath($tmp); 504 505 safe_pipe_capture($TLA,'get','-s','--no-pristine',$ps->{id},"$tmp/import"); 506die"Cannot get import:$!"if$?; 507system('rsync','-aI','--delete','--exclude',$git_dir, 508'--exclude','.arch-ids','--exclude','{arch}', 509"$tmp/import/",'./'); 510die"Cannot rsync import:$!"if$?; 511 512 rmtree("$tmp/import"); 513die"Cannot remove tempdir:$!"if$?; 514 515 516return1; 517} 518 519sub apply_cset { 520my$ps=shift; 521 522 mkpath($tmp); 523 524# get the changeset 525 safe_pipe_capture($TLA,'get-changeset',$ps->{id},"$tmp/changeset"); 526die"Cannot get changeset:$!"if$?; 527 528# apply patches 529if(`find$tmp/changeset/patches-type f -name '*.patch'`) { 530# this can be sped up considerably by doing 531# (find | xargs cat) | patch 532# but that cna get mucked up by patches 533# with missing trailing newlines or the standard 534# 'missing newline' flag in the patch - possibly 535# produced with an old/buggy diff. 536# slow and safe, we invoke patch once per patchfile 537`find$tmp/changeset/patches-type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`; 538die"Problem applying patches!$!"if$?; 539} 540 541# apply changed binary files 542if(my@modified=`find$tmp/changeset/patches-type f -name '*.modified'`) { 543foreachmy$mod(@modified) { 544chomp$mod; 545my$orig=$mod; 546$orig=~s/\.modified$//;# lazy 547$orig=~s!^\Q$tmp\E/changeset/patches/!!; 548#print "rsync -p '$mod' '$orig'"; 549system('rsync','-p',$mod,"./$orig"); 550die"Problem applying binary changes!$!"if$?; 551} 552} 553 554# bring in new files 555system('rsync','-aI','--exclude',$git_dir, 556'--exclude','.arch-ids', 557'--exclude','{arch}', 558"$tmp/changeset/new-files-archive/",'./'); 559 560# deleted files are hinted from the commitlog processing 561 562 rmtree("$tmp/changeset"); 563} 564 565 566# =for reference 567# notes: *-files/-directories keys cannot have spaces, they're always 568# pika-escaped. Everything after the first newline 569# A log entry looks like: 570# Revision: moodle-org--moodle--1.3.3--patch-15 571# Archive: arch-eduforge@catalyst.net.nz--2004 572# Creator: Penny Leach <penny@catalyst.net.nz> 573# Date: Wed May 25 14:15:34 NZST 2005 574# Standard-date: 2005-05-25 02:15:34 GMT 575# New-files: lang/de/.arch-ids/block_glossary_random.php.id 576# lang/de/.arch-ids/block_html.php.id 577# New-directories: lang/de/help/questionnaire 578# lang/de/help/questionnaire/.arch-ids 579# Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id 580# db_sears.sql db/db_sears.sql 581# Removed-files: lang/be/docs/.arch-ids/release.html.id 582# lang/be/docs/.arch-ids/releaseold.html.id 583# Modified-files: admin/cron.php admin/delete.php 584# admin/editor.html backup/lib.php backup/restore.php 585# New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15 586# Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+) 587# summary can be multiline with a leading space just like the above fields 588# Keywords: 589# 590# Updating yadda tadda tadda madda 591sub parselog { 592my($ps,$log) =@_; 593my$key=undef; 594 595# headers we want that contain filenames: 596my%want_headers= ( 597 new_files =>1, 598 modified_files =>1, 599 renamed_files =>1, 600 renamed_directories =>1, 601 removed_files =>1, 602 removed_directories =>1, 603); 604 605chomp(@$log); 606while($_=shift@$log) { 607if(/^Continuation-of:\s*(.*)/) { 608$ps->{tag} =$1; 609$key=undef; 610}elsif(/^Summary:\s*(.*)$/) { 611# summary can be multiline as long as it has a leading space 612$ps->{summary} = [$1]; 613$key='summary'; 614}elsif(/^Creator: (.*)\s*<([^\>]+)>/) { 615$ps->{author} =$1; 616$ps->{email} =$2; 617$key=undef; 618# any *-files or *-directories can be read here: 619}elsif(/^([A-Z][a-z\-]+):\s*(.*)$/) { 620my$val=$2; 621$key=lc$1; 622$key=~tr/-/_/;# too lazy to quote :P 623if($want_headers{$key}) { 624push@{$ps->{$key}},split(/\s+/,$val); 625}else{ 626$key=undef; 627} 628}elsif(/^$/) { 629last;# remainder of @$log that didn't get shifted off is message 630}elsif($key) { 631if(/^\s+(.*)$/) { 632if($keyeq'summary') { 633push@{$ps->{$key}},$1; 634}else{# files/directories: 635push@{$ps->{$key}},split(/\s+/,$1); 636} 637}else{ 638$key=undef; 639} 640} 641} 642 643# post-processing: 644$ps->{summary} =join("\n",@{$ps->{summary}})."\n"; 645$ps->{message} =join("\n",@$log); 646 647# skip Arch control files, unescape pika-escaped files 648foreachmy$k(keys%want_headers) { 649next unless(defined$ps->{$k}); 650my@tmp; 651foreachmy$t(@{$ps->{$k}}) { 652next unlesslength($t); 653next if$t=~m!\{arch\}/!; 654next if$t=~m!\.arch-ids/!; 655# should we skip this? 656next if$t=~m!\.arch-inventory$!; 657# tla cat-archive-log will give us filenames with spaces as file\(sp)name - why? 658# we can assume that any filename with \ indicates some pika escaping that we want to get rid of. 659if($t=~/\\/){ 660$t= (safe_pipe_capture($TLA,'escape','--unescaped',$t))[0]; 661} 662push@tmp,$t; 663} 664$ps->{$k} = \@tmpifscalar@tmp; 665} 666} 667 668# write/read a tag 669sub tag { 670my($tag,$commit) =@_; 671 672if($opt_o) { 673$tag=~ s|/|--|g; 674}else{ 675# don't use subdirs for tags yet, it could screw up other porcelains 676$tag=~ s|/|,|g; 677} 678 679if($commit) { 680open(C,">","$git_dir/refs/tags/$tag") 681or die"Cannot create tag$tag:$!\n"; 682print C "$commit\n" 683or die"Cannot write tag$tag:$!\n"; 684close(C) 685or die"Cannot write tag$tag:$!\n"; 686print" * Created tag '$tag' on '$commit'\n"if$opt_v; 687}else{# read 688open(C,"<","$git_dir/refs/tags/$tag") 689or die"Cannot read tag$tag:$!\n"; 690$commit= <C>; 691chomp$commit; 692die"Error reading tag$tag:$!\n"unlesslength$commit==40; 693close(C) 694or die"Cannot read tag$tag:$!\n"; 695return$commit; 696} 697} 698 699# write/read a private tag 700# reads fail softly if the tag isn't there 701sub ptag { 702my($tag,$commit) =@_; 703 704# don't use subdirs for tags yet, it could screw up other porcelains 705$tag=~ s|/|,|g; 706 707my$tag_file="$ptag_dir/$tag"; 708my$tag_branch_dir= dirname($tag_file); 709 mkpath($tag_branch_dir)unless(-d $tag_branch_dir); 710 711if($commit) {# write 712open(C,">",$tag_file) 713or die"Cannot create tag$tag:$!\n"; 714print C "$commit\n" 715or die"Cannot write tag$tag:$!\n"; 716close(C) 717or die"Cannot write tag$tag:$!\n"; 718$rptags{$commit} =$tag 719unless$tag=~m/--base-0$/; 720}else{# read 721# if the tag isn't there, return 0 722unless( -s $tag_file) { 723return0; 724} 725open(C,"<",$tag_file) 726or die"Cannot read tag$tag:$!\n"; 727$commit= <C>; 728chomp$commit; 729die"Error reading tag$tag:$!\n"unlesslength$commit==40; 730close(C) 731or die"Cannot read tag$tag:$!\n"; 732unless(defined$rptags{$commit}) { 733$rptags{$commit} =$tag; 734} 735return$commit; 736} 737} 738 739sub find_parents { 740# 741# Identify what branches are merging into me 742# and whether we are fully merged 743# git-merge-base <headsha> <headsha> should tell 744# me what the base of the merge should be 745# 746my$ps=shift; 747 748my%branches;# holds an arrayref per branch 749# the arrayref contains a list of 750# merged patches between the base 751# of the merge and the current head 752 753my@parents;# parents found for this commit 754 755# simple loop to split the merges 756# per branch 757foreachmy$merge(@{$ps->{merges}}) { 758my$branch= git_branchname($merge); 759unless(defined$branches{$branch} ){ 760$branches{$branch} = []; 761} 762push@{$branches{$branch}},$merge; 763} 764 765# 766# foreach branch find a merge base and walk it to the 767# head where we are, collecting the merged patchsets that 768# Arch has recorded. Keep that in @have 769# Compare that with the commits on the other branch 770# between merge-base and the tip of the branch (@need) 771# and see if we have a series of consecutive patches 772# starting from the merge base. The tip of the series 773# of consecutive patches merged is our new parent for 774# that branch. 775# 776foreachmy$branch(keys%branches) { 777 778# check that we actually know about the branch 779next unless-e "$git_dir/refs/heads/$branch"; 780 781my$mergebase=`git-merge-base$branch$ps->{branch}`; 782if($?) { 783# Don't die here, Arch supports one-way cherry-picking 784# between branches with no common base (or any relationship 785# at all beforehand) 786warn"Cannot find merge base for$branchand$ps->{branch}"; 787next; 788} 789chomp$mergebase; 790 791# now walk up to the mergepoint collecting what patches we have 792my$branchtip= git_rev_parse($ps->{branch}); 793my@ancestors=`git-rev-list --merge-order$branchtip^$mergebase`; 794 my%have; # collected merges this branch has 795 foreach my$merge(@{$ps->{merges}}) { 796$have{$merge} = 1; 797 } 798 my%ancestorshave; 799 foreach my$par(@ancestors) { 800$par= commitid2pset($par); 801 if (defined$par->{merges}) { 802 foreach my$merge(@{$par->{merges}}) { 803$ancestorshave{$merge}=1; 804 } 805 } 806 } 807 # print "++++ Merges in$ps->{id} are....\n"; 808 # my@have= sort keys%have; print Dumper(\@have); 809 810 # merge what we have with what ancestors have 811%have= (%have,%ancestorshave); 812 813 # see what the remote branch has - these are the merges we 814 # will want to have in a consecutive series from the mergebase 815 my$otherbranchtip= git_rev_parse($branch); 816 my@needraw= `git-rev-list --merge-order $otherbranchtip^$mergebase`; 817my@need; 818foreachmy$needps(@needraw) {# get the psets 819$needps= commitid2pset($needps); 820# git-rev-list will also 821# list commits merged in via earlier 822# merges. we are only interested in commits 823# from the branch we're looking at 824if($brancheq$needps->{branch}) { 825push@need,$needps->{id}; 826} 827} 828 829# print "++++ Merges from $branch we want are....\n"; 830# print Dumper(\@need); 831 832my$newparent; 833while(my$needed_commit=pop@need) { 834if($have{$needed_commit}) { 835$newparent=$needed_commit; 836}else{ 837last;# break out of the while 838} 839} 840if($newparent) { 841push@parents,$newparent; 842} 843 844 845}# end foreach branch 846 847# prune redundant parents 848my%parents; 849foreachmy$p(@parents) { 850$parents{$p} =1; 851} 852foreachmy$p(@parents) { 853next unlessexists$psets{$p}{merges}; 854next unlessref$psets{$p}{merges}; 855my@merges= @{$psets{$p}{merges}}; 856foreachmy$merge(@merges) { 857if($parents{$merge}) { 858delete$parents{$merge}; 859} 860} 861} 862 863@parents= (); 864foreach(keys%parents) { 865push@parents,'-p', ptag($_); 866} 867return@parents; 868} 869 870sub git_rev_parse { 871my$name=shift; 872my$val=`git-rev-parse$name`; 873 die "Error: git-rev-parse$name" if$?; 874 chomp$val; 875 return$val; 876} 877 878# resolve a SHA1 to a known patchset 879sub commitid2pset { 880 my$commitid= shift; 881 chomp$commitid; 882 my$name=$rptags{$commitid} 883 || die "Cannot find reverse tag mapping for$commitid"; 884$name=~ s|,|/|; 885 my$ps=$psets{$name} 886 || (print Dumper(sort keys%psets)) && die "Cannot find patchset for$name"; 887 return$ps; 888} 889 890 891# an alterative to `command` that allows input to be passed as an array 892# to work around shell problems with weird characters in arguments 893sub safe_pipe_capture { 894 my@output; 895 if (my$pid= open my$child, '-|') { 896@output= (<$child>); 897 close$childor die join(' ',@_).":$!$?"; 898 } else { 899 exec(@_) or die$?; # exec() can fail the executable can't be found 900 } 901 return wantarray ?@output: join('',@output); 902} 903 904# `tla logs -rf -d <dir> | head -n1` or `baz tree-id <dir>` 905sub arch_tree_id { 906 my$dir= shift; 907 chomp( my$ret= (safe_pipe_capture($TLA,'logs','-rf','-d',$dir))[0] ); 908 return$ret; 909} 910 911sub archive_reachable { 912 my$archive= shift; 913 return 1 if$reachable{$archive}; 914 return 0 if$unreachable{$archive}; 915 916 if (system "$TLAwhereis-archive$archive>/dev/null") { 917 if ($opt_a&& (system($TLA,'register-archive', 918 "http://mirrors.sourcecontrol.net/$archive") == 0)) { 919$reachable{$archive} = 1; 920 return 1; 921 } 922 print STDERR "Archive is unreachable:$archive\n"; 923$unreachable{$archive} = 1; 924 return 0; 925 } else { 926$reachable{$archive} = 1; 927 return 1; 928 } 929} 930