source: trunk/locker/sbin/propose-update @ 1400

Last change on this file since 1400 was 1030, checked in by mitchb, 15 years ago
Fix propose-update to a) work at all again, and b) work on all platforms
  • Property svn:executable set to *
File size: 5.3 KB
Line 
1#!/usr/athena/bin/perl
2
3use File::Spec::Functions;
4use Data::Dumper;
5use Getopt::Long;
6use Cwd;
7
8my ($redodelete, $redoadd, $redoreplace, $redodiff) = (0,0,0,0);
9
10my $scriptsdev = "";
11
12GetOptions("redo-delete" => \$redodelete,
13           "redo-add" => \$redoadd,
14           "redo-replace" => \$redoreplace,
15           "redo-diff" => \$redodiff,
16           "redo-all" => sub {$redodelete = $redoadd = $redoreplace = $redodiff = 1;},
17           "dev" => sub {$scriptsdev = "dev";},
18                  );
19
20if (@ARGV < 3) {
21  print STDERR "Usage: $0 [--redo-{delete|add|replace|diff|all}] [--dev] package oldversion newversion\n";
22  exit(1);
23}
24
25my ($package, $oldversion, $newversion) = @ARGV;
26my ($old, $new, $updatename) = ($package.'-'.$oldversion, $package.'-'.$newversion, $package.'-'.$oldversion.'-to-'.$newversion);
27
28my $outdir = $updatename.".proposal";
29
30(-d $outdir || mkdir($outdir)) or die "mkdir($outdir) failed: $!";
31
32my $olddir = catdir($outdir,$old);
33my $newdir = catdir($outdir,$new);
34
35unpackPackage($old, $olddir);
36unpackPackage($new, $newdir);
37
38sub unpackPackage($$) {
39  my ($package, $dir) = @_;
40  print STDERR "Extracting $package to $dir... ";
41  if (-d $dir) {
42    warn "$dir already exists; assuming unpacking was successful";
43    return;
44  }
45  mkdir($dir) or die "mkdir($dir) failed: $!";
46  my $cwd = cwd();
47  chdir($dir) or die $!;
48  `athrun scripts gtar zxf "/mit/scripts/deploy$scriptsdev/$package/$package.tar.gz"`;
49  if ($?) { chdir($cwd); system("rmdir", "$dir"); die "Failed to unpack $package.tar.gz: $?"; }
50  my @files=`athrun scripts gfind . -mindepth 1 -maxdepth 1 | grep -v .admin`;
51  if (@files <= 1) {
52    `athrun scripts gfind . -mindepth 2 -maxdepth 2 -exec mv {} . \\;`;
53    rmdir($files[0]);
54  }
55  chdir($cwd) or die "Couldn't return to $cwd";
56  print "done.\n";
57}
58
59my @oldfiles = sort { $a->[1] cmp $b->[1] } map { chomp; s|$olddir\/?||g; [split(' ', $_, 2)] } `athrun scripts gfind $olddir -type f -exec md5sum {} \\;`;
60#print Dumper(\@oldfiles);
61my @newfiles = sort { $a->[1] cmp $b->[1] } map { chomp; s|$newdir\/?||g; [split(' ', $_, 2)] } `athrun scripts gfind $newdir -type f -exec md5sum {} \\;`;
62#print Dumper(\@newfiles);
63
64sub compareDirectories($$) {
65  my ($alist, $blist) = @_;
66  my @a = @$alist;
67  my @b = @$blist;
68  my @aonly, @bonly, @both;
69  $a = $b = 0;
70  my $debug = 0;
71  local $Data::Dumper::Indent = 0;
72  while ($a <= $#a || $b <= $#a) {
73    my $fa = $a[$a];
74    my $fb = $b[$b];
75    print STDERR "Comparing ".Dumper($fa, $fb)."\n" if $debug;
76    if ($fa->[1] eq $fb->[1]) { # Same file exists on both
77      print STDERR "Same file\n" if $debug;
78      if ($fa->[0] ne $fb->[0]) { # File has changed in some way
79        print STDERR "Different md5, pushing on \@both\n" if $debug;
80        push(@both, [$fa->[1], $fa, $fb]);
81      }
82      $a++; $b++; # increment both counters
83    } else {
84      my $a2 = $a;
85      while ($a2 <= $#a && $a[$a2]->[1] lt $fb->[1]) {
86        $a2++;
87      }
88      if ($a2 <= $#a && $a[$a2]->[1] eq $fb->[1]) {
89        for my $i ($a..$a2-1) {
90          push @aonly, $a[$i];
91        }
92        $a = $a2;
93      } else {
94        my $b2 = $b;
95        while ($b2 <= $#b && $b[$b2]->[1] lt $fa->[1]) {
96          $b2++;
97        }
98        if ($b2 <= $#b && $b[$b2]->[1] eq $fa->[1]) {
99          for my $i ($b..$b2-1) {
100            push @bonly, $b[$i];
101          }
102          $b = $b2;
103        } else {
104          push @aonly, $a[$a];
105          push @bonly, $b[$b];
106          $a++; $b++;
107        }
108      }
109    }
110  }
111  return (\@aonly, \@bonly, \@both);
112}
113
114my (@todelete, @toadd, @changed);
115my @comp = compareDirectories(\@oldfiles, \@newfiles);
116open(DIFF, ">", catfile($outdir, "diff.pl"));
117print DIFF Dumper(@comp);
118close(DIFF);
119@todelete = @{$comp[0]};
120@toadd = @{$comp[1]};
121@changed = @{$comp[2]};
122
123if ($redodelete or ! -e catfile($outdir, "files.delete")) {
124        open(TODELETE, ">", catfile($outdir, "files.delete")) or die "Can't open files.delete: $!";
125        foreach my $file (@todelete) {
126          printf TODELETE "%s %s\n", $file->[0], $file->[1];
127        }
128        close(TODELETE);
129        printf "Wrote %d filenames to files.delete\n", scalar(@todelete);
130} else { printf "Not overwriting existing files.delete\n"; }
131
132if ($redoadd or ! -e catfile($outdir, "files.add")) {
133        open(TOADD, ">", catfile($outdir, "files.add")) or die "Can't open files.add: $!";
134        foreach my $file (@toadd) {
135          printf TOADD "%s %s\n", $file->[0], $file->[1];
136        }
137        close(TOADD);
138        printf "Wrote %d filenames to files.add\n", scalar(@toadd);
139} else { printf "Not overwriting existing files.add\n"; }
140
141my @toreplace;
142my @topatch;
143
144foreach my $file (@changed) {
145        if (-B catdir($newdir, $file->[0])) {
146                push (@toreplace, $file);
147        } else {
148                push (@topatch, $file);
149        }
150}
151
152if ($redoreplace or ! -e catfile($outdir, "files.replace")) {
153        open(TOREPLACE, ">", catfile($outdir, "files.replace")) or die "Can't open files.replace: $!";
154        foreach my $file (@toreplace) {
155                printf TOREPLACE "%s %s\n", $file->[1][0], $file->[0];
156        }
157        close(TOREPLACE);
158        printf "Wrote %d filenames to files.replace\n", scalar(@toreplace);
159} else { printf "Not overwriting existing files.replace\n"; }
160
161if ($redodiff or ! -e catfile($outdir, "update.diff")) {
162    open(DIFF, ">", catfile($outdir, "update.diff")) or die "Can't open update.diff: $!";
163    foreach my $file (@topatch) {
164        my $filename = $file->[0];
165        my $oldfile = catfile($olddir, $file->[1][1]);
166        my $newfile = catfile($newdir, $file->[2][1]);
167        my $cmd = "diff -urN $oldfile $newfile";
168        print DIFF "$cmd\n";
169        print DIFF `$cmd`;
170    }
171    close(DIFF);
172    printf "Wrote %d diffs to update.diff\n", scalar(@topatch);
173} else { printf "Not overwriting existing update.patch\n"; }
Note: See TracBrowser for help on using the repository browser.