• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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 WebKit 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
57use strict;
58use warnings;
59
60use Cwd;
61use Digest::MD5;
62use Fcntl qw(:DEFAULT :seek);
63use File::Basename;
64use File::Spec;
65use File::Temp qw(tempfile);
66use Getopt::Long;
67
68sub checksum($);
69sub fixChangeLogPatch($);
70sub gitdiff2svndiff($);
71sub patch($);
72sub revertDirectories();
73sub svnStatus($);
74sub unapplyPatch($$;$);
75sub unsetChangeLogDate($$);
76
77my $showHelp = 0;
78if (!GetOptions("help!" => \$showHelp) || $showHelp) {
79    print STDERR basename($0) . " [-h|--help] patch1 [patch2 ...]\n";
80    exit 1;
81}
82
83my @copiedFiles;
84my %directoriesToCheck;
85
86my $copiedFromPath;
87my $filter;
88my $indexPath;
89my $patch;
90while (<>) {
91    s/([\n\r]+)$//mg;
92    my $eol = $1;
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 .= $eol;
121}
122
123if ($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
132for $patch (@copiedFiles) {
133    patch($patch);
134}
135
136revertDirectories();
137
138exit 0;
139
140sub 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
150sub 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
201sub 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
218sub patch($)
219{
220    my ($patch) = @_;
221    return if !$patch;
222
223    unless ($patch =~ m|^Index: ([^\r\n]+)|) {
224        my $separator = '-' x 67;
225        warn "Failed to find 'Index:' in:\n$separator\n$patch\n$separator\n";
226        return;
227    }
228    my $fullPath = $1;
229    $directoriesToCheck{dirname($fullPath)} = 1;
230
231    my $deletion = 0;
232    my $addition = 0;
233    my $isBinary = 0;
234
235    $addition = 1 if ($patch =~ /\n--- .+\(revision 0\)\n/ || $patch =~ /\n@@ -0,0 .* @@/);
236    $deletion = 1 if $patch =~ /\n@@ .* \+0,0 @@/;
237    $isBinary = 1 if $patch =~ /\nCannot display: file marked as a binary type\./;
238
239    if (!$addition && !$deletion && !$isBinary) {
240        # Standard patch, patch tool can handle this.
241        if (basename($fullPath) eq "ChangeLog") {
242            my $changeLogDotOrigExisted = -f "${fullPath}.orig";
243            unapplyPatch(unsetChangeLogDate($fullPath, fixChangeLogPatch($patch)), $fullPath, ["--fuzz=3"]);
244            unlink("${fullPath}.orig") if (! $changeLogDotOrigExisted);
245        } else {
246            unapplyPatch($patch, $fullPath);
247        }
248    } else {
249        # Either a deletion, an addition or a binary change.
250
251        if ($isBinary) {
252            # Reverse binary change
253            unlink($fullPath) if (-e $fullPath);
254            system "svn", "revert", $fullPath;
255        } elsif ($deletion) {
256            # Reverse deletion
257            rename($fullPath, "$fullPath.orig") if -e $fullPath;
258
259            unapplyPatch($patch, $fullPath);
260
261            # If we don't ask for the filehandle here, we always get a warning.
262            my ($fh, $tempPath) = tempfile(basename($fullPath) . "-XXXXXXXX",
263                                           DIR => dirname($fullPath), UNLINK => 1);
264            close($fh);
265
266            # Keep the version from the patch in case it's different from svn.
267            rename($fullPath, $tempPath);
268            system "svn", "revert", $fullPath;
269            rename($tempPath, $fullPath);
270
271            # This works around a bug in the svn client.
272            # [Issue 1960] file modifications get lost due to FAT 2s time resolution
273            # http://subversion.tigris.org/issues/show_bug.cgi?id=1960
274            system "touch", $fullPath;
275
276            # Remove $fullPath.orig if it is the same as $fullPath
277            unlink("$fullPath.orig") if -e "$fullPath.orig" && checksum($fullPath) eq checksum("$fullPath.orig");
278
279            # Show status if the file is modifed
280            system "svn", "stat", $fullPath;
281        } else {
282            # Reverse addition
283            unapplyPatch($patch, $fullPath, ["--force"]);
284            unlink($fullPath) if -z $fullPath;
285            system "svn", "revert", $fullPath;
286        }
287    }
288}
289
290sub revertDirectories()
291{
292    my %checkedDirectories;
293    foreach my $path (reverse sort keys %directoriesToCheck) {
294        my @dirs = File::Spec->splitdir($path);
295        while (scalar @dirs) {
296            my $dir = File::Spec->catdir(@dirs);
297            pop(@dirs);
298            next if (exists $checkedDirectories{$dir});
299            if (-d $dir) {
300                my $svnOutput = svnStatus($dir);
301                if ($svnOutput && $svnOutput =~ m#A\s+$dir\n#) {
302                   system "svn", "revert", $dir;
303                   rmdir $dir;
304                }
305                elsif ($svnOutput && $svnOutput =~ m#D\s+$dir\n#) {
306                   system "svn", "revert", $dir;
307                }
308                else {
309                    # Modification
310                    print $svnOutput if $svnOutput;
311                }
312                $checkedDirectories{$dir} = 1;
313            }
314            else {
315                die "'$dir' is not a directory";
316            }
317        }
318    }
319}
320
321sub svnStatus($)
322{
323    my ($fullPath) = @_;
324    my $svnStatus;
325    open SVN, "svn status --non-interactive --non-recursive '$fullPath' |" or die;
326    if (-d $fullPath) {
327        # When running "svn stat" on a directory, we can't assume that only one
328        # status will be returned (since any files with a status below the
329        # directory will be returned), and we can't assume that the directory will
330        # be first (since any files with unknown status will be listed first).
331        my $normalizedFullPath = File::Spec->catdir(File::Spec->splitdir($fullPath));
332        while (<SVN>) {
333            # Input may use a different EOL sequence than $/, so avoid chomp.
334            $_ =~ s/[\r\n]+$//g;
335            my $normalizedStatPath = File::Spec->catdir(File::Spec->splitdir(substr($_, 7)));
336            if ($normalizedFullPath eq $normalizedStatPath) {
337                $svnStatus = $_;
338                last;
339            }
340        }
341        # Read the rest of the svn command output to avoid a broken pipe warning.
342        local $/ = undef;
343        <SVN>;
344    }
345    else {
346        # Files will have only one status returned.
347        $svnStatus = <SVN>;
348    }
349    close SVN;
350    return $svnStatus;
351}
352
353sub unapplyPatch($$;$)
354{
355    my ($patch, $fullPath, $options) = @_;
356    $options = [] if (! $options);
357    my $command = "patch " . join(" ", "-p0", "-R", @{$options});
358    open PATCH, "| $command" or die "Failed to patch $fullPath: $!";
359    print PATCH $patch;
360    close PATCH;
361}
362
363sub unsetChangeLogDate($$)
364{
365    my $fullPath = shift;
366    my $patch = shift;
367    my $newDate;
368    sysopen(CHANGELOG, $fullPath, O_RDONLY) or die "Failed to open $fullPath: $!";
369    sysseek(CHANGELOG, 0, SEEK_SET);
370    my $byteCount = sysread(CHANGELOG, $newDate, 10);
371    die "Failed reading $fullPath: $!" if !$byteCount || $byteCount != 10;
372    close(CHANGELOG);
373    $patch =~ s/(\n\+)\d{4}-[^-]{2}-[^-]{2}(  )/$1$newDate$2/;
374    return $patch;
375}
376