debtransform

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Digest::MD5;
   5
   6 sub parsedsc {
   7   my ($fn) = @_;
   8   my @control;
   9   local *F;
  10   open(F, '<', $fn) || die("$fn: $!\n");
  11   @control = <F>;
  12   close F;
  13   chomp @control;
  14   splice(@control, 0, 3) if @control > 3 && $control[0] =~ /^-----BEGIN/;
  15   my @seq = ();
  16   my %tag;
  17   while (@control) {
  18     my $c = shift @control;
  19     last if $c eq '';   # new paragraph
  20     my ($tag, $data) = split(':', $c, 2);
  21     next unless defined $data;
  22     push @seq, $tag;
  23     $tag = uc($tag);
  24     while (@control && $control[0] =~ /^\s/) {
  25       $data .= "\n".substr(shift @control, 1);
  26     }
  27     $data =~ s/^\s+//s;
  28     $data =~ s/\s+$//s;
  29     $tag{$tag} = $data;
  30   }
  31   $tag{'__seq'} = \@seq;
  32   return \%tag;
  33 }
  34
  35 sub writedsc {
  36   my ($fn, $tags) = @_;
  37   open(F, '>', $fn) || die("$fn: $!\n");
  38   my @seq = @{$tags->{'__seq'} || []};
  39   my %seq = map {uc($_) => 1} @seq;
  40   for (sort keys %$tags) {
  41     push @seq, ucfirst(lc($_)) unless $seq{$_};
  42   }
  43   for my $seq (@seq) {
  44     my $ucseq = uc($seq);
  45     my $d = $tags->{$ucseq};
  46     next unless defined $d;
  47     $d =~ s/\n/\n /sg;
  48     print F "$seq: $d\n";
  49   }
  50   print F "\n";
  51   close F;
  52 }
  53
  54 sub listtar {
  55   my ($tar) = @_;
  56   local *F;
  57   my @c;
  58   open(F, '-|', 'tar', '--numeric-owner', '-tvf', $tar) || die("tar: $!\n");
  59   while(<F>) {
  60     next unless /^([-dlbcp])(.........)\s+\d+\/\d+\s+(\S+) \d\d\d\d-\d\d-\d\d \d\d:\d\d(?::\d\d)? (.*)$/;
  61     my ($type, $mode, $size, $name) = ($1, $2, $3, $4);
  62     next if $type eq 'd';
  63     die("debian tar contains link: $name\n") if $type eq 'l';
  64     die("debian tar contains unexpected file type: $name\n") if $type ne '-';
  65     $name =~ s/^\.\///;
  66     $name =~ s/^debian\///;
  67     push @c, {'name' => $name, 'size' => $size};
  68   }
  69   close(F) || die("tar: $!\n");
  70   return @c;
  71 }
  72
  73 sub dotar {
  74   my ($tar, $tardir, $origin, @c) = @_;
  75   local *F;
  76   open(F, '-|', 'tar', '-xOf', $tar) || die("tar: $!\n");
  77   for my $c (@c) {
  78     my $s = $c->{'size'};
  79     my $file = '';
  80     while ($s > 0) {
  81       my $l = sysread(F, $file, $s, length($file));
  82       die("tar read error\n") unless $l;
  83       $s -= $l;
  84     }
  85     next if $origin && $origin->{$c->{'name'}} ne $tar;
  86     my @file = split("\n", $file);
  87     print DIFF "--- $tardir.orig/debian/$c->{'name'}\n";
  88     print DIFF "+++ $tardir/debian/$c->{'name'}\n";
  89     next unless @file;
  90     print DIFF "\@\@ -0,0 +1,".scalar(@file)." \@\@\n";
  91     print DIFF "+$_\n" for @file;
  92   }
  93   close(F);
  94 }
  95
  96 sub dofile {
  97   my ($file, $tardir, $dfile) = @_;
  98   local *F;
  99   open(F, '<', $file) || die("$file: $!\n");
 100   my @file = <F>;
 101   close F;
 102   chomp(@file);
 103   print DIFF "--- $tardir.orig/$dfile\n";
 104   print DIFF "+++ $tardir/$dfile\n";
 105   return unless @file;
 106   print DIFF "\@\@ -0,0 +1,".scalar(@file)." \@\@\n";
 107   print DIFF "+$_\n" for @file;
 108 }
 109
 110 sub doseries {
 111   my ($series, $tardir) = @_;
 112   my $dir = $series;
 113   $dir =~ s/[^\/]+$//;
 114   $dir =~ s/\/+$//;
 115   $dir = '.' if $dir eq '';
 116   local *F;
 117   open(F, '<', $series) || die("$series: $!\n");
 118   my @series = <F>;
 119   close F;
 120   chomp(@series);
 121   for my $patch (@series) {
 122     $patch =~ s/(^|\s+)#.*//;
 123     next if $patch =~ /^\s*$/;
 124     my $level = 1;
 125     $level = $1 if $patch =~ /\s.*-p\s*(\d+)/;
 126     $patch =~ s/\s.*//;
 127     open(F, '<', "$dir/$patch") || die("$dir/$patch: $!\n");
 128     while(<F>) {
 129       chomp;
 130       if ((/^--- ./ || /^\+\+\+ ./) && !/^... \/dev\/null/) {
 131         my $start = substr($_, 0, 4);
 132         $_ = substr($_, 4);
 133         my $l = $level;
 134         while ($l > 0) {
 135           last unless s/.*?\///;
 136           $l--;
 137         }
 138         if ($start eq '--- ') {
 139           print DIFF "$start$tardir.orig/$_\n";
 140         } else {
 141           print DIFF "$start$tardir/$_\n";
 142         }
 143         next;
 144       }
 145       print DIFF "$_\n";
 146     }
 147     close F;
 148   }
 149 }
 150
 151 sub addfile {
 152   my ($file) = @_;
 153   my $base = $file;
 154   $base =~ s/.*\///;
 155   local *F;
 156   open(F, '<', $file) || die("$file: $!\n");
 157   my $size = -s F;
 158   my $ctx = Digest::MD5->new;
 159   $ctx->addfile(*F);
 160   close F;
 161   my $md5 = $ctx->hexdigest();
 162   return "$md5 $size $base";
 163 }
 164
 165 my $changelog;
 166
 167 if (@ARGV > 1 && $ARGV[0] eq '--changelog') {
 168   shift @ARGV;
 169   $changelog = shift @ARGV;
 170 }
 171 die("usage: debtransform [--changelog <changelog>] <srcdir> <dscfile> <outdir>\n") unless @ARGV == 3;
 172
 173 my $dir = $ARGV[0];
 174 my $dsc = $ARGV[1];
 175 my $out = $ARGV[2];
 176
 177 die("$out: $!\n") unless -d $out;
 178
 179 my $tags = parsedsc($dsc);
 180
 181 opendir(D, $dir) || die("$dir: $!\n");
 182 my @dir = grep {$_ ne '.' && $_ ne '..'} readdir(D);
 183 closedir(D);
 184 my %dir = map {$_ => 1} @dir;
 185
 186 my $tarfile = $tags->{'DEBTRANSFORM-TAR'};
 187 my @debtarfiles;
 188 if ($tags->{'DEBTRANSFORM-FILES-TAR'}) {
 189   @debtarfiles = split(' ', $tags->{'DEBTRANSFORM-FILES-TAR'});
 190 }
 191
 192 if (!$tarfile || !@debtarfiles) {
 193   my @tars = grep {/\.tar(?:\.gz|\.bz2)?$/} @dir;
 194   my @debtars = grep {/^debian\.tar(?:\.gz|\.bz2)?$/} @tars;
 195   if (!$tarfile) {
 196     @tars = grep {!/^debian\.tar(?:\.gz|\.bz2)?$/} @tars;
 197     if (@debtarfiles) {
 198       my %debtarfiles = map {$_ => 1} @debtarfiles;
 199       @tars = grep {!$debtarfiles{$_}} @tars;
 200     }
 201     die("package contains no tar file\n") unless @tars;
 202     die("package contains more than one tar file: @tars\n") if @tars > 1;
 203     $tarfile = $tars[0];
 204   }
 205   if (@debtars && !exists($tags->{'DEBTRANSFORM-FILES-TAR'})) {
 206     die("package contains more than one debian tar file\n") if @debtars > 1;
 207     @debtarfiles = ($debtars[0]);
 208   }
 209 }
 210
 211 my $name = $tags->{'SOURCE'};
 212 die("dsc file contains no source\n") unless defined($name);
 213 my $version = $tags->{'VERSION'};
 214 die("dsc file contains no version\n") unless defined($version);
 215 $version =~ s/^\d+://;  # no epoch in version, please
 216
 217 # transform
 218 my $tmptar;
 219 if ($tarfile =~ /\.tar\.bz2/) {
 220     my $old = $tarfile;
 221     $tarfile =~ s/\.tar\.bz2/\.tar\.gz/;
 222     $tmptar = "$out/$tarfile";
 223     print "converting $old to $tarfile\n";
 224     system( ( "debtransformbz2", "$old", "$tmptar" )) == 0 || die("cannot transform .tar.bz2 to .tar.gz");
 225 }
 226 if ($tarfile =~ /\.zip/) {
 227     my $old = $tarfile;
 228     $tarfile =~ s/\.zip/\.tar\.gz/;
 229     $tmptar = "$out/$tarfile";
 230     print "converting $old to $tarfile\n";
 231     system( ( "debtransformzip", "$old", "$tmptar" )) == 0 || die("cannot transform .zip to .tar.gz");
 232 }
 233
 234 my $tardir = $tarfile;
 235 $tardir =~ s/\.orig\.tar/\.tar/;
 236 $tardir =~ s/\.tar.*?$//;
 237
 238 my @files;
 239 my $v = $version;
 240 $v =~ s/-[^-]*$//;
 241 $tarfile =~ /.*(\.tar.*?)$/;
 242 my $ntarfile = "${name}_$v.orig$1";
 243 if( $tmptar ) {
 244   link("$tmptar", "$out/$ntarfile") || die("link $dir/$tarfile $out/$ntarfile: $!\n");
 245   unlink("$tmptar");
 246 } else {
 247   link("$dir/$tarfile", "$out/$ntarfile") || die("link $dir/$tarfile $out/$ntarfile: $!\n");
 248 }
 249 push @files, addfile("$out/$ntarfile");
 250
 251 open(DIFF, '>', "$out/${name}_$version.diff") || die("$out/${name}_$version.diff: $!\n");
 252
 253 undef $changelog if $dir{'debian.changelog'};
 254
 255 my %debtarorigin;
 256 my %debtarcontent;
 257 for my $debtarfile (@debtarfiles) {
 258   my @c = listtar("$dir/$debtarfile");
 259   $debtarcontent{$debtarfile} = \@c;
 260   for (@c) {
 261     die("debian tar and directory both contain '$_->{'name'}'\n") if $dir{"debian.$_->{'name'}"};
 262     undef $changelog if $_->{'name'} eq 'changelog';
 263     $debtarorigin{$_->{'name'}} = "$dir/$debtarfile";
 264   }
 265 }
 266
 267 dofile($changelog, $tardir, 'debian/changelog') if defined $changelog;
 268
 269 for my $debtarfile (@debtarfiles) {
 270   dotar("$dir/$debtarfile", $tardir, \%debtarorigin, @{$debtarcontent{$debtarfile} });
 271 }
 272
 273 for my $file (grep {/^debian\./} @dir) {
 274   next if $file eq 'debian.series';
 275   next if $file =~ /\.tar$/;
 276   next if $file =~ /\.tar\./;
 277   dofile("$dir/$file", $tardir, 'debian/'.substr($file, 7));
 278 }
 279
 280 if ($tags->{'DEBTRANSFORM-SERIES'}) {
 281   doseries("$dir/$tags->{'DEBTRANSFORM-SERIES'}", $tardir);
 282 } elsif ($dir{"debian.series"}) {
 283   doseries("$dir/debian.series", $tardir);
 284 } elsif ($dir{"patches.series"}) {
 285   doseries("$dir/patches.series", $tardir);
 286 }
 287
 288 close(DIFF);
 289
 290 if (! -s "$out/${name}_$version.diff") {
 291   unlink("$out/${name}_$version.diff");
 292 } else {
 293   system('gzip', '-9', "$out/${name}_$version.diff");
 294   if (-f "$out/${name}_$version.diff.gz") {
 295     push @files, addfile("$out/${name}_$version.diff.gz");
 296   } else {
 297     push @files, addfile("$out/${name}_$version.diff");
 298   }
 299 }
 300
 301 $tags->{'FILES'} = "\n".join("\n", @files);
 302 delete $tags->{'DEBTRANSFORM-SERIES'};
 303 delete $tags->{'DEBTRANSFORM-TAR'};
 304 delete $tags->{'DEBTRANSFORM-FILES-TAR'};
 305 writedsc("$out/${name}_$version.dsc", $tags);
 306 exit(0);