1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
|
#!/usr/bin/perl
#
# Look at what wrappers are needed, get rid of ones that arn't needed any more,
# and generate those that do not already exit. Uses dpkg-divert to keep dpkg
# from installing files over top of the wrappers.
# Configuration section
$histfile='/var/lib/xaw-wrappers/update-wrappers-history';
$wrapperfile='/usr/lib/xaw-wrappers/wrapper';
BEGIN { unshift @INC, "/usr/lib/xaw-wrappers/" }
# Print out the text if verbose.
sub Log {
print shift if $verbose;
}
# Purge a wrapper from the system.
sub RemoveWrapper { my $fn=shift;
if (-l $fn && unlink ($fn) eq 0) {
print "\t$fn: symlink unlink failed: $!\n";
$errorexit=1;
return;
}
my $ret=system "/usr/sbin/dpkg-divert","--quiet","--rename","--remove",$fn;
if (int($ret/256) ne 0) {
print "\t$fn: dpkg-divert failed\n";
$errorexit=1;
return;
}
Log "\t$fn\n";
}
# Add a wrapper to the system, and set up diversion.
sub AddWrapper { my $fn=shift;
# This should no longer happen, but I've left the fix in out of paranoia.
# --fixup makes us correct it.
if (-e $fn and ! -l $fn and -e "$fn.real" and $fixup) {
print "\n";
print "** $fn was doubled; fixing.\n";
print " The author of this program still doesn't understand how\n";
print " we got into this state. If you would, please contact\n";
print " <xaw-wrappers\@packages.debian.org>, and tell me you\n";
print " experienced this bug. If possible, provide a transcript of\n";
print " this dpkg run.\n";
print "[Press Return to continue]";
<>;
print "\n";
unlink "$fn.real";
}
my $ret=system "/usr/sbin/dpkg-divert","--package","xaw-wrappers","--add",
"--quiet","--rename","--divert","$fn.real","$fn";
if (int($ret/256) ne 0) {
print "\t$fn: dpkg-divert failed\n";
$errorexit=1;
return;
}
if (!-e $fn and ! -l $fn) {
if (symlink($wrapperfile,$fn) ne 1) {
print "\t$fn: symlink failed: $!\n";
$errorexit=1;
return;
}
}
elsif (!-l $fn) {
print "\t$fn: unable to symlink\n";
$errorexit=1;
return;
}
Log "\t$fn\n";
}
# Parse parameters.
use Getopt::Long;
$ret=&GetOptions(
"help|h", \$help,
"verbose|v", \$verbose,
"force|f", \$force,
"off|o", \$off,
"fixup",\$fixup,
);
# Usage help.
if ($help) {
print <<eof;
update-xaw-wrappers sets up wrapper scripts around programs that do not
work well with some xaw replacement libraries.
Usage: update-xaw-wrappers [options ...]
-h, --help Display this help text
-v, --verbose Be verbose about what changes are being made
-f, --force Force removal and reset up all wrappers
-o, --off Only remove exitsting wrappers, do not add new
eof
exit;
}
# Make sure I have root privs.
if ($> ne 0) {
print STDERR "$0 must be run as root.\n";
exit 1;
}
# Loading this package causes all config files to be read.
use XawWrapper;
Log "Updating xaw wrappers..\n";
# Load up the list of what wrappers existed when this was run last, and
# if any of those are not needed, get rid of them.
# The format of the history file is simply one filename per line.
Log "Removing wrappers:\n";
open (HISTORY,"<$histfile");
while (<HISTORY>) {
chomp;
if ($force || !defined($XawWrapper::files{$_})) {
RemoveWrapper($_);
}
}
close HISTORY;
# Create new wrappers, and write out the history file.
if (!$off) {
Log "Adding wrappers:\n";
open (HISTORY,">$histfile") || die "open $histfile: $!\n";
foreach $fn (keys(%XawWrapper::files)) {
print HISTORY "$fn\n";
AddWrapper($fn);
}
close HISTORY;
}
exit $errorexit if $errorexit;
|