source: locker/update-system/bin/propose-update @ 411

Last change on this file since 411 was 411, checked in by quentin, 17 years ago
Added --dev flag to use development packages
  • Property svn:executable set to *
File size: 4.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}] 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($old, $newdir);
37
38sub unpackPackage($$) {
39  my ($package, $dir) = @_;
40  print "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.tar.gz"`; $? && die "Failed to unpack $package.tar.gz: $?";
49  my @files=`athrun scripts gfind . -mindepth 1 -maxdepth 1 | grep -v .admin`;
50  if (@files <= 1) {
51    `athrun scripts gfind . -mindepth 2 -maxdepth 2 | xargs -i mv \{} .`;
52    rmdir($files[0]);
53  }
54  chdir($cwd) or die "Couldn't return to $cwd";
55  print "done.\n";
56}
57
58my @oldfiles = sort { $a->[1] cmp $b->[1] } map { chomp; s|$olddir\/?||g; [split(' ', $_, 2)] } `athrun scripts gfind $olddir -type f | xargs -i md5sum \{}`;
59#print Dumper(\@oldfiles);
60my @newfiles = sort { $a->[1] cmp $b->[1] } map { chomp; s|$newdir\/?||g; [split(' ', $_, 2)] } `athrun scripts gfind $newdir -type f | xargs -i md5sum \{}`;
61#print Dumper(\@newfiles);
62
63sub compareDirectories($$) {
64  my ($alist, $blist) = @_;
65  my @a = @$alist;
66  my @b = @$blist;
67  my @aonly, @bonly, @both;
68  $a = $b = 0;
69  my $debug = 1;
70  local $Data::Dumper::Indent = 0;
71  while ($a <= $#a || $b <= $#a) {
72    my $fa = $a[$a];
73    my $fb = $b[$b];
74    print STDERR "Comparing ".Dumper($fa, $fb)."\n" if $debug;
75    if ($fa->[1] eq $fb->[1]) { # Same file exists on both
76      print STDERR "Same file\n" if $debug;
77      if ($fa->[0] ne $fb->[0]) { # File has changed in some way
78        print STDERR "Different md5, pushing on \@both\n" if $debug;
79        push(@both, [$fa->[1], $fa, $fb]);
80      }
81      $a++; $b++; # increment both counters
82    } else {
83      my $a2 = $a;
84      while ($a2 <= $#a && $a[$a2]->[1] lt $fb->[1]) {
85        $a2++;
86      }
87      if ($a2 <= $#a && $a[$a2]->[1] eq $fb->[1]) {
88        for my $i ($a..$a2-1) {
89          push @aonly, $a[$i];
90        }
91        $a = $a2;
92      } else {
93        my $b2 = $b;
94        while ($b2 <= $#b && $b[$b2]->[1] lt $fa->[1]) {
95          $b2++;
96        }
97        if ($b2 <= $#b && $b[$b2]->[1] eq $fa->[1]) {
98          for my $i ($b..$b2-1) {
99            push @bonly, $b[$i];
100          }
101          $b = $b2;
102        } else {
103          push @aonly, $a[$a];
104          push @bonly, $b[$b];
105          $a++; $b++;
106        }
107      }
108    }
109  }
110  return (\@aonly, \@bonly, \@both);
111}
112
113my (@todelete, @toadd, @changed);
114my @comp = compareDirectories(\@oldfiles, \@newfiles);
115print Dumper(@comp);
116@todelete = @{$comp[0]};
117@toadd = @{$comp[1]};
118@changed = @{$comp[2]};
119
120if ($redodelete or ! -e catfile($outdir, "files.delete")) {
121        open(TODELETE, ">", catfile($outdir, "files.delete")) or die "Can't open files.delete: $!";
122        foreach my $file (@todelete) {
123          printf TODELETE "%s %s\n", $file->[0], $file->[1];
124        }
125        close(TODELETE);
126}
127
128if ($redoadd or ! -e catfile($outdir, "files.add")) {
129        open(TOADD, ">", catfile($outdir, "files.add")) or die "Can't open files.add: $!";
130        foreach my $file (@toadd) {
131          printf TOADD "%s # MD5 = %s\n", $file->[1], $file->[0];
132        }
133        close(TOADD);
134}
135
136my @toreplace;
137my @topatch;
138
139foreach my $file (@changed) {
140        if (-B catdir($newdir, $file->[0])) {
141                push (@toreplace, $file);
142        } else {
143                push (@topatch, $file);
144        }
145}
146
147if ($redoreplace or ! -e catfile($outdir, "files.replace")) {
148        open(TOREPLACE, ">", catfile($outdir, "files.replace")) or die "Can't open files.replace: $!";
149        foreach my $file (@toreplace) {
150                printf TOREPLACE "%s %s\n", $file->[2][0], $file->[0];
151        }
152        close(TOREPLACE);
153}
Note: See TracBrowser for help on using the repository browser.