home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 4 / hacker04 / 04_HACK04.ISO / darwin / darwinx86.iso / usr / bin / dpkg-gencontrol < prev    next >
Encoding:
Text File  |  2001-09-18  |  8.3 KB  |  252 lines
  1. #! /usr/bin/perl
  2.  
  3. my $dpkglibdir, $version;
  4.  
  5. BEGIN { 
  6.     $dpkglibdir="/usr/share/dpkg";
  7.     $version=""; # This line modified by Makefile
  8.     push (@INC, $dpkglibdir); 
  9. }
  10.  
  11. use POSIX;
  12. #use POSIX qw(:errno_h);
  13.  
  14. require 'controllib.pl';
  15.  
  16. $controlfile= 'debian/control';
  17. $changelogfile= 'debian/changelog';
  18. $fileslistfile= 'debian/files';
  19. $varlistfile= 'debian/substvars';
  20. $packagebuilddir= 'debian/tmp';
  21.  
  22. sub usageversion {
  23.     print STDERR
  24. "Debian GNU/Linux dpkg-gencontrol $version.  Copyright (C) 1996
  25. Ian Jackson.  This is free software; see the GNU General Public Licence
  26. version 2 or later for copying conditions.  There is NO warranty.
  27.  
  28. Usage: dpkg-gencontrol [options ...]
  29.  
  30. Options:  -p<package>            print control file for package
  31.           -c<controlfile>        get control info from this file
  32.           -l<changelogfile>      get per-version info from this file
  33.           -F<changelogformat>    force change log format
  34.           -v<forceversion>       set version of binary package
  35.           -f<fileslistfile>      write files here instead of debian/files
  36.           -P<packagebuilddir>    temporary build dir instead of debian/tmp
  37.           -O                     write to stdout, not .../DEBIAN/control
  38.           -is                    include section field
  39.           -ip                    include priority field
  40.           -isp|-ips              include both section and priority
  41.           -D<field>=<value>      override or add a field and value
  42.           -U<field>              remove a field
  43.           -V<name>=<value>       set a substitution variable
  44.           -T<varlistfile>        read variables here, not debian/substvars
  45.           -h                     print this message
  46. ";
  47. }
  48.  
  49. $i=100;grep($fieldimps{$_}=$i--,
  50.           qw(Package Version Section Priority Architecture Essential
  51.              Pre-Depends Depends Recommends Suggests Optional Conflicts Replaces
  52.              Provides Installed-Size Maintainer Source Description));
  53.  
  54. while (@ARGV) {
  55.     $_=shift(@ARGV);
  56.     if (m/^-p([-+0-9a-z.]+)$/) {
  57.         $oppackage= $1;
  58.     } elsif (m/^-c/) {
  59.         $controlfile= $';
  60.     } elsif (m/^-l/) {
  61.         $changelogfile= $';
  62.     } elsif (m/^-P/) {
  63.         $packagebuilddir= $';
  64.     } elsif (m/^-f/) {
  65.         $fileslistfile= $';
  66.     } elsif (m/^-v(.+)$/) {
  67.         $forceversion= $1;
  68.     } elsif (m/^-O$/) {
  69.         $stdout= 1;
  70.     } elsif (m/^-is$/) {
  71.         $spinclude{'Section'}=1;
  72.     } elsif (m/^-ip$/) {
  73.         $spinclude{'Priority'}=1;
  74.     } elsif (m/^-isp$/ || m/^-ips$/) {
  75.         $spinclude{'Section'}=1;
  76.         $spinclude{'Priority'}=1;
  77.     } elsif (m/^-F([0-9a-z]+)$/) {
  78.         $changelogformat=$1;
  79.     } elsif (m/^-D([^\=:]+)[=:]/) {
  80.         $override{$1}= $';
  81.     } elsif (m/^-U([^\=:]+)$/) {
  82.         $remove{$1}= 1;
  83.     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
  84.         $substvar{$1}= $';
  85.     } elsif (m/^-T/) {
  86.         $varlistfile= $';
  87.     } elsif (m/^-h$/) {
  88.         &usageversion; exit(0);
  89.     } else {
  90.         &usageerr("unknown option \`$_'");
  91.     }
  92. }
  93.  
  94. $arch = $override{Architecture} or do {
  95.        $arch=`dpkg --print-architecture`;
  96.        $? && &subprocerr("dpkg --print-architecture");
  97. };
  98. $arch =~ s/\n$//;
  99.  
  100. &parsechangelog;
  101. &parsecontrolfile;
  102.             
  103. if (length($oppackage)) {
  104.     defined($p2i{"C $oppackage"}) || &error("package $oppackage not in control info");
  105.     $myindex= $p2i{"C $oppackage"};
  106. } else {
  107.     @packages= grep(m/^C /,keys %p2i);
  108.     @packages==1 ||
  109.         &error("must specify package since control info has many (@packages)");
  110.     $myindex=1;
  111. }
  112.  
  113. #print STDERR "myindex $myindex\n";
  114.  
  115. for $_ (keys %fi) {
  116.     $v= $fi{$_};
  117.     if (s/^C //) {
  118. #print STDERR "G key >$_< value >$v<\n";
  119.         if (m/^Maintainer$/) { $f{$_}=$v; }
  120.         elsif (m/^Source$/) { &setsourcepackage; }
  121.         elsif (s/^X[CS]*B[CS]*-//i) { $f{$_}= $v; }
  122.         elsif (m/^X[CS]+-|^Standards-Version$/i) { }
  123.         elsif (m/^Section$|^Priority$/) { $spdefault{$_}= $v; }
  124.         else { &unknown('general section of control info file'); }
  125.     } elsif (s/^C$myindex //) {
  126. #print STDERR "P key >$_< value >$v<\n";
  127.         if (m/^(Package|Description|Essential|Pre-Depends|Depends)$/ ||
  128.             m/^(Recommends|Suggests|Optional|Conflicts|Provides|Replaces)$/) {
  129.             $f{$_}= $v;
  130.         } elsif (m/^Section$|^Priority$/) {
  131.             $spvalue{$_}= $v;
  132.         } elsif (m/^Architecture$/) {
  133.             if ($v eq 'all') {
  134.                 $f{$_}= $v;
  135.             } elsif ($v eq 'any') {
  136.                 $f{$_}= $arch;
  137.             } else {
  138.                 @archlist= split(/\s+/,$v);
  139.                 grep($arch eq $_, @archlist) ||
  140.                     &error("current build architecture $arch does not".
  141.                            " appear in package's list (@archlist)");
  142.                 $f{$_}= $arch;
  143.             }
  144.         } elsif (s/^X[CS]*B[CS]*-//i) {
  145.             $f{$_}= $v;
  146.         } elsif (!m/^X[CS]+-/i) {
  147.             &unknown("package's section of control info file");
  148.         }
  149.     } elsif (m/^C\d+ /) {
  150. #print STDERR "X key >$_< value not shown<\n";
  151.     } elsif (s/^L //) {
  152. #print STDERR "L key >$_< value >$v<\n";
  153.         if (m/^Source$/) {
  154.             &setsourcepackage;
  155.         } elsif (m/^Version$/) {
  156.             $sourceversion= $v;
  157.             $f{$_}= $v unless length($forceversion);
  158.         } elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date)$/) {
  159.         } elsif (s/^X[CS]*B[CS]*-//i) {
  160.             $f{$_}= $v;
  161.         } elsif (!m/^X[CS]+-/i) {
  162.             &unknown("parsed version of changelog");
  163.         }
  164.     } else {
  165.         &internerr("value from nowhere, with key >$_< and value >$v<");
  166.     }
  167. }
  168.  
  169. $f{'Version'}= $forceversion if length($forceversion);
  170.  
  171. for $f (qw(Section Priority)) {
  172.     $spvalue{$f}= $spdefault{$f} unless length($spvalue{$f});
  173.     $f{$f}= $spvalue{$f} if $spinclude{$f} && length($spvalue{$f});
  174. }
  175.  
  176. for $f (qw(Package Version)) {
  177.     defined($f{$f}) || &error("missing information for output field $f");
  178. }
  179. for $f (qw(Maintainer Description Architecture)) {
  180.     defined($f{$f}) || &warn("missing information for output field $f");
  181. }
  182. $oppackage= $f{'Package'};
  183.  
  184. $verdiff= $f{'Version'} ne $sourceversion;
  185. if ($oppackage ne $sourcepackage || $verdiff) {
  186.     $f{'Source'}= $sourcepackage;
  187.     $f{'Source'}.= " ($sourceversion)" if $verdiff;
  188. }
  189.  
  190. if (!defined($substvar{'Installed-Size'})) {
  191.     defined($c= open(DU,"-|")) || &syserr("fork for du");
  192.     if (!$c) {
  193.         chdir("$packagebuilddir") || &syserr("chdir for du to \`$packagebuilddir'");
  194.         exec("du","-k","-s","."); &syserr("exec du");
  195.     }
  196.     $duo=''; while (<DU>) { $duo.=$_; }
  197.     close(DU); $? && &subprocerr("du in \`$packagebuilddir'");
  198.     $duo =~ m/^(\d+)\s+\.$/ || &failure("du gave unexpected output \`$duo'");
  199.     $substvar{'Installed-Size'}= $1;
  200. }
  201. if (defined($substvar{'Extra-Size'})) {
  202.     $substvar{'Installed-Size'} += $substvar{'Extra-Size'};
  203. }
  204. if (length($substvar{'Installed-Size'})) {
  205.     $f{'Installed-Size'}= $substvar{'Installed-Size'};
  206. }
  207.  
  208. $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
  209. open(Y,"> $fileslistfile.new") || &syserr("open new files list file");
  210. my (@fowner) = &getfowner ();
  211. chown (@fowner, "$fileslistfile.new") 
  212.         || &syserr ("chown new files list file");
  213. if (open(X,"< $fileslistfile")) {
  214.     while (<X>) {
  215.         s/\n$//;
  216.         next if m/^([-+0-9a-z.]+)_[^_]+_(\w+)\.deb /
  217.                 && ($1 eq $oppackage) && ($2 eq $arch);
  218.        print(Y "$_\n") || &syserr("copy old entry to new files list file");
  219.     }
  220.     close(X) || &syserr("close old files list file");
  221. } elsif ($! != ENOENT) {
  222.     &syserr("read old files list file");
  223. }
  224. $sversion=$f{'Version'};
  225. $sversion =~ s/^\d+://;
  226. print(Y &substvars(sprintf("%s_%s_%s.deb %s %s\n",
  227.                            $oppackage,$sversion,$f{'Architecture'},
  228.                            &spfileslistvalue('Section'), &spfileslistvalue('Priority'))))
  229.     || &syserr("write new entry to new files list file");
  230. close(Y) || &syserr("close new files list file");
  231. rename("$fileslistfile.new",$fileslistfile) || &syserr("install new files list file");
  232.  
  233. for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
  234. for $f (keys %remove) { delete $f{&capit($f)}; }
  235.  
  236. if (!$stdout) {
  237.     $cf= "$packagebuilddir/DEBIAN/control";
  238.     $cf= "./$cf" if $cf =~ m/^\s/;
  239.     open(STDOUT,"> $cf.new") ||
  240.         &syserr("cannot open new output control file \`$cf.new'");
  241. }
  242. &outputclose(1);
  243. if (!$stdout) {
  244.     rename("$cf.new","$cf") || &syserr("cannot install output control file \`$cf'");
  245. }
  246.  
  247. sub spfileslistvalue {
  248.     $r= $spvalue{$_[0]};
  249.     $r= '-' if !length($r);
  250.     return $r;
  251. }
  252.