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
|
#!/usr/bin/perl
# Perl version of Christoph Lameter's debpkg program.
# Written by Julian Gilbey, December 1998.
# Copyright 1999, Julian Gilbey
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
# All this program does is to check that it is either running as root
# or setuid root, and then exec dpkg with the command line options.
# As this may be running setuid, we make sure to clean out the
# environment before we go further. Also wise for building the
# packages, anyway. We don't put /usr/local/bin in the PATH as Debian
# programs will presumably be built without the use of any locally
# installed programs. This could be changed, but in which case,
# you probably want to add /usr/local/bin at the END so that you don't
# get any unexpected behaviour.
use 5.003;
use strict;
use warnings;
use File::Basename;
my $progname = basename($0);
# Predeclare functions
sub fatal($);
my $usage = "Usage: $progname --help|--version|dpkg-options\n";
my $version = <<"EOF";
This is $progname, from the Debian devscripts package, version ###VERSION###
This code is copyright 1999 by Julian Gilbey, all rights reserved.
Based on code by Christoph Lameter.
This program comes with ABSOLUTELY NO WARRANTY.
You are free to redistribute this code under the terms of the
GNU General Public License, version 2 or later.
EOF
##
## handle command-line options
##
if (!@ARGV) { print STDERR $usage; exit 1; }
if ($ARGV[0] eq '--help') { print $usage; exit 0; }
if ($ARGV[0] eq '--version') { print $version; exit 0; }
# We *do* preserve locale variables; dpkg should know how to handle
# them, and anyone running this with root privileges has total power
# over the system anyway, so doesn't really need to worry about forging
# locale data. We don't try to preserve TEXTDOMAIN and the like.
foreach my $var (keys %ENV) {
delete $ENV{$var}
unless $var =~ /^(PATH|TERM|HOME|LOGNAME|LANG)$/
or $var =~ /^LC_[A-Z]+$/;
}
$ENV{'PATH'} = "/usr/sbin:/usr/bin:/sbin:/bin:/usr/bin/X11";
# $ENV{'PATH'} = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/bin/X11";
$ENV{'TERM'} = 'dumb' unless defined $ENV{'TERM'};
# Pick up superuser privileges if we are running setuid root
if ($< != 0 && $> == 0) { $< = $>; }
fatal "debpkg is only useful if it is run by root or setuid root!"
if $< != 0;
# Pick up group 'root'
$( = $) = 0;
# @ARGV is tainted, so we need to untaint it. Don't bother doing any
# checking; anyone running this as root can do anything anyway.
my @clean_argv = map { /^(.*)$/ && $1; } @ARGV;
exec 'dpkg', @clean_argv or fatal "Couldn't exec dpkg: $!\n";
###### Subroutines
sub fatal($) {
my ($pack, $file, $line);
($pack, $file, $line) = caller();
(my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d;
$msg =~ s/\n\n$/\n/;
die $msg;
}
|
