dpkg-split/mksplit.pl

   1 #!/usr/bin/perl --
   2 # This script is only supposed to be called by dpkg-split.
   3 # Its arguments are:
   4 #  <sourcefile> <partsize> <prefix> <totalsize> <partsizeallow> <msdostruncyesno>
   5 # Stdin is also redirected from the source archive by dpkg-split.
   6
   7 # Copyright © 1995 Ian Jackson <ian@chiark.greenend.org.uk>
   8 #
   9 # This is free software; you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 2 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 @ARGV == 6 || die "mksplit: bad invocation\n";
  23
  24 ($sourcefile,$partsize,$prefix,$orgsize,$partsizeallow,$msdos) = @ARGV;
  25
  26 sub output {
  27     $!=0; $rv= `$_[0]`; $? && die "mksplit $_[0]: $! $?\n";
  28     $rv =~ s/\n$//; $rv =~ s/\s+$//; $rv =~ s/^\s+//;
  29     $rv;
  30 }
  31
  32 $myversion='2.1';
  33 $csum= &output("md5sum <\"$sourcefile\"");
  34 $csum =~ s/\s.*//;
  35 $package= &output("dpkg-deb --field \"$sourcefile\" Package");
  36 $version= &output("dpkg-deb --field \"$sourcefile\" Version");
  37 $revision= &output("dpkg-deb --field \"$sourcefile\" Package_Revision");
  38 $version.= "-$revision" if length($revision);
  39 $nparts=int(($orgsize+$partsize-1)/$partsize);
  40 $startat=0;
  41 $showpartnum=1;
  42
  43 $|=1;
  44 print("Splitting package $package into $nparts parts: ");
  45
  46 $msdos= ($msdos eq 'yes');
  47 if ($msdos) {
  48     $prefixdir= $prefix; $prefixdir =~ s:(/?)/*[^/]+$:$1:;
  49     $cleanprefix= $prefix; $cleanprefix =~ s:^.*/+::;
  50     $cleanprefix =~ y/A-Za-z0-9+/a-za-z0-9x/;
  51     $cleanprefix =~ y/a-z0-9//cd;
  52 }
  53
  54 sub add {
  55     $data .=
  56         sprintf("%-16s%-12d0     0     100644  %-10d%c\n%s%s",
  57                 $_[0], time, length($_[1]), 0140, $_[1],
  58                 (length($_[1]) & 1) ? "\n" : "");
  59 }
  60
  61 while ($startat < $orgsize) {
  62     $dsp= "$myversion\n$package\n$version\n$csum\n$orgsize\n$partsize\n".
  63           "$showpartnum/$nparts\n";
  64     defined($thispartreallen= read(STDIN,$pd,$partsize)) || die "mksplit: read: $!\n";
  65     $data= "!<arch>\n";
  66     print("$showpartnum ");
  67     &add('debian-split',$dsp);
  68     &add("data.$showpartnum",$pd);
  69     if ($thispartreallen > $partsizeallow) {
  70         die "Header is too long, making part too long.  Your package name or version\n".
  71             "numbers must be extraordinarily long, or something.  Giving up.\n";
  72     }
  73     if ($msdos) {
  74         $basename= "${showpartnum}of$nparts.$cleanprefix";
  75         $basename= substr($basename,0,9);
  76         $basename =~ s/^([^.]*)\.(.*)$/$2$1/;
  77         $basename= "$prefixdir$basename";
  78     } else {
  79         $basename= "$prefix.${showpartnum}of$nparts";
  80     }
  81     open(O,"> $basename.deb") || die("mksplit: open $basename.deb: $!\n");
  82     print(O $data) || die("mksplit: write $basename.deb: $!\n");
  83     close(O) || die("mksplit: close $basename.deb: $!\n");
  84     $startat += $partsize;
  85     $showpartnum++;
  86 }
  87 print("done\n");
  88
  89 exit(0);