home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Exec 2 / CD_Magazyn_EXEC_nr_2.iso / Linux / Archiwa / dpkg.tar.gz / dpkg-1.6.12_powerpc.nondebbin.tar / usr / sbin / dpkg-divert < prev    next >
Text File  |  2000-04-07  |  9KB  |  253 lines
  1. #! /usr/bin/perl --
  2.  
  3. #use POSIX; &ENOENT;
  4. sub ENOENT { 2; }
  5. # Sorry about this, but the errno-part of POSIX.pm isn't in perl-*-base
  6.  
  7. $version="1.6.12"; # This line modified by Makefile
  8. sub showversion {
  9.     print("Debian GNU/Linux dpkg-divert $version.\n") || &quit("failed to write version: $!");
  10. }
  11.  
  12. sub usage {
  13.     &showversion;
  14.     print(STDOUT <<END)
  15. Copyright (C) 1995 Ian Jackson.  This is free software; see the GNU General
  16. Public Licence version 2 or later for copying conditions. There is NO warranty.
  17.  
  18. Usage:
  19.  
  20.  dpkg-divert [options] [--add] <file>               - add a diversion
  21.  dpkg-divert [options] --remove <file>              - remove the diversion
  22.  dpkg-divert [options] --list [<glob-pattern>]      - show file diversions
  23.  
  24. Options: 
  25.     --package <package>        name of the package whose copy of <file>
  26.                                will not be diverted.
  27.     --local                    all packages' versions are diverted.
  28.     --divert <divert-to>       the name used by other packages' versions.
  29.     --rename                   actually move the file aside (or back).
  30.     --quiet                    quiet operation, minimal output
  31.     --test                     don't do anything, just demonstrate
  32.     --help                     print this help screen and exit
  33.     --version                  output version and exit
  34.     --admindir <directory>     set the directory with the diversions file
  35.  
  36. When adding, default is --local and --divert <original>.distrib.
  37. When removing, --package or --local and --divert must match if specified.
  38. Package preinst/postrm scripts should always specify --package and --divert.
  39. END
  40.         || &quit("failed to write usage: $!");
  41. }
  42.  
  43. $admindir= '/var/lib/dpkg';
  44. $testmode= 0;
  45. $dorename= 0;
  46. $verbose= 1;
  47. $mode='';
  48. $|=1;
  49.  
  50. sub checkmanymodes {
  51.     return unless $mode;
  52.     &badusage("two modes specified: $_ and --$mode");
  53. }
  54.  
  55. while (@ARGV) {
  56.     $_= shift(@ARGV);
  57.     last if m/^--$/;
  58.     if (!m/^-/) {
  59.         unshift(@ARGV,$_); last;
  60.     } elsif (m/^--help$/) {
  61.         &usage; exit(0);
  62.     } elsif (m/^--version$/) {
  63.         &showversion; exit(0);
  64.     } elsif (m/^--test$/) {
  65.         $testmode= 1;
  66.     } elsif (m/^--rename$/) {
  67.         $dorename= 1;
  68.     } elsif (m/^--quiet$/) {
  69.         $verbose= 0;
  70.     } elsif (m/^--local$/) {
  71.         $package= ':';
  72.     } elsif (m/^--add$/) {
  73.         &checkmanymodes;
  74.         $mode= 'add';
  75.     } elsif (m/^--remove$/) {
  76.         &checkmanymodes;
  77.         $mode= 'remove';
  78.     } elsif (m/^--list$/) {
  79.         &checkmanymodes;
  80.         $mode= 'list';
  81.     } elsif (m/^--divert$/) {
  82.         @ARGV || &badusage("--divert needs a divert-to argument");
  83.         $divertto= shift(@ARGV);
  84.         $divertto =~ m/\n/ && &badusage("divert-to may not contain newlines");
  85.     } elsif (m/^--package$/) {
  86.         @ARGV || &badusage("--package needs a package argument");
  87.         $package= shift(@ARGV);
  88.         $divertto =~ m/\n/ && &badusage("package may not contain newlines");
  89.     } elsif (m/^--admindir$/) {
  90.         @ARGV || &badusage("--admindir needs a directory argument");
  91.         $admindir= shift(@ARGV);
  92.     } else {
  93.         &badusage("unknown option \`$_'");
  94.     }
  95. }
  96.  
  97. $mode='add' unless $mode;
  98.  
  99. open(O,"$admindir/diversions") || &quit("cannot open diversions: $!");
  100. while(<O>) {
  101.     s/\n$//; push(@contest,$_);
  102.     $_=<O>; s/\n$// || &badfmt("missing altname");
  103.     push(@altname,$_);
  104.     $_=<O>; s/\n$// || &badfmt("missing package");
  105.     push(@package,$_);
  106. }
  107. close(O);
  108.  
  109. if ($mode eq 'add') {
  110.     @ARGV == 1 || &badusage("--add needs a single argument");
  111.     $file= $ARGV[0];
  112.     $file =~ m/\n/ && &badusage("file may not contain newlines");
  113.     -d $file && &badusage("Cannot divert directories");
  114.     $divertto= "$file.distrib" unless defined($divertto);
  115.     $package= ':' unless defined($package);
  116.     for ($i=0; $i<=$#contest; $i++) {
  117.         if ($contest[$i] eq $file || $altname[$i] eq $file ||
  118.             $contest[$i] eq $divertto || $altname[$i] eq $divertto) {
  119.             if ($contest[$i] eq $file && $altname[$i] eq $divertto &&
  120.                 $package[$i] eq $package) {
  121.                 print "Leaving \`",&infon($i),"'\n" if $verbose > 0;
  122.                 exit(0);
  123.             }
  124.             &quit("\`".&infoa."' clashes with \`".&infon($i)."'");
  125.         }
  126.     }
  127.     push(@contest,$file);
  128.     push(@altname,$divertto);
  129.     push(@package,$package);
  130.     print "Adding \`",&infon($#contest),"'\n" if $verbose > 0;
  131.     &checkrename($file,$divertto);
  132.     &save;
  133.     &dorename($file,$divertto);
  134.     exit(0);
  135. } elsif ($mode eq 'remove') {
  136.     @ARGV == 1 || &badusage("--remove needs a single argument");
  137.     $file= $ARGV[0];
  138.     for ($i=0; $i<=$#contest; $i++) {
  139.         next unless $file eq $contest[$i];
  140.         &quit("mismatch on divert-to\n  when removing \`".&infoa."'\n  found \`".
  141.               &infon($i)."'") if defined($divertto) && $altname[$i] ne $divertto;
  142.         &quit("mismatch on package\n  when removing \`".&infoa."'\n  found \`".
  143.               &infon($i)."'") if defined($package) && $package[$i] ne $package;
  144.         print "Removing \`",&infon($i),"'\n" if $verbose > 0;
  145.         $orgfile= $contest[$i];
  146.         $orgdivertto= $altname[$i];
  147.         @contest= (($i > 0 ? @contest[0..$i-1] : ()),
  148.                    ($i < $#contest ? @contest[$i+1..$#contest] : ()));
  149.         @altname= (($i > 0 ? @altname[0..$i-1] : ()),
  150.                    ($i < $#altname ? @altname[$i+1..$#altname] : ()));
  151.         @package= (($i > 0 ? @package[0..$i-1] : ()),
  152.                    ($i < $#package ? @package[$i+1..$#package] : ()));
  153.         &checkrename($orgdivertto,$orgfile);
  154.         &dorename($orgdivertto,$orgfile);
  155.         &save;
  156.         exit(0);
  157.     }
  158.     print "No diversion \`",&infoa,"', none removed\n" if $verbose > 0;
  159.     exit(0);
  160. } elsif ($mode eq 'list') {
  161.     @ilist= @ARGV ? @ARGV : ('*');
  162.     while (defined($_=shift(@ilist))) {
  163.         s/\W/\\$&/g;
  164.         s/\\\?/./g;
  165.         s/\\\*/.*/g;
  166.         push(@list,"^$_\$");
  167.     }
  168.     $pat= join('$|^',@list);
  169.     for ($i=0; $i<=$#contest; $i++) {
  170.         next unless ($contest[$i] =~ m/$pat/o ||
  171.                      $altname[$i] =~ m/$pat/o ||
  172.                      $package[$i] =~ m/$pat/o);
  173.         print &infon($i),"\n";
  174.     }
  175.     exit(0);
  176. } else {
  177.     &quit("internal error - bad mode \`$mode'");
  178. }
  179.  
  180. sub infol {
  181.     return (($_[2] eq ':' ? "local " : length($_[2]) ? "" : "any ").
  182.             "diversion of $_[0]".
  183.             (length($_[1]) ? " to $_[1]" : "").
  184.             (length($_[2]) && $_[2] ne ':' ? " by $_[2]" : ""));
  185. }
  186.  
  187. sub checkrename {
  188.     return unless $dorename;
  189.     ($rsrc,$rdest) = @_;
  190.     (@ssrc= lstat($rsrc)) || $! == &ENOENT ||
  191.         &quit("cannot stat old name \`$rsrc': $!");
  192.     (@sdest= lstat($rdest)) || $! == &ENOENT ||
  193.         &quit("cannot stat new name \`$rdest': $!");
  194.     # Unfortunately we have to check for write access in both
  195.     # places, just having +w is not enough, since people do
  196.     # mount things RO, and we need to fail before we start
  197.     # mucking around with things. So we open a file with the
  198.     # same name as the diversions but with an extension that
  199.     # (hopefully) wont overwrite anything. If it succeeds, we
  200.     # assume a writable filesystem.
  201.     foreach $file ($rsrc,$rdest) {
  202.     open (TMP, ">> ${file}.dpkg-devert.tmp") || $! == NOENT ||
  203.         &quit("error checking \`$file': $!");
  204.     close TMP;
  205.     if ($1 == ENOENT) {
  206.         $dorename = 0;
  207.     } else {
  208.         unlink ("${file}.dpkg-devert.tmp");
  209.     }
  210.     }
  211.     if (@ssrc && @sdest &&
  212.         !($ssrc[0] == $sdest[0] && $ssrc[1] == $sdest[1])) {
  213.         &quit("rename involves overwriting \`$rdest' with\n".
  214.               "  different file \`$rsrc', not allowed");
  215.     }
  216. }
  217.  
  218. sub dorename {
  219.     return unless $dorename;
  220.     return if $testmode;
  221.     if (@ssrc) {
  222.         if (@sdest) {
  223.             unlink($rsrc) || &quit("rename: remove duplicate old link \`$rsrc': $!");
  224.         } else {
  225.             rename($rsrc,$rdest) || &quit("rename: rename \`$rsrc' to \`$rdest': $!");
  226.         }
  227.     }
  228. }            
  229.     
  230. sub save {
  231.     return if $testmode;
  232.     open(N,"> $admindir/diversions-new") || &quit("create diversions-new: $!");
  233.     chmod 0644, "$admindir/diversions-new";
  234.     for ($i=0; $i<=$#contest; $i++) {
  235.         print(N "$contest[$i]\n$altname[$i]\n$package[$i]\n")
  236.             || &quit("write diversions-new: $!");
  237.     }
  238.     close(N) || &quit("close diversions-new: $!");
  239.     unlink("$admindir/diversions-old") ||
  240.         $! == &ENOENT || &quit("remove old diversions-old: $!");
  241.     link("$admindir/diversions","$admindir/diversions-old") ||
  242.         $! == &ENOENT || &quit("create new diversions-old: $!");
  243.     rename("$admindir/diversions-new","$admindir/diversions")
  244.         || &quit("install new diversions: $!");
  245. }
  246.  
  247. sub infoa { &infol($file,$divertto,$package); }
  248. sub infon { &infol($contest[$i],$altname[$i],$package[$i]); }
  249.  
  250. sub quit { print STDERR "dpkg-divert: @_\n"; exit(2); }
  251. sub badusage { print STDERR "dpkg-divert: @_\n\n"; print("You need --help.\n"); exit(2); }
  252. sub badfmt { &quit("internal error: $admindir/diversions corrupt: $_[0]"); }
  253.