1 #!/usr/bin/perl -w

     2 

     3 # Copyright (C) 2005, 2006, 2007 Apple Inc.  All rights reserved.

     4 #

     5 # Redistribution and use in source and binary forms, with or without

     6 # modification, are permitted provided that the following conditions

     7 # are met:

     8 #

     9 # 1.  Redistributions of source code must retain the above copyright

    10 #     notice, this list of conditions and the following disclaimer. 

    11 # 2.  Redistributions in binary form must reproduce the above copyright

    12 #     notice, this list of conditions and the following disclaimer in the

    13 #     documentation and/or other materials provided with the distribution. 

    14 # 3.  Neither the name of Apple Computer, Inc. ("Apple") nor the names of

    15 #     its contributors may be used to endorse or promote products derived

    16 #     from this software without specific prior written permission. 

    17 #

    18 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY

    19 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

    20 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

    21 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY

    22 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES

    23 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;

    24 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND

    25 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

    26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF

    27 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    28 

    29 # "unpatch" script for Web Kit Open Source Project, used to remove patches.

    30 

    31 # Differences from invoking "patch -p0 -R":

    32 #

    33 #   Handles added files (does a svn revert with additional logic to handle local changes). 

    34 #   Handles added directories (does a svn revert and a rmdir).

    35 #   Handles removed files (does a svn revert with additional logic to handle local changes). 

    36 #   Handles removed directories (does a svn revert). 

    37 #   Paths from Index: lines are used rather than the paths on the patch lines, which

    38 #       makes patches generated by "cvs diff" work (increasingly unimportant since we

    39 #       use Subversion now).

    40 #   ChangeLog patches use --fuzz=3 to prevent rejects, and the entry date is reset in

    41 #       the patch before it is applied (svn-apply sets it when applying a patch).

    42 #   Handles binary files (requires patches made by svn-create-patch).

    43 #   Handles copied and moved files (requires patches made by svn-create-patch).

    44 #   Handles git-diff patches (without binary changes) created at the top-level directory

    45 #

    46 # Missing features:

    47 #

    48 #   Handle property changes.

    49 #   Handle copied and moved directories (would require patches made by svn-create-patch).

    50 #   Use version numbers in the patch file and do a 3-way merge.

    51 #   When reversing an addition, check that the file matches what's being removed.

    52 #   Notice a patch that's being unapplied at the "wrong level" and make it work anyway.

    53 #   Do a dry run on the whole patch and don't do anything if part of the patch is

    54 #       going to fail (probably too strict unless we exclude ChangeLog).

    55 #   Handle git-diff patches with binary changes

    56 

    57 use strict;

    58 use warnings;

    59 

    60 use Cwd;

    61 use Digest::MD5;

    62 use Fcntl qw(:DEFAULT :seek);

    63 use File::Basename;

    64 use File::Spec;

    65 use File::Temp qw(tempfile);

    66 use Getopt::Long;

    67 

    68 sub checksum($);

    69 sub fixChangeLogPatch($);

    70 sub gitdiff2svndiff($);

    71 sub patch($);

    72 sub revertDirectories();

    73 sub svnStatus($);

    74 sub unapplyPatch($$;$);

    75 sub unsetChangeLogDate($$);

    76 

    77 my $showHelp = 0;

    78 if (!GetOptions("help!" => \$showHelp) || $showHelp) {

    79     print STDERR basename($0) . " [-h|--help] patch1 [patch2 ...]\n";

    80     exit 1;

    81 }

    82 

    83 my @copiedFiles;

    84 my %directoriesToCheck;

    85 

    86 my $copiedFromPath;

    87 my $filter;

    88 my $indexPath;

    89 my $patch;

    90 while (<>) {

    91     s/\r//g;

    92     chomp;

    93     if (!defined($indexPath) && m#^diff --git a/#) {

    94         $filter = \&gitdiff2svndiff;

    95     }

    96     $_ = &$filter($_) if $filter;

    97     if (/^Index: (.*)/) {

    98         $indexPath = $1;

    99         if ($patch) {

   100             if ($copiedFromPath) {

   101                 push @copiedFiles, $patch;

   102             } else {

   103                 patch($patch);

   104             }

   105             $copiedFromPath = "";

   106             $patch = "";

   107         }

   108     }

   109     if ($indexPath) {

   110         # Fix paths on diff, ---, and +++ lines to match preceding Index: line.

   111         s/^--- \S+/--- $indexPath/;

   112         if (/^--- .+\(from (\S+):\d+\)$/) {

   113             $copiedFromPath = $1;

   114         }

   115         if (s/^\+\+\+ \S+/+++ $indexPath/) {

   116             $indexPath = "";

   117         }

   118     }

   119     $patch .= $_;

   120     $patch .= "\n";

   121 }

   122 

   123 if ($patch) {

   124     if ($copiedFromPath) {

   125         push @copiedFiles, $patch;

   126     } else {

   127         patch($patch);

   128     }

   129 }

   130 

   131 # Handle copied and moved files last since they may have had post-copy changes that have now been unapplied

   132 for $patch (@copiedFiles) {

   133     patch($patch);

   134 }

   135 

   136 revertDirectories();

   137 

   138 exit 0;

   139 

   140 sub checksum($)

   141 {

   142     my $file = shift;

   143     open(FILE, $file) or die "Can't open '$file': $!";

   144     binmode(FILE);

   145     my $checksum = Digest::MD5->new->addfile(*FILE)->hexdigest();

   146     close(FILE);

   147     return $checksum;

   148 }

   149 

   150 sub fixChangeLogPatch($)

   151 {

   152     my $patch = shift;

   153     my $contextLineCount = 3;

   154 

   155     return $patch if $patch !~ /\n@@ -1,(\d+) \+1,(\d+) @@\n( .*\n)+(\+.*\n)+( .*\n){$contextLineCount}$/m;

   156     my ($oldLineCount, $newLineCount) = ($1, $2);

   157     return $patch if $oldLineCount <= $contextLineCount;

   158 

   159     # The diff(1) command is greedy when matching lines, so a new ChangeLog entry will

   160     # have lines of context at the top of a patch when the existing entry has the same

   161     # date and author as the new entry.  This nifty loop alters a ChangeLog patch so

   162     # that the added lines ("+") in the patch always start at the beginning of the

   163     # patch and there are no initial lines of context.

   164     my $newPatch;

   165     my $lineCountInState = 0;

   166     my $oldContentLineCountReduction = $oldLineCount - $contextLineCount;

   167     my $newContentLineCountWithoutContext = $newLineCount - $oldLineCount - $oldContentLineCountReduction;

   168     my ($stateHeader, $statePreContext, $stateNewChanges, $statePostContext) = (1..4);

   169     my $state = $stateHeader;

   170     foreach my $line (split(/\n/, $patch)) {

   171         $lineCountInState++;

   172         if ($state == $stateHeader && $line =~ /^@@ -1,$oldLineCount \+1,$newLineCount @\@$/) {

   173             $line = "@@ -1,$contextLineCount +1," . ($newLineCount - $oldContentLineCountReduction) . " @@";

   174             $lineCountInState = 0;

   175             $state = $statePreContext;

   176         } elsif ($state == $statePreContext && substr($line, 0, 1) eq " ") {

   177             $line = "+" . substr($line, 1);

   178             if ($lineCountInState == $oldContentLineCountReduction) {

   179                 $lineCountInState = 0;

   180                 $state = $stateNewChanges;

   181             }

   182         } elsif ($state == $stateNewChanges && substr($line, 0, 1) eq "+") {

   183             # No changes to these lines

   184             if ($lineCountInState == $newContentLineCountWithoutContext) {

   185                 $lineCountInState = 0;

   186                 $state = $statePostContext;

   187             }

   188         } elsif ($state == $statePostContext) {

   189             if (substr($line, 0, 1) eq "+" && $lineCountInState <= $oldContentLineCountReduction) {

   190                 $line = " " . substr($line, 1);

   191             } elsif ($lineCountInState > $contextLineCount && substr($line, 0, 1) eq " ") {

   192                 next; # Discard

   193             }

   194         }

   195         $newPatch .= $line . "\n";

   196     }

   197 

   198     return $newPatch;

   199 }

   200 

   201 sub gitdiff2svndiff($)

   202 {

   203     $_ = shift @_;

   204     if (m#^diff --git a/(.+) b/(.+)#) {

   205         return "Index: $1";

   206     } elsif (m/^new file.*/) {

   207         return "";

   208     } elsif (m#^index [0-9a-f]{7}\.\.[0-9a-f]{7} [0-9]{6}#) {

   209         return "===================================================================";

   210     } elsif (m#^--- a/(.+)#) {

   211         return "--- $1";

   212     } elsif (m#^\+\+\+ b/(.+)#) {

   213         return "+++ $1";

   214     }

   215     return $_;

   216 }

   217 

   218 sub patch($)

   219 {

   220     my ($patch) = @_;

   221     return if !$patch;

   222 

   223     $patch =~ m|^Index: ([^\n]+)| or die "Failed to find Index: in \"$patch\"\n";

   224     my $fullPath = $1;

   225     $directoriesToCheck{dirname($fullPath)} = 1;

   226 

   227     my $deletion = 0;

   228     my $addition = 0;

   229     my $isBinary = 0;

   230 

   231     $addition = 1 if ($patch =~ /\n--- .+\(revision 0\)\n/ || $patch =~ /\n@@ -0,0 .* @@/);

   232     $deletion = 1 if $patch =~ /\n@@ .* \+0,0 @@/;

   233     $isBinary = 1 if $patch =~ /\nCannot display: file marked as a binary type\./;

   234 

   235     if (!$addition && !$deletion && !$isBinary) {

   236         # Standard patch, patch tool can handle this.

   237         if (basename($fullPath) eq "ChangeLog") {

   238             my $changeLogDotOrigExisted = -f "${fullPath}.orig";

   239             unapplyPatch(unsetChangeLogDate($fullPath, fixChangeLogPatch($patch)), $fullPath, ["--fuzz=3"]);

   240             unlink("${fullPath}.orig") if (! $changeLogDotOrigExisted);

   241         } else {

   242             unapplyPatch($patch, $fullPath);

   243         }

   244     } else {

   245         # Either a deletion, an addition or a binary change.

   246 

   247         if ($isBinary) {

   248             # Reverse binary change

   249             unlink($fullPath) if (-e $fullPath);

   250             system "svn", "revert", $fullPath;

   251         } elsif ($deletion) {

   252             # Reverse deletion

   253             rename($fullPath, "$fullPath.orig") if -e $fullPath;

   254 

   255             unapplyPatch($patch, $fullPath);

   256 

   257             # If we don't ask for the filehandle here, we always get a warning.

   258             my ($fh, $tempPath) = tempfile(basename($fullPath) . "-XXXXXXXX",

   259                                            DIR => dirname($fullPath), UNLINK => 1);

   260             close($fh);

   261 

   262             # Keep the version from the patch in case it's different from svn.

   263             rename($fullPath, $tempPath);

   264             system "svn", "revert", $fullPath;

   265             rename($tempPath, $fullPath);

   266 

   267             # This works around a bug in the svn client.

   268             # [Issue 1960] file modifications get lost due to FAT 2s time resolution

   269             # http://subversion.tigris.org/issues/show_bug.cgi?id=1960

   270             system "touch", $fullPath;

   271 

   272             # Remove $fullPath.orig if it is the same as $fullPath

   273             unlink("$fullPath.orig") if -e "$fullPath.orig" && checksum($fullPath) eq checksum("$fullPath.orig");

   274 

   275             # Show status if the file is modifed

   276             system "svn", "stat", $fullPath;

   277         } else {

   278             # Reverse addition

   279             unapplyPatch($patch, $fullPath, ["--force"]);

   280             unlink($fullPath) if -z $fullPath;

   281             system "svn", "revert", $fullPath;

   282         }

   283     }

   284 }

   285 

   286 sub revertDirectories()

   287 {

   288     my %checkedDirectories;

   289     foreach my $path (reverse sort keys %directoriesToCheck) {

   290         my @dirs = File::Spec->splitdir($path);

   291         while (scalar @dirs) {

   292             my $dir = File::Spec->catdir(@dirs);

   293             pop(@dirs);

   294             next if (exists $checkedDirectories{$dir});

   295             if (-d $dir) {

   296                 my $svnOutput = svnStatus($dir);

   297                 if ($svnOutput && $svnOutput =~ m#A\s+$dir\n#) {

   298                    system "svn", "revert", $dir;

   299                    rmdir $dir;

   300                 }

   301                 elsif ($svnOutput && $svnOutput =~ m#D\s+$dir\n#) {

   302                    system "svn", "revert", $dir;

   303                 }

   304                 else {

   305                     # Modification

   306                     print $svnOutput if $svnOutput;

   307                 }

   308                 $checkedDirectories{$dir} = 1;

   309             }

   310             else {

   311                 die "'$dir' is not a directory";

   312             }

   313         }

   314     }

   315 }

   316 

   317 sub svnStatus($)

   318 {

   319     my ($fullPath) = @_;

   320     my $svnStatus;

   321     open SVN, "svn status --non-interactive --non-recursive '$fullPath' |" or die;

   322     if (-d $fullPath) {

   323         # When running "svn stat" on a directory, we can't assume that only one

   324         # status will be returned (since any files with a status below the

   325         # directory will be returned), and we can't assume that the directory will

   326         # be first (since any files with unknown status will be listed first).

   327         my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));

   328         while (<SVN>) {

   329             chomp;

   330             my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));

   331             if ($normalizedFullPath eq $normalizedStatPath) {

   332                 $svnStatus = $_;

   333                 last;

   334             }

   335         }

   336         # Read the rest of the svn command output to avoid a broken pipe warning.

   337         local $/ = undef;

   338         <SVN>;

   339     }

   340     else {

   341         # Files will have only one status returned.

   342         $svnStatus = <SVN>;

   343     }

   344     close SVN;

   345     return $svnStatus;

   346 }

   347 

   348 sub unapplyPatch($$;$)

   349 {

   350     my ($patch, $fullPath, $options) = @_;

   351     $options = [] if (! $options);

   352     my $command = "patch " . join(" ", "-p0", "-R", @{$options});

   353     open PATCH, "| $command" or die "Failed to patch $fullPath: $!";

   354     print PATCH $patch;

   355     close PATCH;

   356 }

   357 

   358 sub unsetChangeLogDate($$)

   359 {

   360     my $fullPath = shift;

   361     my $patch = shift;

   362     my $newDate;

   363     sysopen(CHANGELOG, $fullPath, O_RDONLY) or die "Failed to open $fullPath: $!";

   364     sysseek(CHANGELOG, 0, SEEK_SET);

   365     my $byteCount = sysread(CHANGELOG, $newDate, 10);

   366     die "Failed reading $fullPath: $!" if !$byteCount || $byteCount != 10;

   367     close(CHANGELOG);

   368     $patch =~ s/(\n\+)\d{4}-[^-]{2}-[^-]{2}(  )/$1$newDate$2/;

   369     return $patch;

   370 }