deb2targz/deb2targz

   1 #!/usr/bin/perl -w
   2 # $Id: deb2targz,v 1.1 2002/12/17 11:57:54 mike Exp $
   3
   4 # deb2targz - convert a Debian Linux .deb file to a .tar.gz
   5 #
   6 # This is a hack based only on my eyeball inspection of a single .deb
   7 # file (scottfree_1.14-5_i386.deb) and not on a deep understanding of
   8 # the format.  However, so far as I can tell, here's how it works:
   9 #
  10 # First line -- file header: "!<arch>" or similar
  11 # Multiple blocks -- each one, a header line followed by data
  12 #       Header line -- <filename> <num1> <num2> <num3> <mode> <len>
  13 #       Data -- <len> bytes of data
  14 # We want the block called "data.tar.gz"
  15 #
  16 # This naive algorithm seems to work on the other .deb files that I've
  17 # tested it on, so I'm happy enough with it:
  18 #       libapache-reload-perl_0.07-1_all.deb
  19 #       libogg0_1.0.0-1_i386.deb
  20 #       abiword_1.0.2+cvs.2002.06.05-1_i386.deb
  21
  22 use strict;
  23 use IO::File;
  24
  25 $0 =~ s@.*/@@;
  26 if (@ARGV == 0) {
  27     print STDERR "Usage: $0 <deb-file> [<deb-file> ...]\n";
  28     exit(1);
  29 }
  30
  31 FILE: foreach my $filename (@ARGV) {
  32     if ($filename !~ /\.deb$/) {
  33         print "$0: ignoring '$filename' (not a .deb)\n";
  34         next;
  35     }
  36
  37     print "$0: converting '$filename' ...\n";
  38     my $fh = new IO::File("<$filename")
  39         or die "$0: can't read '$filename': $!";
  40
  41     <$fh>;                      # discard file-header line
  42     my $data = join('', <$fh>);
  43     $fh->close();
  44
  45     while ($data) {
  46         my $header;
  47         ($header, $data) = ($data =~ /(.*?)\n(.*)/s);
  48         my($name, $num1, $num2, $num3, $num4, $len) = split /\s+/, $header;
  49         #print "header='$header'\n\tname='$name', len=$len\n";
  50         if ($name eq "data.tar.gz") {
  51             # Found it
  52             $data = substr($data, 0, $len);
  53             $filename =~ s/\.deb$/.tar.gz/;
  54             my $fh = new IO::File(">$filename")
  55                 or die "can't write '$filename': $!";
  56             print $fh $data;
  57             $fh->close();
  58             print "$0: wrote '$filename'\n";
  59             next FILE;
  60         }
  61
  62         print "$0: skipping section '$name'\n";
  63         if (substr($data, $len, 1) eq "\n") {
  64             $len++;
  65         }
  66         $data = substr($data, $len);
  67     }
  68 }