home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 4 / hacker04 / 04_HACK04.ISO / darwin / darwinx86.iso / usr / bin / dpkg-genchanges < prev    next >
Encoding:
Text File  |  2001-09-18  |  10.1 KB  |  302 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. require 'controllib.pl';
  12.  
  13. use POSIX;
  14. use POSIX qw(:errno_h :signal_h);
  15.  
  16. $controlfile= 'debian/control';
  17. $changelogfile= 'debian/changelog';
  18. $fileslistfile= 'debian/files';
  19. $varlistfile= 'debian/substvars';
  20. $uploadfilesdir= '..';
  21. $sourcestyle= 'i';
  22. $quiet= 0;
  23.  
  24. sub usageversion {
  25.     print STDERR
  26. "Debian GNU/Linux dpkg-genchanges $version.  Copyright (C) 1996
  27. Ian Jackson.  This is free software; see the GNU General Public Licence
  28. version 2 or later for copying conditions.  There is NO warranty.
  29.  
  30. Usage: dpkg-genchanges [options ...]
  31.  
  32. Options:  -b                     binary-only build - no source files
  33.           -B                     arch-specific - no source or arch-indep files
  34.           -c<controlfile>        get control info from this file
  35.           -l<changelogfile>      get per-version info from this file
  36.           -f<fileslistfile>      get .deb files list from this file
  37.           -v<sinceversion>       include all changes later than version
  38.           -C<changesdescription> use change description from this file
  39.           -m<maintainer>         override changelog's maintainer value
  40.           -u<uploadfilesdir>     directory with files (default is \`..')
  41.           -si (default)          src includes orig for debian-revision 0 or 1
  42.           -sa                    source includes orig src
  43.           -sd                    source is diff and .dsc only
  44.           -q                     quiet - no informational messages on stderr
  45.           -F<changelogformat>    force change log format
  46.           -V<name>=<value>       set a substitution variable
  47.           -T<varlistfile>        read variables here, not debian/substvars
  48.           -D<field>=<value>      override or add a field and value
  49.           -U<field>              remove a field
  50.           -h                     print this message
  51. ";
  52. }
  53.  
  54. $i=100;grep($fieldimps{$_}=$i--,
  55.           qw(Format Date Source Binary Architecture Version
  56.              Distribution Urgency Maintainer Description Changes Files));
  57.  
  58. while (@ARGV) {
  59.     $_=shift(@ARGV);
  60.     if (m/^-b$/) {
  61.         $binaryonly= 1;
  62.     } elsif (m/^-B$/) {
  63.     $archspecific=1;
  64.     $binaryonly= 1;
  65.     print STDERR "$progname: arch-specific upload - not including arch-independent packages\n";
  66.     } elsif (m/^-s([iad])$/) {
  67.         $sourcestyle= $1;
  68.     } elsif (m/^-q$/) {
  69.         $quiet= 1;
  70.     } elsif (m/^-c/) {
  71.         $controlfile= $';
  72.     } elsif (m/^-l/) {
  73.         $changelogfile= $';
  74.     } elsif (m/^-C/) {
  75.         $changesdescription= $';
  76.     } elsif (m/^-f/) {
  77.         $fileslistfile= $';
  78.     } elsif (m/^-v/) {
  79.         $since= $';
  80.     } elsif (m/^-T/) {
  81.         $varlistfile= $';
  82.     } elsif (m/^-m/) {
  83.         $forcemaint= $';
  84.     } elsif (m/^-F([0-9a-z]+)$/) {
  85.         $changelogformat=$1;
  86.     } elsif (m/^-D([^\=:]+)[=:]/) {
  87.         $override{$1}= $';
  88.     } elsif (m/^-u/) {
  89.         $uploadfilesdir= $';
  90.     } elsif (m/^-U([^\=:]+)$/) {
  91.         $remove{$1}= 1;
  92.     } elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
  93.         $substvar{$1}= $';
  94.     } elsif (m/^-h$/) {
  95.         &usageversion; exit(0);
  96.     } else {
  97.         &usageerr("unknown option \`$_'");
  98.     }
  99. }
  100.  
  101. &findarch;
  102. &parsechangelog;
  103. &parsecontrolfile;
  104.  
  105. $fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
  106. open(FL,"< $fileslistfile") || &syserr("cannot read files list file");
  107. while(<FL>) {
  108.     if (m/^(([-+.0-9a-z]+)_([^_]+)_(\w+)\.deb) (\S+) (\S+)$/) {
  109.         defined($p2f{"$2 $4"}) &&
  110.             &warn("duplicate files list entry for package $2 (line $.)");
  111.     $f2p{$1}= $2;
  112.         $p2f{"$2 $4"}= $1;
  113.         $p2f{$2}= $1;
  114.         $p2ver{$2}= $3;
  115.         defined($f2sec{$1}) &&
  116.             &warn("duplicate files list entry for file $1 (line $.)");
  117.         $f2sec{$1}= $5;
  118.         $f2pri{$1}= $6;
  119.         push(@fileslistfiles,$1);
  120.     } elsif (m/^([-+.,_0-9a-zA-Z]+) (\S+) (\S+)$/) {
  121.     defined($f2sec{$1}) &&
  122.             &warn("duplicate files list entry for file $1 (line $.)");
  123.         $f2sec{$1}= $2;
  124.         $f2pri{$1}= $3;
  125.         push(@fileslistfiles,$1);
  126.     } else {
  127.         &error("badly formed line in files list file, line $.");
  128.     }
  129. }
  130. close(FL);
  131.  
  132. for $_ (keys %fi) {
  133.     $v= $fi{$_};
  134.     if (s/^C //) {
  135. #print STDERR "G key >$_< value >$v<\n";
  136.     if (m/^Source$/) { &setsourcepackage; }
  137.     elsif (m/^Section$|^Priority$/) { $sourcedefault{$_}= $v; }
  138.     elsif (s/^X[BS]*C[BS]*-//i) { $f{$_}= $v; }
  139.     elsif (m/|^X[BS]+-|^Standards-Version$|^Maintainer$/i) { }
  140.     else { &unknown('general section of control info file'); }
  141.     } elsif (s/^C(\d+) //) {
  142. #print STDERR "P key >$_< value >$v<\n";
  143.     $i=$1; $p=$fi{"C$i Package"}; $a=$fi{"C$i Architecture"};
  144.     if (!defined($p2f{$p})) {
  145.         if (!$archspecific || $a eq $substvar{'Arch'}) {
  146.         &error("package $p in control file but not in files list");
  147.         }
  148.     } else {
  149.         $p2arch{$p}=$a;
  150.         $f=$p2f{$p};
  151.         if (m/^Description$/) {
  152.         $v=$` if $v =~ m/\n/;
  153.         push(@descriptions,sprintf("%-10s - %-.65s",$p,$v));
  154.         } elsif (m/^Section$/) {
  155.         $f2seccf{$f}= $v;
  156.         } elsif (m/^Priority$/) {
  157.         $f2pricf{$f}= $v;
  158.         } elsif (s/^X[BS]*C[BS]*-//i) {
  159.         $f{$_}= $v;
  160.         } elsif (m/^Architecture$/) {
  161.         $v= $arch if $v eq 'any';
  162.         push(@archvalues,$v) unless $archadded{$v}++;
  163.         } elsif (m/^(Package|Essential|Pre-Depends|Depends|Provides)$/ ||
  164.              m/^(Recommends|Suggests|Optional|Conflicts|Replaces)$/ ||
  165.              m/^X[CS]+-/i) {
  166.         } else {
  167.         &unknown("package's section of control info file");
  168.         }
  169.     }
  170.     } elsif (s/^L //) {
  171. #print STDERR "L key >$_< value >$v<\n";
  172.         if (m/^Source$/) {
  173.             &setsourcepackage;
  174.         } elsif (m/^(Version|Maintainer|Changes|Urgency|Distribution|Date)$/) {
  175.             $f{$_}= $v;
  176.         } elsif (s/^X[BS]*C[BS]*-//i) {
  177.             $f{$_}= $v;
  178.         } elsif (!m/^X[BS]+-/i) {
  179.             &unknown("parsed version of changelog");
  180.         }
  181.     } else {
  182.         &internerr("value from nowhere, with key >$_< and value >$v<");
  183.     }
  184. }
  185.  
  186. if ($changesdescription) {
  187.     $changesdescription="./$changesdescription" if $changesdescription =~ m/^\s/;
  188.     $f{'Changes'}= '';
  189.     open(X,"< $changesdescription") || &syserr("read changesdescription");
  190.     while(<X>) {
  191.         s/\s*\n$//;
  192.         $_= '.' unless m/\S/;
  193.         $f{'Changes'}.= "\n $_";
  194.     }
  195. }
  196.  
  197. for $p (keys %p2f) {
  198.     my ($pp, $aa) = (split / /, $p);
  199.     defined($p2i{"C $pp"}) ||
  200.         &warn("package $pp listed in files list but not in control info");
  201. }
  202.  
  203. for $p (keys %p2f) {
  204.     $f= $p2f{$p};
  205.     $sec= $f2seccf{$f}; $sec= $sourcedefault{'Section'} if !length($sec);
  206.     if (!length($sec)) { $sec='-'; &warn("missing Section for binary package $p; using '-'"); }
  207.     $sec eq $f2sec{$f} || &error("package $p has section $sec in control file".
  208.                                  " but $f2sec{$f} in files list");
  209.     $pri= $f2pricf{$f}; $pri= $sourcedefault{'Priority'} if !length($pri);
  210.     if (!length($pri)) { $pri='-'; &warn("missing Priority for binary package $p; using '-'"); }
  211.     $pri eq $f2pri{$f} || &error("package $p has priority $pri in control".
  212.                                  " file but $f2pri{$f} in files list");
  213. }
  214.  
  215. if (!$binaryonly) {
  216.     $version= $f{'Version'};
  217.     $origversion= $version; $origversion =~ s/-[^-]+$//;
  218.     $sec= $sourcedefault{'Section'};
  219.     if (!length($sec)) { $sec='-'; &warn("missing Section for source files"); }
  220.     $pri= $sourcedefault{'Priority'};
  221.     if (!length($pri)) { $pri='-'; &warn("missing Priority for source files"); }
  222.  
  223.     ($sversion = $version) =~ s/^\d+://;
  224.     $dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
  225.     open(CDATA,"< $dsc") || &error("cannot open .dsc file $dsc: $!");
  226.     push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
  227.     
  228.     &parsecdata('S',-1,"source control file $dsc");
  229.     $files= $fi{'S Files'};
  230.     for $file (split(/\n /,$files)) {
  231.         next if $file eq '';
  232.         $file =~ m/^([0-9a-f]{32})[ \t]+\d+[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_]+)$/
  233.             || &error("Files field contains bad line \`$file'");
  234.         ($md5sum{$2},$file) = ($1,$2);
  235.         push(@sourcefiles,$file);
  236.     }
  237.     for $f (@sourcefiles) { $f2sec{$f}= $sec; $f2pri{$f}= $pri; }
  238.     
  239.     if (($sourcestyle =~ m/i/ && $version !~ m/-[01]$/ ||
  240.          $sourcestyle =~ m/d/) &&
  241.         grep(m/\.diff\.gz$/,@sourcefiles)) {
  242.         $origsrcmsg= "not including original source code in upload";
  243.         @sourcefiles= grep(!m/\.orig\.tar\.gz$/,@sourcefiles);
  244.     } else {
  245.         $origsrcmsg= "including full source code in upload";
  246.     }
  247. } else {
  248.     $origsrcmsg= "binary-only upload - not including any source code";
  249. }
  250.  
  251. print(STDERR "$progname: $origsrcmsg\n") ||
  252.     &syserr("write original source message") unless $quiet;
  253.  
  254. $f{'Format'}= $substvar{'Format'};
  255.  
  256. if (!length($f{'Date'})) {
  257.     chop($date822=`822-date`); $? && subprocerr("822-date");
  258.     $f{'Date'}= $date822;
  259. }
  260.  
  261. $f{'Binary'}= join(' ',grep(s/C //,keys %p2i));
  262.  
  263. unshift(@archvalues,'source') unless $binaryonly;
  264. $f{'Architecture'}= join(' ',@archvalues);
  265.  
  266. $f{'Description'}= "\n ".join("\n ",sort @descriptions);
  267.  
  268. $f{'Files'}= '';
  269. for $f (@sourcefiles,@fileslistfiles) {
  270.     next if ($archspecific && ($p2arch{$f2p{$f}} eq 'all'));
  271.     next if $filedone{$f}++;
  272.     $uf= "$uploadfilesdir/$f";
  273.     open(STDIN,"< $uf") || &syserr("cannot open upload file $uf for reading");
  274.     (@s=stat(STDIN)) || &syserr("cannot fstat upload file $uf");
  275.     $size= $s[7]; $size || &warn("upload file $uf is empty");
  276.     $md5sum=`md5sum`; $? && subprocerr("md5sum upload file $uf");
  277.     $md5sum =~ m/^([0-9a-f]{32})\s*$/i ||
  278.         &failure("md5sum upload file $uf gave strange output \`$md5sum'");
  279.     $md5sum= $1;
  280.     defined($md5sum{$f}) && $md5sum{$f} ne $md5sum &&
  281.         &error("md5sum of source file $uf ($md5sum) is different from md5sum in $dsc".
  282.                " ($md5sum{$f})");
  283.     $f{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
  284. }    
  285.  
  286. $f{'Source'}= $sourcepackage;
  287.  
  288. $f{'Maintainer'}= $forcemaint if length($forcemaint);
  289.  
  290. for $f (qw(Version Distribution Maintainer Changes)) {
  291.     defined($f{$f}) || &error("missing information for critical output field $f");
  292. }
  293.  
  294. for $f (qw(Urgency)) {
  295.     defined($f{$f}) || &warn("missing information for output field $f");
  296. }
  297.  
  298. for $f (keys %override) { $f{&capit($f)}= $override{$f}; }
  299. for $f (keys %remove) { delete $f{&capit($f)}; }
  300.  
  301. &outputclose(0);
  302.