Contents of /trunk/src/debconf/debconf-apt-progress

#!/usr/bin/perl -w

=head1 NAME

debconf-apt-progress - install packages using debconf to display a progress bar

=head1 SYNOPSIS

 debconf-apt-progress [--] command [args ...]
 debconf-apt-progress --config
 debconf-apt-progress --start
 debconf-apt-progress --from waypoint --to waypoint [--] command [args ...]
 debconf-apt-progress --stop

=head1 DESCRIPTION

B<debconf-apt-progress> installs packages using debconf to display a
progress bar. The given I<command> should be any command-line apt frontend;
specifically, it must send progress information to the file descriptor
selected by the C<APT::Status-Fd> configuration option, and must keep the
file descriptors nominated by the C<APT::Keep-Fds> configuration option open
when invoking debconf (directly or indirectly), as those file descriptors
will be used for the debconf passthrough protocol.

The arguments to the command you supply should generally include B<-y> (for
B<apt-get> or B<aptitude>) or similar to avoid the apt frontend prompting
for input. B<debconf-apt-progress> cannot do this itself because the
appropriate argument may differ between apt frontends.

The B<--start>, B<--stop>, B<--from>, and B<--to> options may be used to
create a progress bar with multiple segments for different stages of
installation, provided that the caller is a debconf confmodule. The caller
may also interact with the progress bar itself using the debconf protocol if
it so desires.

debconf locks its config database when it starts up, which makes it
unfortunately inconvenient to have one instance of debconf displaying the
progress bar and another passing through questions from packages being
installed. If you're using a multiple-segment progress bar, you'll need to
eval the output of the B<--config> option before starting the debconf
frontend to work around this. See L<the EXAMPLES section/EXAMPLES> below.

=head1 OPTIONS

=over 4

=item B<--config>

Print environment variables necessary to start up a progress bar frontend.

=item B<--start>

Start up a progress bar, running from 0 to 100 by default. Use B<--from> and
B<--to> to use other endpoints.

=item B<--from> I<waypoint>

If used with B<--start>, make the progress bar begin at I<waypoint> rather
than 0.

Otherwise, install packages with their progress bar beginning at this
"waypoint". Must be used with B<--to>.

=item B<--to> I<waypoint>

If used with B<--start>, make the progress bar end at I<waypoint> rather
than 100.

Otherwise, install packages with their progress bar ending at this
"waypoint". Must be used with B<--from>.

=item B<--stop>

Stop a running progress bar.

=item B<--no-progress>

Avoid starting, stopping, or stepping the progress bar. Progress
messages from apt, media change events, and debconf questions will still
be passed through to debconf.

=item B<--dlwaypoint> I<percentage>

Specify what percent of the progress bar to use for downloading packages.
The remainder will be used for installing packages. The default is to use
15% for downloading and the remaining 85% for installing.

=item B<--logfile> I<file>

Send the normal output from apt to the given file.

=item B<--logstderr>

Send the normal output from apt to stderr. If you supply neither
B<--logfile> nor B<--logstderr>, the normal output from apt will be
discarded.

=item B<-->

Terminate options. Since you will normally need to give at least the B<-y>
argument to the command being run, you will usually need to use B<--> to
prevent that being interpreted as an option to B<debconf-apt-progress>
itself.

=back

=head1 EXAMPLES

Install the GNOME desktop and an X window system development environment
within a progress bar:

 debconf-apt-progress -- aptitude -y install gnome x-window-system-dev

Install the GNOME, KDE, and XFCE desktops within a single progress bar,
allocating 45% of the progress bar for each of GNOME and KDE and the
remaining 10% for XFCE:

 #! /bin/sh
 set -e
 case $1 in
   '')
     eval "$(debconf-apt-progress --config)"
     "$0" debconf
     ;;
   debconf)
     . /usr/share/debconf/confmodule
     debconf-apt-progress --start
     debconf-apt-progress --from 0 --to 45 -- apt-get -y install gnome
     debconf-apt-progress --from 45 --to 90 -- apt-get -y install kde
     debconf-apt-progress --from 90 --to 100 -- apt-get -y install xfce4
     debconf-apt-progress --stop
     ;;
 esac

=head1 RETURN CODE

The exit code of the specified command is returned, unless the user hit the
cancel button on the progress bar. If the cancel button was hit, a value of
30 is returned. To avoid ambiguity, if the command returned 30, a value of
3 will be returned.

=cut

use strict;
use POSIX;
use Fcntl;
use Getopt::Long;
# Avoid starting the debconf frontend just yet.
use Debconf::Client::ConfModule ();

my ($config, $start, $from, $to, $stop);
my $progress=1;
my $dlwaypoint=15;
my ($logfile, $logstderr);

sub checkopen (@) {
        my $file = $_[0];
        my $fd = POSIX::open($file, &POSIX::O_RDONLY);
        defined $fd or die "$0: can't open $_[0]: $!\n";
        return $fd;
}

sub checkclose ($) {
        my $fd = $_[0];
        unless (POSIX::close($fd)) {
                return if $! == &POSIX::EBADF;
                die "$0: can't close fd $fd: $!\n";
        }
}

sub checkdup2 ($$) {
        my ($oldfd, $newfd) = @_;
        checkclose($newfd);
        POSIX::dup2($oldfd, $newfd)
                or die "$0: can't dup fd $oldfd to $newfd: $!\n";
}

sub nocloexec (*) {
        my $fh = shift;
        my $flags = fcntl($fh, F_GETFD, 0);
        fcntl($fh, F_SETFD, $flags & ~FD_CLOEXEC);
}

sub nonblock (*) {
        my $fh = shift;
        my $flags = fcntl($fh, F_GETFL, 0);
        fcntl($fh, F_SETFL, $flags | O_NONBLOCK);
}

# Open the given file descriptors to make sure they won't accidentally be
# used by Perl, leading to confusion.
sub reservefds (@) {
        my $null = checkopen('/dev/null');
        my $close = 1;
        for my $fd (@_) {
                if ($null == $fd) {
                        $close = 0;
                } else {
                        checkclose($fd);
                        checkdup2($null, $fd);
                }
        }
        if ($close) {
                checkclose($null);
        }
}

# Does this environment variable exist, and is it non-empty?
sub envnonempty ($) {
        my $name = shift;
        return (exists $ENV{$name} and $ENV{$name} ne '');
}

sub start_debconf (@) {
        if (! $ENV{DEBIAN_HAS_FRONTEND}) {
                # Save existing environment variables.
                if (envnonempty('DEBCONF_DB_REPLACE')) {
                        $ENV{DEBCONF_APT_PROGRESS_DB_REPLACE} =
                                $ENV{DEBCONF_DB_REPLACE};
                }
                if (envnonempty('DEBCONF_DB_OVERRIDE')) {
                        $ENV{DEBCONF_APT_PROGRESS_DB_OVERRIDE} =
                                $ENV{DEBCONF_DB_OVERRIDE};
                }

                # Make sure the main configdb is opened read-only ...
                $ENV{DEBCONF_DB_REPLACE} = 'configdb';
                # ... and stack a writable db on top of it, since the
                # passthrough instance is going to be sending us db updates.
                $ENV{DEBCONF_DB_OVERRIDE} = 'Pipe{infd:none outfd:none}';

                delete $ENV{DEBCONF_APT_PROGRESS_HAD_FRONTEND};

                # Restore @ARGV so that
                # Debconf::Client::ConfModule::import() can use it.
                @ARGV = @_;
        } else {
                # Leave a note for ourselves.
                $ENV{DEBCONF_APT_PROGRESS_HAD_FRONTEND} = 1;
        }

        import Debconf::Client::ConfModule;
}

sub passthrough (@) {
        my $priority = Debconf::Client::ConfModule::get('debconf/priority');

        defined(my $pid = fork) or die "$0: can't fork: $!\n";
        if (!$pid) {
                close STATUS_READ;
                close COMMAND_WRITE;
                close DEBCONF_COMMAND_READ;
                close DEBCONF_REPLY_WRITE;
                $^F = 6; # avoid close-on-exec
                if (fileno(COMMAND_READ) != 0) {
                        checkdup2(fileno(COMMAND_READ), 0);
                        close COMMAND_READ;
                }
                if (fileno(APT_LOG) != 1) {
                        checkclose(1);
                        checkdup2(fileno(APT_LOG), 1);
                }
                if (fileno(APT_LOG) != 2) {
                        checkclose(2);
                        checkdup2(fileno(APT_LOG), 2);
                }
                close APT_LOG;
                delete $ENV{DEBIAN_HAS_FRONTEND};
                delete $ENV{DEBCONF_REDIR};
                delete $ENV{DEBCONF_SYSTEMRC};
                delete $ENV{DEBCONF_PIPE}; # just in case ...
                $ENV{DEBIAN_FRONTEND} = 'passthrough';
                $ENV{DEBIAN_PRIORITY} = $priority;
                $ENV{DEBCONF_READFD} = 5;
                $ENV{DEBCONF_WRITEFD} = 6;
                $ENV{APT_LISTCHANGES_FRONTEND} = 'none';
                exec @_;
        }

        close STATUS_WRITE;
        close COMMAND_READ;
        close DEBCONF_COMMAND_WRITE;
        close DEBCONF_REPLY_READ;
        return $pid;
}

sub handle_status ($$$) {
        my ($from, $to, $line) = @_;
        my ($status, $pkg, $percent, $description) = split ':', $line, 4;

        my ($min, $len);
        if ($status eq 'dlstatus') {
                $min = 0;
                $len = $dlwaypoint;
        }
        elsif ($status eq 'pmstatus') {
                $min = $dlwaypoint;
                $len = 100 - $dlwaypoint;
        }
        elsif ($status eq 'media-change') {
                Debconf::Client::ConfModule::subst(
                        'debconf-apt-progress/media-change', 'MESSAGE',
                        $description);
                my @ret = Debconf::Client::ConfModule::input(
                        'critical', 'debconf-apt-progress/media-change');
                $ret[0] == 0 or die "Can't display media change request!\n";
                Debconf::Client::ConfModule::go();
                print COMMAND_WRITE "\n" || die "can't talk to command fd: $!";
                return;
        }
        else {
                return;
        }

        $percent = ($percent * $len / 100 + $min);
        $percent = ($percent * ($to - $from) / 100 + $from);
        $percent =~ s/\..*//;
        if ($progress) {
                my @ret=Debconf::Client::ConfModule::progress('SET', $percent);
                if ($ret[0] eq '30') {
                        cancel();
                }
        }
        Debconf::Client::ConfModule::subst(
                'debconf-apt-progress/info', 'DESCRIPTION', $description);
        my @ret=Debconf::Client::ConfModule::progress(
                'INFO', 'debconf-apt-progress/info');
        if ($ret[0] eq '30') {
                cancel();
        }
}

sub handle_debconf_command ($) {
        my $line = shift;

        # Debconf::Client::ConfModule has already dealt with checking
        # DEBCONF_REDIR.
        print "$line\n" || die "can't write to stdout: $!";
        my $ret = <STDIN>;
        chomp $ret;
        print DEBCONF_REPLY_WRITE "$ret\n" ||
                die "can't write to DEBCONF_REPLY_WRITE: $!";
}

my $pid;
sub run_progress ($$@) {
        my $from = shift;
        my $to = shift;
        my $command = shift;
        local (*STATUS_READ, *STATUS_WRITE);
        local (*COMMAND_READ, *COMMAND_WRITE);
        local (*DEBCONF_COMMAND_READ, *DEBCONF_COMMAND_WRITE);
        local (*DEBCONF_REPLY_READ, *DEBCONF_REPLY_WRITE);
        local *APT_LOG;
        use IO::Handle;

        if ($progress) {
                my @ret=Debconf::Client::ConfModule::progress(
                        'INFO', 'debconf-apt-progress/preparing');
                if ($ret[0] eq '30') {
                        cancel();
                }
        }

        reservefds(4, 5, 6);

        pipe STATUS_READ, STATUS_WRITE
                or die "$0: can't create status pipe: $!";
        nonblock(\*STATUS_READ);
        checkdup2(fileno(STATUS_WRITE), 4);
        open STATUS_WRITE, '>&=4'
                or die "$0: can't reopen STATUS_WRITE as fd 4: $!";
        nocloexec(\*STATUS_WRITE);

        pipe COMMAND_READ, COMMAND_WRITE
                or die "$0: can't create command pipe: $!";
        nocloexec(\*COMMAND_READ);
        COMMAND_WRITE->autoflush(1);

        pipe DEBCONF_COMMAND_READ, DEBCONF_COMMAND_WRITE
                or die "$0: can't create debconf command pipe: $!";
        nonblock(\*DEBCONF_COMMAND_READ);
        checkdup2(fileno(DEBCONF_COMMAND_WRITE), 6);
        open DEBCONF_COMMAND_WRITE, '>&=6'
                or die "$0: can't reopen DEBCONF_COMMAND_WRITE as fd 6: $!";
        nocloexec(\*DEBCONF_COMMAND_WRITE);

        pipe DEBCONF_REPLY_READ, DEBCONF_REPLY_WRITE
                or die "$0: can't create debconf reply pipe: $!";
        checkdup2(fileno(DEBCONF_REPLY_READ), 5);
        open DEBCONF_REPLY_READ, '<&=5'
                or die "$0: can't reopen DEBCONF_REPLY_READ as fd 5: $!";
        nocloexec(\*DEBCONF_REPLY_READ);
        DEBCONF_REPLY_WRITE->autoflush(1);

        if (defined $logfile) {
                open APT_LOG, '>>', $logfile
                        or die "$0: can't open $logfile: $!";
        } elsif ($logstderr) {
                open APT_LOG, '>&STDERR'
                        or die "$0: can't duplicate stderr: $!";
        } else {
                open APT_LOG, '>', '/dev/null'
                        or die "$0: can't open /dev/null: $!";
        }
        nocloexec(\*APT_LOG);

        $pid = passthrough $command,
                '-o', 'APT::Status-Fd=4',
                '-o', 'APT::Keep-Fds::=5',
                '-o', 'APT::Keep-Fds::=6',
                @_;

        my $status_eof = 0;
        my $debconf_command_eof = 0;
        my $status_buf = '';
        my $debconf_command_buf = '';

        # STATUS_READ should be the last fd to close. DEBCONF_COMMAND_WRITE
        # may end up captured by buggy daemons, so terminate the loop even
        # if we haven't hit $debconf_command_eof.
        while (not $status_eof) {
                my $rin = '';
                my $rout;
                vec($rin, fileno(STATUS_READ), 1) = 1;
                vec($rin, fileno(DEBCONF_COMMAND_READ), 1) = 1
                        unless $debconf_command_eof;
                my $sel = select($rout = $rin, undef, undef, undef);
                if ($sel < 0) {
                        next if $! == &POSIX::EINTR;
                        die "$0: select failed: $!";
                }

                if (vec($rout, fileno(STATUS_READ), 1) == 1) {
                        # Status message from apt. Transform into debconf
                        # messages.
                        while (1) {
                                my $r = sysread(STATUS_READ, $status_buf, 4096,
                                                length $status_buf);
                                if (not defined $r) {
                                        next if $! == &POSIX::EINTR;
                                        last if $! == &POSIX::EAGAIN or
                                                $! == &POSIX::EWOULDBLOCK;
                                        die "$0: read STATUS_READ failed: $!";
                                }
                                elsif ($r == 0) {
                                        if ($status_buf ne '' and
                                            $status_buf !~ /\n$/) {
                                                $status_buf .= "\n";
                                        }
                                        $status_eof = 1;
                                        last;
                                }
                                last if $status_buf =~ /\n/;
                        }

                        while ($status_buf =~ /\n/) {
                                my $status_line;
                                ($status_line, $status_buf) =
                                        split /\n/, $status_buf, 2;
                                handle_status $from, $to, $status_line;
                        }
                }

                if (vec($rout, fileno(DEBCONF_COMMAND_READ), 1) == 1) {
                        # Debconf command. Pass straight through.
                        while (1) {
                                my $r = sysread(DEBCONF_COMMAND_READ,
                                                $debconf_command_buf, 4096,
                                                length $debconf_command_buf);
                                if (not defined $r) {
                                        next if $! == &POSIX::EINTR;
                                        last if $! == &POSIX::EAGAIN or
                                                $! == &POSIX::EWOULDBLOCK;
                                        die "$0: read DEBCONF_COMMAND_READ " .
                                            "failed: $!";
                                }
                                elsif ($r == 0) {
                                        if ($debconf_command_buf ne '' and
                                            $debconf_command_buf !~ /\n$/) {
                                                $debconf_command_buf .= "\n";
                                        }
                                        $debconf_command_eof = 1;
                                        last;
                                }
                                last if $debconf_command_buf =~ /\n/;
                        }

                        while ($debconf_command_buf =~ /\n/) {
                                my $debconf_command_line;
                                ($debconf_command_line, $debconf_command_buf) =
                                        split /\n/, $debconf_command_buf, 2;
                                handle_debconf_command $debconf_command_line;
                        }
                }
        }

        waitpid $pid, 0;
        my $status = $?;

        # make sure that the progress bar always gets to the end
        Debconf::Client::ConfModule::progress('SET', $to) if $progress;

        if ($status & 127) {
                return 127;
        }

        return ($status >> 8);
}

# Called if the progress bar is cancelled. Starts with a SIGINT but
# if called repeatedly, falls back to SIGKILL.
my $cancelled=0;
sub cancel () {
        if (defined $pid) {
                $cancelled++;
                #print STDERR "cancelled ($cancelled)\n";
                if ($cancelled == 1) {
                        kill INT => $pid;
                }
                else {
                        kill KILL => $pid;
                }
        }
}

sub start_bar ($$) {
        my ($from, $to) = @_;
        if ($progress) {
                Debconf::Client::ConfModule::progress(
                        'START', $from, $to, 'debconf-apt-progress/title');
                my @ret=Debconf::Client::ConfModule::progress(
                        'INFO', 'debconf-apt-progress/preparing');
                if ($ret[0] eq '30') {
                        cancel();
                }
        }
}

sub stop_bar () {
        Debconf::Client::ConfModule::progress('STOP') if $progress;
        # If we don't stop, we leave a zombie in case some daemon fails to
        # disconnect from fd 3. Don't do this if debconf was already
        # running, though, since in that case we're running as part of a
        # larger application which will need to take its own care to stop
        # when it's finished.
        Debconf::Client::ConfModule::stop()
                unless $ENV{DEBCONF_APT_PROGRESS_HAD_FRONTEND};
}

# Restore saved environment variables.
if (envnonempty('DEBCONF_APT_PROGRESS_DB_REPLACE')) {
        $ENV{DEBCONF_DB_REPLACE} = $ENV{DEBCONF_APT_PROGRESS_DB_REPLACE};
} else {
        delete $ENV{DEBCONF_DB_REPLACE};
}
if (envnonempty('DEBCONF_APT_PROGRESS_DB_OVERRIDE')) {
        $ENV{DEBCONF_DB_OVERRIDE} = $ENV{DEBCONF_APT_PROGRESS_DB_OVERRIDE};
} else {
        delete $ENV{DEBCONF_DB_OVERRIDE};
}

my @saved_argv = @ARGV;

my $result = GetOptions('config'       => \$config,
                        'start'        => \$start,
                        'from=i'       => \$from,
                        'to=i'         => \$to,
                        'stop'         => \$stop,
                        'logfile=s'    => \$logfile,
                        'logstderr'    => \$logstderr,
                        'progress!'    => \$progress,
                        'dlwaypoint=i' => \$dlwaypoint,
);

if (! $progress && ($start || $from || $to || $stop)) {
        die "--no-progress cannot be used with --start, --from, --to, or --stop\n";
}

unless ($start) {
        if (defined $from and not defined $to) {
                die "$0: --from requires --to\n";
        } elsif (defined $to and not defined $from) {
                die "$0: --to requires --from\n";
        }
}

my $mutex = 0;
++$mutex if $config;
++$mutex if $start;
++$mutex if $stop;
if ($mutex > 1) {
        die "$0: must use only one of --config, --start, or --stop\n";
}

if (($config or $stop) and (defined $from or defined $to)) {
        die "$0: cannot use --from or --to with --config or --stop\n";
}

start_debconf(@saved_argv) unless $config;

my $status = 0;

if ($config) {
        print <<'EOF';
DEBCONF_APT_PROGRESS_DB_REPLACE="$DEBCONF_DB_REPLACE"
DEBCONF_APT_PROGRESS_DB_OVERRIDE="$DEBCONF_DB_OVERRIDE"
export DEBCONF_APT_PROGRESS_DB_REPLACE DEBCONF_APT_PROGRESS_DB_OVERRIDE
DEBCONF_DB_REPLACE=configdb
DEBCONF_DB_OVERRIDE='Pipe{infd:none outfd:none}'
export DEBCONF_DB_REPLACE DEBCONF_DB_OVERRIDE
EOF
} elsif ($start) {
        $from = 0 unless defined $from;
        $to = 100 unless defined $to;
        start_bar($from, $to);
} elsif (defined $from) {
        $status = run_progress($from, $to, @ARGV);
} elsif ($stop) {
        stop_bar();
} else {
        start_bar(0, 100);
        $status = run_progress(0, 100, @ARGV);
        stop_bar();
}

if ($cancelled) {
        # This is pure paranoia. What if the child was in the
        # middle of writing a debconf command out, only to be
        # interrupted with a truncated write? Let's send a no-op
        # command to finish it out just in case.
        Debconf::Client::ConfModule::get("debconf/priority");

        exit 30;
}
elsif ($status == 30) {
        exit 3;
}
else {
        exit $status;
}

=head1 AUTHORS

Colin Watson <cjwatson@debian.org>

Joey Hess <joeyh@debian.org>

=cut
1	cjwatson	1901	#!/usr/bin/perl -w
2
3			=head1 NAME
4
5			debconf-apt-progress - install packages using debconf to display a progress bar
6
7			=head1 SYNOPSIS
8
9			debconf-apt-progress [--] command [args ...]
10			debconf-apt-progress --config
11			debconf-apt-progress --start
12			debconf-apt-progress --from waypoint --to waypoint [--] command [args ...]
13			debconf-apt-progress --stop
14
15			=head1 DESCRIPTION
16
17			B<debconf-apt-progress> installs packages using debconf to display a
18			progress bar. The given I<command> should be any command-line apt frontend;
19			specifically, it must send progress information to the file descriptor
20			selected by the C<APT::Status-Fd> configuration option, and must keep the
21			file descriptors nominated by the C<APT::Keep-Fds> configuration option open
22			when invoking debconf (directly or indirectly), as those file descriptors
23			will be used for the debconf passthrough protocol.
24
25			The arguments to the command you supply should generally include B<-y> (for
26			B<apt-get> or B<aptitude>) or similar to avoid the apt frontend prompting
27			for input. B<debconf-apt-progress> cannot do this itself because the
28			appropriate argument may differ between apt frontends.
29
30			The B<--start>, B<--stop>, B<--from>, and B<--to> options may be used to
31			create a progress bar with multiple segments for different stages of
32			installation, provided that the caller is a debconf confmodule. The caller
33			may also interact with the progress bar itself using the debconf protocol if
34			it so desires.
35
36			debconf locks its config database when it starts up, which makes it
37			unfortunately inconvenient to have one instance of debconf displaying the
38			progress bar and another passing through questions from packages being
39	cjwatson	1908	installed. If you're using a multiple-segment progress bar, you'll need to
40			eval the output of the B<--config> option before starting the debconf
41			frontend to work around this. See L<the EXAMPLES section/EXAMPLES> below.
42	cjwatson	1901
43			=head1 OPTIONS
44
45			=over 4
46
47			=item B<--config>
48
49	cjwatson	1908	Print environment variables necessary to start up a progress bar frontend.
50	cjwatson	1901
51			=item B<--start>
52
53	cjwatson	1912	Start up a progress bar, running from 0 to 100 by default. Use B<--from> and
54			B<--to> to use other endpoints.
55	cjwatson	1901
56			=item B<--from> I<waypoint>
57
58	cjwatson	1912	If used with B<--start>, make the progress bar begin at I<waypoint> rather
59			than 0.
60	cjwatson	1901
61	cjwatson	1912	Otherwise, install packages with their progress bar beginning at this
62			"waypoint". Must be used with B<--to>.
63
64	cjwatson	1901	=item B<--to> I<waypoint>
65
66	cjwatson	1912	If used with B<--start>, make the progress bar end at I<waypoint> rather
67			than 100.
68	cjwatson	1901
69	cjwatson	1912	Otherwise, install packages with their progress bar ending at this
70			"waypoint". Must be used with B<--from>.
71
72	cjwatson	1901	=item B<--stop>
73
74			Stop a running progress bar.
75
76	joeyh	2233	=item B<--no-progress>
77
78			Avoid starting, stopping, or stepping the progress bar. Progress
79			messages from apt, media change events, and debconf questions will still
80			be passed through to debconf.
81
82	joeyh	2244	=item B<--dlwaypoint> I<percentage>
83
84			Specify what percent of the progress bar to use for downloading packages.
85			The remainder will be used for installing packages. The default is to use
86			15% for downloading and the remaining 85% for installing.
87
88	cjwatson	1901	=item B<--logfile> I<file>
89
90			Send the normal output from apt to the given file.
91
92	cjwatson	1904	=item B<--logstderr>
93
94			Send the normal output from apt to stderr. If you supply neither
95			B<--logfile> nor B<--logstderr>, the normal output from apt will be
96			discarded.
97
98	cjwatson	1901	=item B<-->
99
100			Terminate options. Since you will normally need to give at least the B<-y>
101			argument to the command being run, you will usually need to use B<--> to
102			prevent that being interpreted as an option to B<debconf-apt-progress>
103			itself.
104
105	cjwatson	2307	=back
106
107	cjwatson	1901	=head1 EXAMPLES
108
109			Install the GNOME desktop and an X window system development environment
110			within a progress bar:
111
112			debconf-apt-progress -- aptitude -y install gnome x-window-system-dev
113
114			Install the GNOME, KDE, and XFCE desktops within a single progress bar,
115			allocating 45% of the progress bar for each of GNOME and KDE and the
116			remaining 10% for XFCE:
117
118			#! /bin/sh
119			set -e
120			case $1 in
121			'')
122	cjwatson	1908	eval "$(debconf-apt-progress --config)"
123			"$0" debconf
124	cjwatson	1901	;;
125			debconf)
126			. /usr/share/debconf/confmodule
127			debconf-apt-progress --start
128			debconf-apt-progress --from 0 --to 45 -- apt-get -y install gnome
129			debconf-apt-progress --from 45 --to 90 -- apt-get -y install kde
130			debconf-apt-progress --from 90 --to 100 -- apt-get -y install xfce4
131			debconf-apt-progress --stop
132			;;
133			esac
134
135	joeyh	2238	=head1 RETURN CODE
136
137			The exit code of the specified command is returned, unless the user hit the
138			cancel button on the progress bar. If the cancel button was hit, a value of
139	joeyh	2239	30 is returned. To avoid ambiguity, if the command returned 30, a value of
140			3 will be returned.
141	joeyh	2238
142	cjwatson	1901	=cut
143
144			use strict;
145			use POSIX;
146			use Fcntl;
147			use Getopt::Long;
148			# Avoid starting the debconf frontend just yet.
149			use Debconf::Client::ConfModule ();
150
151			my ($config, $start, $from, $to, $stop);
152	joeyh	2233	my $progress=1;
153	joeyh	2244	my $dlwaypoint=15;
154	cjwatson	1904	my ($logfile, $logstderr);
155	cjwatson	1901
156			sub checkopen (@) {
157			my $file = $_[0];
158			my $fd = POSIX::open($file, &POSIX::O_RDONLY);
159			defined $fd or die "$0: can't open $_[0]: $!\n";
160			return $fd;
161			}
162
163			sub checkclose ($) {
164			my $fd = $_[0];
165			unless (POSIX::close($fd)) {
166			return if $! == &POSIX::EBADF;
167			die "$0: can't close fd $fd: $!\n";
168			}
169			}
170
171			sub checkdup2 ($$) {
172			my ($oldfd, $newfd) = @_;
173			checkclose($newfd);
174			POSIX::dup2($oldfd, $newfd)
175			or die "$0: can't dup fd $oldfd to $newfd: $!\n";
176			}
177
178			sub nocloexec (*) {
179			my $fh = shift;
180			my $flags = fcntl($fh, F_GETFD, 0);
181			fcntl($fh, F_SETFD, $flags & ~FD_CLOEXEC);
182			}
183
184	cjwatson	2214	sub nonblock (*) {
185			my $fh = shift;
186			my $flags = fcntl($fh, F_GETFL, 0);
187			fcntl($fh, F_SETFL, $flags \| O_NONBLOCK);
188			}
189
190	cjwatson	1901	# Open the given file descriptors to make sure they won't accidentally be
191			# used by Perl, leading to confusion.
192			sub reservefds (@) {
193			my $null = checkopen('/dev/null');
194			my $close = 1;
195			for my $fd (@_) {
196			if ($null == $fd) {
197			$close = 0;
198			} else {
199			checkclose($fd);
200			checkdup2($null, $fd);
201			}
202			}
203			if ($close) {
204			checkclose($null);
205			}
206			}
207
208	cjwatson	1908	# Does this environment variable exist, and is it non-empty?
209			sub envnonempty ($) {
210			my $name = shift;
211			return (exists $ENV{$name} and $ENV{$name} ne '');
212			}
213
214	cjwatson	1928	sub start_debconf (@) {
215			if (! $ENV{DEBIAN_HAS_FRONTEND}) {
216			# Save existing environment variables.
217			if (envnonempty('DEBCONF_DB_REPLACE')) {
218			$ENV{DEBCONF_APT_PROGRESS_DB_REPLACE} =
219			$ENV{DEBCONF_DB_REPLACE};
220			}
221			if (envnonempty('DEBCONF_DB_OVERRIDE')) {
222			$ENV{DEBCONF_APT_PROGRESS_DB_OVERRIDE} =
223			$ENV{DEBCONF_DB_OVERRIDE};
224			}
225
226			# Make sure the main configdb is opened read-only ...
227			$ENV{DEBCONF_DB_REPLACE} = 'configdb';
228			# ... and stack a writable db on top of it, since the
229			# passthrough instance is going to be sending us db updates.
230			$ENV{DEBCONF_DB_OVERRIDE} = 'Pipe{infd:none outfd:none}';
231
232	cjwatson	2334	delete $ENV{DEBCONF_APT_PROGRESS_HAD_FRONTEND};
233
234	cjwatson	1928	# Restore @ARGV so that
235			# Debconf::Client::ConfModule::import() can use it.
236			@ARGV = @_;
237	cjwatson	2334	} else {
238			# Leave a note for ourselves.
239			$ENV{DEBCONF_APT_PROGRESS_HAD_FRONTEND} = 1;
240	cjwatson	1928	}
241
242			import Debconf::Client::ConfModule;
243			}
244
245	cjwatson	1901	sub passthrough (@) {
246			my $priority = Debconf::Client::ConfModule::get('debconf/priority');
247
248			defined(my $pid = fork) or die "$0: can't fork: $!\n";
249			if (!$pid) {
250			close STATUS_READ;
251	joeyh	2105	close COMMAND_WRITE;
252	cjwatson	2214	close DEBCONF_COMMAND_READ;
253			close DEBCONF_REPLY_WRITE;
254	cjwatson	1901	$^F = 6; # avoid close-on-exec
255	joeyh	2105	if (fileno(COMMAND_READ) != 0) {
256			checkdup2(fileno(COMMAND_READ), 0);
257			close COMMAND_READ;
258	cjwatson	1901	}
259			if (fileno(APT_LOG) != 1) {
260			checkclose(1);
261			checkdup2(fileno(APT_LOG), 1);
262			}
263			if (fileno(APT_LOG) != 2) {
264			checkclose(2);
265			checkdup2(fileno(APT_LOG), 2);
266			}
267			close APT_LOG;
268			delete $ENV{DEBIAN_HAS_FRONTEND};
269			delete $ENV{DEBCONF_REDIR};
270			delete $ENV{DEBCONF_SYSTEMRC};
271			delete $ENV{DEBCONF_PIPE}; # just in case ...
272			$ENV{DEBIAN_FRONTEND} = 'passthrough';
273			$ENV{DEBIAN_PRIORITY} = $priority;
274			$ENV{DEBCONF_READFD} = 5;
275			$ENV{DEBCONF_WRITEFD} = 6;
276			$ENV{APT_LISTCHANGES_FRONTEND} = 'none';
277			exec @_;
278			}
279
280			close STATUS_WRITE;
281	joeyh	2105	close COMMAND_READ;
282	cjwatson	2214	close DEBCONF_COMMAND_WRITE;
283			close DEBCONF_REPLY_READ;
284	cjwatson	1901	return $pid;
285			}
286
287	cjwatson	2214	sub handle_status ($$$) {
288			my ($from, $to, $line) = @_;
289			my ($status, $pkg, $percent, $description) = split ':', $line, 4;
290
291			my ($min, $len);
292			if ($status eq 'dlstatus') {
293			$min = 0;
294	joeyh	2244	$len = $dlwaypoint;
295	cjwatson	2214	}
296			elsif ($status eq 'pmstatus') {
297	joeyh	2244	$min = $dlwaypoint;
298			$len = 100 - $dlwaypoint;
299	cjwatson	2214	}
300			elsif ($status eq 'media-change') {
301			Debconf::Client::ConfModule::subst(
302			'debconf-apt-progress/media-change', 'MESSAGE',
303			$description);
304			my @ret = Debconf::Client::ConfModule::input(
305			'critical', 'debconf-apt-progress/media-change');
306			$ret[0] == 0 or die "Can't display media change request!\n";
307			Debconf::Client::ConfModule::go();
308			print COMMAND_WRITE "\n" \|\| die "can't talk to command fd: $!";
309	cjwatson	2266	return;
310	cjwatson	2214	}
311			else {
312	cjwatson	2266	return;
313	cjwatson	2214	}
314
315			$percent = ($percent * $len / 100 + $min);
316			$percent = ($percent * ($to - $from) / 100 + $from);
317			$percent =~ s/\..*//;
318	joeyh	2236	if ($progress) {
319			my @ret=Debconf::Client::ConfModule::progress('SET', $percent);
320			if ($ret[0] eq '30') {
321			cancel();
322			}
323			}
324	cjwatson	2214	Debconf::Client::ConfModule::subst(
325			'debconf-apt-progress/info', 'DESCRIPTION', $description);
326	joeyh	2236	my @ret=Debconf::Client::ConfModule::progress(
327	cjwatson	2214	'INFO', 'debconf-apt-progress/info');
328	joeyh	2236	if ($ret[0] eq '30') {
329			cancel();
330			}
331	cjwatson	2214	}
332
333			sub handle_debconf_command ($) {
334			my $line = shift;
335
336			# Debconf::Client::ConfModule has already dealt with checking
337			# DEBCONF_REDIR.
338			print "$line\n" \|\| die "can't write to stdout: $!";
339			my $ret = <STDIN>;
340			chomp $ret;
341			print DEBCONF_REPLY_WRITE "$ret\n" \|\|
342			die "can't write to DEBCONF_REPLY_WRITE: $!";
343			}
344
345	joeyh	2236	my $pid;
346	cjwatson	1901	sub run_progress ($$@) {
347			my $from = shift;
348			my $to = shift;
349			my $command = shift;
350			local (STATUS_READ, STATUS_WRITE);
351	joeyh	2105	local (COMMAND_READ, COMMAND_WRITE);
352	cjwatson	2214	local (DEBCONF_COMMAND_READ, DEBCONF_COMMAND_WRITE);
353			local (DEBCONF_REPLY_READ, DEBCONF_REPLY_WRITE);
354	cjwatson	1901	local *APT_LOG;
355	cjwatson	2214	use IO::Handle;
356	cjwatson	1901
357	joeyh	2236	if ($progress) {
358			my @ret=Debconf::Client::ConfModule::progress(
359			'INFO', 'debconf-apt-progress/preparing');
360			if ($ret[0] eq '30') {
361			cancel();
362			}
363			}
364	cjwatson	1901
365			reservefds(4, 5, 6);
366
367	cjwatson	2214	pipe STATUS_READ, STATUS_WRITE
368			or die "$0: can't create status pipe: $!";
369			nonblock(\*STATUS_READ);
370	cjwatson	1901	checkdup2(fileno(STATUS_WRITE), 4);
371			open STATUS_WRITE, '>&=4'
372			or die "$0: can't reopen STATUS_WRITE as fd 4: $!";
373			nocloexec(\*STATUS_WRITE);
374	cjwatson	2214
375			pipe COMMAND_READ, COMMAND_WRITE
376			or die "$0: can't create command pipe: $!";
377	joeyh	2105	nocloexec(\*COMMAND_READ);
378			COMMAND_WRITE->autoflush(1);
379	cjwatson	1901
380	cjwatson	2214	pipe DEBCONF_COMMAND_READ, DEBCONF_COMMAND_WRITE
381			or die "$0: can't create debconf command pipe: $!";
382			nonblock(\*DEBCONF_COMMAND_READ);
383			checkdup2(fileno(DEBCONF_COMMAND_WRITE), 6);
384			open DEBCONF_COMMAND_WRITE, '>&=6'
385			or die "$0: can't reopen DEBCONF_COMMAND_WRITE as fd 6: $!";
386			nocloexec(\*DEBCONF_COMMAND_WRITE);
387
388			pipe DEBCONF_REPLY_READ, DEBCONF_REPLY_WRITE
389			or die "$0: can't create debconf reply pipe: $!";
390			checkdup2(fileno(DEBCONF_REPLY_READ), 5);
391			open DEBCONF_REPLY_READ, '<&=5'
392			or die "$0: can't reopen DEBCONF_REPLY_READ as fd 5: $!";
393			nocloexec(\*DEBCONF_REPLY_READ);
394			DEBCONF_REPLY_WRITE->autoflush(1);
395
396	cjwatson	1901	if (defined $logfile) {
397			open APT_LOG, '>>', $logfile
398			or die "$0: can't open $logfile: $!";
399	cjwatson	1904	} elsif ($logstderr) {
400	cjwatson	1901	open APT_LOG, '>&STDERR'
401			or die "$0: can't duplicate stderr: $!";
402	cjwatson	1904	} else {
403			open APT_LOG, '>', '/dev/null'
404			or die "$0: can't open /dev/null: $!";
405	cjwatson	1901	}
406			nocloexec(\*APT_LOG);
407
408	joeyh	2236	$pid = passthrough $command,
409	cjwatson	1901	'-o', 'APT::Status-Fd=4',
410			'-o', 'APT::Keep-Fds::=5',
411			'-o', 'APT::Keep-Fds::=6',
412			@_;
413
414	cjwatson	2214	my $status_eof = 0;
415			my $debconf_command_eof = 0;
416			my $status_buf = '';
417			my $debconf_command_buf = '';
418	cjwatson	1901
419	cjwatson	2249	# STATUS_READ should be the last fd to close. DEBCONF_COMMAND_WRITE
420			# may end up captured by buggy daemons, so terminate the loop even
421			# if we haven't hit $debconf_command_eof.
422			while (not $status_eof) {
423	cjwatson	2214	my $rin = '';
424			my $rout;
425	cjwatson	2249	vec($rin, fileno(STATUS_READ), 1) = 1;
426	cjwatson	2214	vec($rin, fileno(DEBCONF_COMMAND_READ), 1) = 1
427			unless $debconf_command_eof;
428			my $sel = select($rout = $rin, undef, undef, undef);
429			if ($sel < 0) {
430			next if $! == &POSIX::EINTR;
431			die "$0: select failed: $!";
432	joeyh	2119	}
433	cjwatson	2214
434			if (vec($rout, fileno(STATUS_READ), 1) == 1) {
435			# Status message from apt. Transform into debconf
436			# messages.
437			while (1) {
438			my $r = sysread(STATUS_READ, $status_buf, 4096,
439			length $status_buf);
440			if (not defined $r) {
441			next if $! == &POSIX::EINTR;
442			last if $! == &POSIX::EAGAIN or
443			$! == &POSIX::EWOULDBLOCK;
444			die "$0: read STATUS_READ failed: $!";
445			}
446			elsif ($r == 0) {
447			if ($status_buf ne '' and
448			$status_buf !~ /\n$/) {
449			$status_buf .= "\n";
450			}
451			$status_eof = 1;
452			last;
453			}
454			last if $status_buf =~ /\n/;
455			}
456
457			while ($status_buf =~ /\n/) {
458			my $status_line;
459			($status_line, $status_buf) =
460			split /\n/, $status_buf, 2;
461			handle_status $from, $to, $status_line;
462			}
463	joeyh	2119	}
464	cjwatson	2214
465			if (vec($rout, fileno(DEBCONF_COMMAND_READ), 1) == 1) {
466			# Debconf command. Pass straight through.
467			while (1) {
468			my $r = sysread(DEBCONF_COMMAND_READ,
469			$debconf_command_buf, 4096,
470			length $debconf_command_buf);
471			if (not defined $r) {
472			next if $! == &POSIX::EINTR;
473			last if $! == &POSIX::EAGAIN or
474			$! == &POSIX::EWOULDBLOCK;
475			die "$0: read DEBCONF_COMMAND_READ " .
476			"failed: $!";
477			}
478			elsif ($r == 0) {
479			if ($debconf_command_buf ne '' and
480			$debconf_command_buf !~ /\n$/) {
481			$debconf_command_buf .= "\n";
482			}
483			$debconf_command_eof = 1;
484			last;
485			}
486			last if $debconf_command_buf =~ /\n/;
487			}
488
489			while ($debconf_command_buf =~ /\n/) {
490			my $debconf_command_line;
491			($debconf_command_line, $debconf_command_buf) =
492			split /\n/, $debconf_command_buf, 2;
493			handle_debconf_command $debconf_command_line;
494			}
495	joeyh	2119	}
496	cjwatson	1901	}
497
498			waitpid $pid, 0;
499			my $status = $?;
500
501			# make sure that the progress bar always gets to the end
502	joeyh	2233	Debconf::Client::ConfModule::progress('SET', $to) if $progress;
503	cjwatson	1901
504	joeyh	2237	if ($status & 127) {
505			return 127;
506			}
507
508	cjwatson	1901	return ($status >> 8);
509			}
510
511	joeyh	2244	# Called if the progress bar is cancelled. Starts with a SIGINT but
512	joeyh	2236	# if called repeatedly, falls back to SIGKILL.
513	joeyh	2240	my $cancelled=0;
514	joeyh	2236	sub cancel () {
515			if (defined $pid) {
516	joeyh	2240	$cancelled++;
517	joeyh	2244	#print STDERR "cancelled ($cancelled)\n";
518	joeyh	2240	if ($cancelled == 1) {
519	cjwatson	2265	kill INT => $pid;
520	joeyh	2236	}
521			else {
522	cjwatson	2265	kill KILL => $pid;
523	joeyh	2236	}
524			}
525			}
526
527	cjwatson	1912	sub start_bar ($$) {
528			my ($from, $to) = @_;
529	joeyh	2236	if ($progress) {
530			Debconf::Client::ConfModule::progress(
531			'START', $from, $to, 'debconf-apt-progress/title');
532			my @ret=Debconf::Client::ConfModule::progress(
533			'INFO', 'debconf-apt-progress/preparing');
534			if ($ret[0] eq '30') {
535			cancel();
536			}
537			}
538	cjwatson	1901	}
539
540			sub stop_bar () {
541	joeyh	2233	Debconf::Client::ConfModule::progress('STOP') if $progress;
542	cjwatson	1909	# If we don't stop, we leave a zombie in case some daemon fails to
543	cjwatson	2334	# disconnect from fd 3. Don't do this if debconf was already
544			# running, though, since in that case we're running as part of a
545			# larger application which will need to take its own care to stop
546			# when it's finished.
547			Debconf::Client::ConfModule::stop()
548			unless $ENV{DEBCONF_APT_PROGRESS_HAD_FRONTEND};
549	cjwatson	1901	}
550
551	cjwatson	1908	# Restore saved environment variables.
552			if (envnonempty('DEBCONF_APT_PROGRESS_DB_REPLACE')) {
553			$ENV{DEBCONF_DB_REPLACE} = $ENV{DEBCONF_APT_PROGRESS_DB_REPLACE};
554			} else {
555			delete $ENV{DEBCONF_DB_REPLACE};
556			}
557			if (envnonempty('DEBCONF_APT_PROGRESS_DB_OVERRIDE')) {
558			$ENV{DEBCONF_DB_OVERRIDE} = $ENV{DEBCONF_APT_PROGRESS_DB_OVERRIDE};
559			} else {
560			delete $ENV{DEBCONF_DB_OVERRIDE};
561			}
562
563	cjwatson	1901	my @saved_argv = @ARGV;
564
565	joeyh	2244	my $result = GetOptions('config' => \$config,
566			'start' => \$start,
567			'from=i' => \$from,
568			'to=i' => \$to,
569			'stop' => \$stop,
570			'logfile=s' => \$logfile,
571			'logstderr' => \$logstderr,
572			'progress!' => \$progress,
573			'dlwaypoint=i' => \$dlwaypoint,
574			);
575	cjwatson	1901
576	joeyh	2233	if (! $progress && ($start \|\| $from \|\| $to \|\| $stop)) {
577			die "--no-progress cannot be used with --start, --from, --to, or --stop\n";
578			}
579
580	cjwatson	1912	unless ($start) {
581			if (defined $from and not defined $to) {
582			die "$0: --from requires --to\n";
583			} elsif (defined $to and not defined $from) {
584			die "$0: --to requires --from\n";
585			}
586	cjwatson	1901	}
587
588			my $mutex = 0;
589			++$mutex if $config;
590			++$mutex if $start;
591			++$mutex if $stop;
592			if ($mutex > 1) {
593	cjwatson	1912	die "$0: must use only one of --config, --start, or --stop\n";
594	cjwatson	1901	}
595
596	cjwatson	1912	if (($config or $stop) and (defined $from or defined $to)) {
597			die "$0: cannot use --from or --to with --config or --stop\n";
598			}
599
600	cjwatson	1928	start_debconf(@saved_argv) unless $config;
601
602	cjwatson	1901	my $status = 0;
603
604			if ($config) {
605	cjwatson	1908	print <<'EOF';
606			DEBCONF_APT_PROGRESS_DB_REPLACE="$DEBCONF_DB_REPLACE"
607			DEBCONF_APT_PROGRESS_DB_OVERRIDE="$DEBCONF_DB_OVERRIDE"
608			export DEBCONF_APT_PROGRESS_DB_REPLACE DEBCONF_APT_PROGRESS_DB_OVERRIDE
609			DEBCONF_DB_REPLACE=configdb
610			DEBCONF_DB_OVERRIDE='Pipe{infd:none outfd:none}'
611			export DEBCONF_DB_REPLACE DEBCONF_DB_OVERRIDE
612			EOF
613	cjwatson	1901	} elsif ($start) {
614	cjwatson	1912	$from = 0 unless defined $from;
615			$to = 100 unless defined $to;
616			start_bar($from, $to);
617	cjwatson	1901	} elsif (defined $from) {
618			$status = run_progress($from, $to, @ARGV);
619			} elsif ($stop) {
620			stop_bar();
621			} else {
622	cjwatson	1912	start_bar(0, 100);
623	cjwatson	1901	$status = run_progress(0, 100, @ARGV);
624			stop_bar();
625			}
626
627	joeyh	2240	if ($cancelled) {
628	joeyh	2245	# This is pure paranoia. What if the child was in the
629			# middle of writing a debconf command out, only to be
630			# interrupted with a truncated write? Let's send a no-op
631			# command to finish it out just in case.
632			Debconf::Client::ConfModule::get("debconf/priority");
633
634	joeyh	2238	exit 30;
635			}
636	joeyh	2239	elsif ($status == 30) {
637			exit 3;
638			}
639	joeyh	2238	else {
640			exit $status;
641			}
642	cjwatson	1901
643			=head1 AUTHORS
644
645			Colin Watson <cjwatson@debian.org>
646
647			Joey Hess <joeyh@debian.org>
648
649			=cut