package install_steps_gtk; # $Id$
use diagnostics;
use strict;
use vars qw(@ISA);
@ISA = qw(install_steps_interactive interactive::gtk);
#-######################################################################################
#- misc imports
#-######################################################################################
use pkgs;
use install_steps_interactive;
use interactive::gtk;
use common;
use ugtk2 qw(:helpers :wrappers :create);
use devices;
use modules;
use install_gtk;
use install_any;
use mouse;
use help;
use log;
#-######################################################################################
#- In/Out Steps Functions
#-######################################################################################
sub new($$) {
my ($type, $o) = @_;
my $old = $SIG{__DIE__};
$SIG{__DIE__} = sub { $_[0] !~ /ugtk2\.pm/ and goto $old };
$ENV{DISPLAY} ||= $o->{display} || ":0";
my $wanted_DISPLAY = $::testing && -x '/usr/X11R6/bin/Xnest' ? ':1' : $ENV{DISPLAY};
if ($ENV{DISPLAY} =~ /^:\d/ && !$::testing || $ENV{DISPLAY} ne $wanted_DISPLAY) { #- is the display local or distant?
my $f = "/tmp/Xconf";
if (!$::testing) {
devices::make("/dev/kbd");
}
my $launchX = sub {
my ($server, $Driver) = @_;
my $ok = 1;
my $xpmac_opts = cat_('/proc/cmdline');
install_gtk::createXconf($f, @{$o->{mouse}}{"XMOUSETYPE", "device"}, $o->{mouse}{wacom}[0], $Driver);
mkdir '/var/log' if !-d '/var/log';
local $SIG{CHLD} = sub { $ok = 0 if waitpid(-1, c::WNOHANG()) > 0 };
my @options = (
if_(arch() !~ /^sparc/ && arch() ne 'ppc' && $server ne 'Xnest',
'-kb', '-allowMouseOpenFail', '-xf86config', $f),
($wanted_DISPLAY, 'tty7', '-dpms', '-s', '240'),
);
push @options, $xpmac_opts !~ /ofonly/ ? ('-mode', '17', '-depth', '32') : '-mach64' if $server =~ /Xpmac/;
push @options, '-fp', '/usr/X11R6/lib/X11/fonts:unscaled' if $server =~ /Xsun|Xpmac/;
push @options, '-geometry', $o->{vga16} ? '640x480' : '800x600' if $server eq 'Xnest';
unless (fork()) {
exec $server, @options or exit 1;
}
foreach (1..60) {
sleep 1;
log::l("Server died"), return 0 if !$ok;
if (c::Xtest($wanted_DISPLAY)) {
if (-x '/usr/bin/aewm-drakx') {
fork() || exec("aewm-drakx") || c::_exit(0);
}
return 1;
}
}
log::l("Timeout!!");
0;
};
my @servers = qw(FBDev VGA16); #-)
if ($::testing) {
@servers = 'Xnest';
} elsif (arch() eq "alpha") {
require Xconfig::card;
my ($card) = Xconfig::card::probe();
Xconfig::card::add_to_card__using_Cards($card, $card->{type}) if $card && $card->{type};
@servers = $card->{server} || "TGA";
#-@servers = qw(SVGA 3DLabs TGA)
} elsif (arch() =~ /^sparc/) {
local $_ = cat_("/proc/fb");
if (/Mach64/) {
@servers = qw(Mach64);
} elsif (/Permedia2/) {
@servers = qw(3DLabs);
} else {
@servers = qw(Xsun24);
}
} elsif (arch() =~ /ia64/) {
require Xconfig::card;
my ($card) = Xconfig::card::probe();
@servers = map { if_($_, "Driver:$_") } $card && $card->{Driver}, 'fbdev';
} elsif (arch() eq "ppc") {
@servers = qw(Xpmac);
}
foreach (@servers) {
log::l("Trying with server $_");
my $dir = "/usr/X11R6/bin";
my ($prog, $Driver) = /Driver:(.*)/ ? ('XFree86', $1) : /Xsun|Xpmac|Xnest/ ? $_ : "XF86_$_";
unless (-x "$dir/$prog") {
unlink $_ foreach glob_("$dir/X*");
install_any::getAndSaveFile("Mandrake/mdkinst$dir/$prog", "$dir/$prog") or die "failed to get server $prog: $!";
chmod 0755, "$dir/$prog";
}
if (/FB/) {
!$o->{vga16} && $o->{allowFB} or next;
$o->{allowFB} = &$launchX($prog, $Driver) #- keep in mind FB is used.
and goto OK;
} else {
$o->{vga16} = 1 if /VGA16/;
&$launchX($prog) and goto OK;
}
}
return undef;
}
OK:
$ENV{DISPLAY} = $wanted_DISPLAY;
install_gtk::init_gtk();
install_gtk::init_sizes();
install_gtk::install_theme($o);
install_gtk::create_logo_window($o);
install_gtk::create_steps_window($o);
$ugtk2::force_center = [ $::rootwidth - $::windowwidth, $::logoheight, $::windowwidth, $::windowheight ];
$o = (bless {}, ref($type) || $type)->SUPER::new($o);
$o->interactive::gtk::new;
$o;
}
sub enteringStep {
my ($o, $step) = @_;
printf "Entering step `%s'\n", $o->{steps}{$step}{text};
$o->SUPER::enteringStep($step);
install_gtk::update_steps_position($o);
# install_gtk::create_help_window($o); #- HACK: without this it doesn't work (reaches step doPartitionDisks then fail)
}
sub leavingStep {
my ($o, $step) = @_;
$o->SUPER::leavingStep($step);
}
sub charsetChanged {
my ($o) = @_;
Gtk2->set_locale;
install_gtk::load_font($o);
install_gtk::create_steps_window($o);
}
#-######################################################################################
#- Steps Functions
#-######################################################################################
sub selectLanguage {
my ($o, $first_time) = @_;
$o->SUPER::selectLanguage;
$o->ask_warn('',
formatAlaTeX(N("Your system is low on resources. You may have some problem installing
Mandrake Linux. If that occurs, you can try a text install instead. For this,
press `F1' when booting on CDROM, then enter `text'."))) if $first_time && availableRamMB() < 70; # 70MB
}
#------------------------------------------------------------------------------
sub selectMouse {
my ($o, $force) = @_;
my %old = %{$o->{mouse}};
$o->SUPER::selectMouse($force) or return;
my $mouse = $o->{mouse};
$mouse->{type} eq 'none' ||
$old{type} eq $mouse->{type} &&
$old{name} eq $mouse->{name} &&
$old{device} eq $mouse->{device} && !$force and return;
local $ugtk2::grab = 1; #- unsure a crazy mouse don't go wild clicking everywhere
while (1) {
my $xId = mouse::xmouse2xId($mouse->{XMOUSETYPE});
my $x_protocol_changed = $old{device} ne $mouse->{device} || $xId != mouse::xmouse2xId($old{XMOUSETYPE});
if ($x_protocol_changed) {
log::l("telling X server to use another mouse");
eval { modules::load('serial') } if $mouse->{device} =~ /ttyS/;
if (!$::testing) {
devices::make($mouse->{device});
symlinkf($mouse->{device}, "/dev/mouse");
c::setMouseLive($ENV{DISPLAY}, $xId, $mouse->{nbuttons} < 3);
}
}
mouse::test_mouse_install($mouse, $x_protocol_changed) and return;
%old = %$mouse;
$o->SUPER::selectMouse(1);
$mouse = $o->{mouse};
}
}
sub reallyChooseGroups {
my ($o, $size_to_display, $individual, $val) = @_;
my $w = ugtk2->new('');
my $tips = Gtk2::Tooltips->new;
my $w_size = Gtk2::Label->new(&$size_to_display);
my $entry = sub {
my ($e) = @_;
my $text = translate($o->{compssUsers}{$e}{label});
my $help = translate($o->{compssUsers}{$e}{descr});
my $check = Gtk2::CheckButton->new($text);
$check->set_active($val->{$e});
$check->signal_connect(clicked => sub {
$val->{$e} = $check->get_active;
$w_size->set_label(&$size_to_display);
});
gtkset_tip($tips, $check, $help);
#gtkpack_(Gtk2::HBox->new(0, 0), 0, gtkpng($file), 1, $check);
$check;
};
my $entries_in_path = sub {
my ($path) = @_;
translate($path), map { $entry->($_) } grep { $o->{compssUsers}{$_}{path} eq $path } @{$o->{compssUsersSorted}};
};
gtkadd($w->{window},
gtkpack_($w->create_box_with_title(N("Package Group Selection")),
1, gtkpack_(Gtk2::VBox->new(0, 0),
1, gtkpack_(Gtk2::HBox->new(0, 0),
$o->{meta_class} eq 'server' ? (
1, gtkpack(Gtk2::VBox->new(0, 0),
$entries_in_path->('Server'),
),
1, gtkpack(Gtk2::VBox->new(0, 0),
$entries_in_path->('Graphical Environment'),
'',
$entries_in_path->('Development'),
'',
$entries_in_path->('Utilities'),
),
) : $o->{meta_class} eq 'desktop' ? (
1, gtkpack(Gtk2::VBox->new(0, 0),
$entries_in_path->('Workstation'),
),
) : (
1, gtkpack(Gtk2::VBox->new(0, 0),
$entries_in_path->('Workstation'),
'',
$entry->('Development|Development'),
$entry->('Development|Documentation'),
$entry->('Development|LSB'),
),
0, gtkpack(Gtk2::VBox->new(0, 0),
$entries_in_path->('Server'),
'',
$entries_in_path->('Graphical Environment'),
),
),
)),
1, '',
0, gtkadd(Gtk2::HBox->new(0, 0),
gtksignal_connect(Gtk2::Button->new(N("Help")), clicked => $o->interactive_help_sub_display_id('choosePackages')),
$w_size,
if_($individual, do {
my $check = Gtk2::CheckButton->new(N("Individual package selection"));
$check->set_active($$individual);
$check->signal_connect(clicked => sub { $$individual = $check->get_active });
$check;
}),
gtksignal_connect(Gtk2::Button->new(N("Next ->")), clicked => sub { Gtk2->main_quit }),
),
),
);
$w->main;
1;
}
sub choosePackagesTree {
my ($o, $packages, $limit_to_medium) = @_;
my $available = install_any::getAvailableSpace($o);
my $availableCorrected = pkgs::invCorrectSize($available / sqr(1024)) * sqr(1024);
my $common; $common = { get_status => sub {
my $size = pkgs::selectedSize($packages);
N("Total size: %d / %d MB", pkgs::correctSize($size / sqr(1024)), $available / sqr(1024));
},
node_state => sub {
my $p = pkgs::packageByName($packages, $_[0]) or return;
pkgs::packageMedium($packages, $p)->{selected} or return;
$p->flag_base and return 'base';
$p->flag_installed && !$p->flag_upgrade and return 'installed';
$p->flag_selected and return 'selected';
return 'unselected';
},
build_tree => sub {
my ($add_node, $flat) = @_;
if ($flat) {
foreach (sort map { $_->name } grep { !$limit_to_medium || pkgs::packageMedium($packages, $_) == $limit_to_medium }
@{$packages->{depslist}}) {
$add_node->($_, undef);
}
} else {
foreach my $root (@{$o->{compssUsersSorted}}) {
my (%fl, @firstchoice, @others);
#$fl{$_} = $o->{compssUsersChoice}{$_} foreach @{$o->{compssUsers}{$root}{flags}}; #- FEATURE:improve choce of packages...
$fl{$_} = 1 foreach @{$o->{compssUsers}{$root}{flags}};
foreach my $p (@{$packages->{depslist}}) {
!$limit_to_medium || pkgs::packageMedium($packages, $p) == $limit_to_medium or next;
my @flags = $p->rflags;
next if !($p->rate && any { any { !/^!/ && $fl{$_} } split('\|\|') } @flags);
$p->rate >= 3 ?
push(@firstchoice, $p->name) :
push(@others, $p->name);
}
my $root2 = join('|', map { translate($_) } split('\|', $root));
$add_node->($_, $root2) foreach sort @firstchoice;
$add_node->($_, $root2 . '|' . N("Other")) foreach sort @others;
}
}
},
get_info => sub {
my $p = pkgs::packageByName($packages, $_[0]) or return '';
pkgs::extractHeaders($o->{prefix}, [$p], $packages->{mediums});
my $imp = translate($pkgs::compssListDesc{$p->flag_base ? 5 : $p->rate});
my $info = $@ ? N("Bad package") :
(N("Name: %s\n", $p->name) .
N("Version: %s\n", $p->version . '-' . $p->release) .
N("Size: %d KB\n", $p->size / 1024) .
($imp && N("Importance: %s\n", $imp)) . "\n" .
formatLines(c::from_utf8($p->description)));
return $info;
},
toggle_nodes => sub {
my $set_state = shift @_;
my @n = map { pkgs::packageByName($packages, $_) } @_;
my %l;
my $isSelection = !$n[0]->flag_selected;
foreach (@n) {
#pkgs::togglePackageSelection($packages, $_, my $l = {});
#@l{grep {$l->{$_}} keys %$l} = ();
pkgs::togglePackageSelection($packages, $_, \%l);
}
if (my @l = map { $packages->{depslist}[$_]->name } keys %l) {
#- check for size before trying to select.
my $size = pkgs::selectedSize($packages);
foreach (@l) {
my $p = pkgs::packageByName($packages, $_);
$p->flag_selected or $size += $p->size;
}
if (pkgs::correctSize($size / sqr(1024)) > $available / sqr(1024)) {
return $o->ask_warn('', N("You can't select this package as there is not enough space left to install it"));
}
@l > @n && $common->{state}{auto_deps} and
$o->ask_okcancel('', [ $isSelection ?
N("The following packages are going to be installed") :
N("The following packages are going to be removed"),
common::formatList(20, sort @l) ], 1) || return;
if ($isSelection) {
pkgs::selectPackage($packages, $_) foreach @n;
} else {
pkgs::unselectPackage($packages, $_) foreach @n;
}
foreach (@l) {
my $p = pkgs::packageByName($packages, $_);
$set_state->($_, $p->flag_selected ? 'selected' : 'unselected');
}
} else {
$o->ask_warn('', N("You can't select/unselect this package"));
}
},
grep_allowed_to_toggle => sub {
grep { my $p = pkgs::packageByName($packages, $_); $p && !$p->flag_base } @_;
},
grep_unselected => sub {
grep { !pkgs::packageByName($packages, $_)->flag_selected } @_;
},
check_interactive_to_toggle => sub {
my $p = pkgs::packageByName($packages, $_[0]) or return;
if ($p->flag_base) {
$o->ask_warn('', N("This is a mandatory package, it can't be unselected"));
} elsif ($p->flag_installed && !$p->flag_upgrade) {
$o->ask_warn('', N("You can't unselect this package. It is already installed"));
} elsif ($p->flag_selected && $p->flag_installed) {
if ($::expert) {
$o->ask_yesorno('', N("This package must be upgraded.\nAre you sure you want to deselect it?")) or return;
return 1;
} else {
$o->ask_warn('', N("You can't unselect this package. It must be upgraded"));
}
} else { return 1 }
return;
},
auto_deps => N("Show automatically selected packages"),
interactive_help_id => 'choosePackagesTree',
ok => N("Install"),
cancel => N("<- Previous"),
icons => [ { icon => 'floppy',
help => N("Load/Save on floppy"),
wait_message => N("Updating package selection"),
code => sub { $o->loadSavePackagesOnFloppy($packages); 1 },
},
if_(0,
{ icon => 'feather',
help => N("Minimal install"),
code => sub {
install_any::unselectMostPackages($o);
pkgs::setSelectedFromCompssList($packages, { SYSTEM => 1 }, 4, $availableCorrected);
1;
} }),
],
state => {
auto_deps => 1,
flat => $limit_to_medium,
},
};
$o->ask_browse_tree_info('', N("Choose the packages you want to install"), $common);
}
#------------------------------------------------------------------------------
sub beforeInstallPackages {
my ($o) = @_;
$o->SUPER::beforeInstallPackages;
install_any::copy_advertising($o);
}
#------------------------------------------------------------------------------
sub installPackages {
my ($o, $packages) = @_;
my ($current_total_size, $last_size, $nb, $total_size, $start_time, $last_dtime, $_trans_progress_total);
my $w = ugtk2->new(N("Installing"));
$w->sync;
my $text = Gtk2::Label->new;
my ($advertising, $change_time, $i);
my $show_advertising if 0;
$show_advertising = to_bool(@install_any::advertising_images) if !defined $show_advertising;
my ($msg, $msg_time_remaining, $msg_time_total) = map { Gtk2::Label->new($_) } '', (N("Estimating")) x 2;
my ($progress, $progress_total) = map { Gtk2::ProgressBar->new } (1..2);
gtkadd($w->{window}, my $box = Gtk2::VBox->new(0,10));
$box->pack_end(gtkshow(gtkpack(Gtk2::VBox->new(0,5),
$msg, $progress,
create_packtable({},
[N("Time remaining "), $msg_time_remaining],
# [N("Total time "), $msg_time_total],
),
$text,
$progress_total,
gtkadd(create_hbox(),
my $cancel = Gtk2::Button->new(N("Cancel")),
my $details = Gtk2::Button->new(N("Details")),
),
)), 0, 1, 0);
$details->hide if !@install_any::advertising_images;
$w->sync;
$msg->set_label(N("Please wait, preparing installation..."));
gtkset_mousecursor_normal($cancel->window);
gtkset_mousecursor_normal($details->window);
my $advertize = sub {
@install_any::advertising_images or return;
$show_advertising ? $_->hide : $_->show foreach $msg, $progress, $text;
gtkdestroy($advertising) if $advertising;
if ($show_advertising && $_[0]) {
$change_time = time();
my $f = $install_any::advertising_images[$i++ % @install_any::advertising_images];
log::l("advertising $f");
my $pl = $f; $pl =~ s/\.png$/\.pl/;
my $icon_name = $f; $icon_name =~ s/\.png$/_icon\.png/;
my ($draw_text, $width, $height, @data, $icon, $icon_dx, $icon_dy, $icon_px);
-e $pl and $draw_text = 1;
eval(cat_($pl)) if $draw_text;
my $pix = gtkcreate_pixbuf($f);
$icon_px = gtkcreate_pixbuf($icon_name) if $icon;
my $dbl_area;
my $darea = Gtk2::DrawingArea->new;
gtkpack($box, $advertising = !$draw_text ?
gtkcreate_img($f) :
gtksignal_connect(gtkset_size_request($darea, $width, $height), expose_event => sub {
my (undef, undef, $dx, $dy) = $darea->allocation->values;
if (!defined($dbl_area)) {
$darea->window->draw_rectangle($darea->style->bg_gc('active'), 1, 0, 0, $dx, $dy);
$pix->render_to_drawable($darea->window, $darea->style->bg_gc('normal'), 0, 0,
($dx-$width)/2, 0, $width, $height, 'none', 0, 0);
my $yicon = 0;
my $decy = 0;
my $first = 1;
foreach (@data) {
my ($text, $x, $y, $area_width, $area_height, $bold) = @$_;
my ($width, $_height, $lines, $widths, $heights, $_ascents, $_descents) =
get_text_coord($text, $darea, $area_width, $area_height, 1, 0, 1, 1);
if ($first && $icon) {
my $iconx = ($dx-$width)/2 + $x + ${$widths}[0] - $icon_dx;
my $icony = $y + ${$heights}[0] - $icon_dy/2;
$icony > 0 or $icony = 0;
$icon_px->render_to_drawable($darea->window, $darea->style->bg_gc('normal'), 0, 0,
$iconx, $icony, $icon_dx, $icon_dy, 'none', 0, 0);
$yicon = $icony + $icon_dy;
}
my $i = 0;
$yicon > $y + ${$heights}[0] and $decy = $yicon - ($y + ${$heights}[$i]);
foreach (@{$lines}) {
my $layout = $darea->create_pango_layout($_);
my $draw_lay = sub {
my ($gc, $decx, $decy) = @_;
$darea->window->draw_layout($gc,
($dx-$width)/2 + $x + ${$widths}[$i] + $decx,
$y + ${$heights}[$i] + $decy,
$layout);
};
$draw_lay->($darea->style->black_gc, 0, 0);
$bold and $draw_lay->($darea->style->black_gc, 1, 0);
$layout->unref;
$i++;
}
$first = 0;
}
}
}));
} else {
$advertising = undef;
}
};
$cancel->signal_connect(clicked => sub { $pkgs::cancel_install = 1 });
$details->signal_connect(clicked => sub {
invbool \$show_advertising;
$details->set_label($show_advertising ? N("Details") : N("No details"));
$advertize->(1);
});
$advertize->();
my $oldInstallCallback = \&pkgs::installCallback;
local *pkgs::installCallback = sub {
my ($data, $type, $id, $subtype, $amount, $total) = @_;
if ($type eq 'user' && $subtype eq 'install') {
#- $amount and $total are used to return number of package and total size.
$nb = $amount;
$total_size = $total; $current_total_size = 0;
$start_time = time();
$msg->set_label(N("%d packages", $nb));
$w->flush;
} elsif ($type eq 'inst' && $subtype eq 'start') {
$progress->set_fraction(0);
my $p = $data->{depslist}[$id];
$msg->set_label(N("Installing package %s", $p->name));
$current_total_size += $last_size;
$last_size = $p->size;
$text->set_label((split /\n/, c::from_utf8($p->summary))[0] || '');
$advertize->(1) if $show_advertising && $total_size > 20_000_000 && time() - $change_time > 20;
$w->flush;
} elsif ($type eq 'inst' && $subtype eq 'progress') {
$progress->set_fraction($total ? $amount / $total : 0);
my $dtime = time() - $start_time;
my $ratio =
$total_size == 0 ? 0 :
pkgs::size2time($current_total_size + $amount, $total_size) / pkgs::size2time($total_size, $total_size);
$ratio >= 1 and $ratio = 1;
my $total_time = $ratio ? $dtime / $ratio : time();
$progress_total->set_fraction($ratio);
if ($dtime != $last_dtime && $current_total_size > 80_000_000) {
$msg_time_total->set_label(formatTime(10 * round($total_time / 10) + 10));
#- $msg_time_total->set_label(formatTimeRaw($total_time) . " " . formatTimeRaw($dtime / $ratio2));
$msg_time_remaining->set_label(formatTime(10 * round(max($total_time - $dtime, 0) / 10) + 10));
$last_dtime = $dtime;
}
$w->flush;
} else { goto $oldInstallCallback }
};
#- the modification is not local as the box should be living for other package installation.
undef *install_any::changeMedium;
*install_any::changeMedium = sub {
my ($method, $medium) = @_;
#- if not using a cdrom medium, always abort.
if ($method eq 'cdrom' && !$::oem) {
local $ugtk2::grab = 1;
my $name = pkgs::mediumDescr($o->{packages}, $medium);
local $| = 1; print "\a";
my $time = time();
my $r = $name !~ /commercial/i || ($o->{useless_thing_accepted2} ||= $o->ask_from_list_('', formatAlaTeX(install_messages::com_license()), [ N_("Accept"), N_("Refuse") ], "Accept") eq "Accept");
$r &&= $o->ask_okcancel('', N("Change your Cd-Rom!
Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done.
If you don't have it, press Cancel to avoid installation from this Cd-Rom.", $name), 1);
#- add the elapsed time (otherwise the predicted time will be rubbish)
$start_time += time() - $time;
return $r;
}
};
my $install_result;
catch_cdie { $install_result = $o->install_steps::installPackages($packages) }
sub {
if ($@ =~ /^error ordering package list: (.*)/) {
$o->ask_yesorno('', [
N("There was an error ordering packages:"), $1, N("Go on anyway?") ], 1) and return 1;
${$_[0]} = "already displayed";
} elsif ($@ =~ /^error installing package list: (.*)/) {
$o->ask_yesorno('', [
N("There was an error installing packages:"), $1, N("Go on anyway?") ], 1) and return 1;
${$_[0]} = "already displayed";
}
0;
};
if ($pkgs::cancel_install) {
$pkgs::cancel_install = 0;
die 'already displayed';
}
$w->destroy;
$install_result;
}
sub summary_prompt {
my ($o, $l, $check_complete) = @_;
my $w = ugtk2->new('');
my $set_entry_labels;
my @table;
my %group;
foreach my $e (@$l) {
$group{$e->{group}} ||= do {
push @table, [ gtkpack__(Gtk2::HBox->new(0, 0), $e->{group}), '' ];
};
$e->{widget} = Gtk2::Label->new;
$e->{widget}->set_property(wrap => 1);
$e->{widget}->set_size_request($::windowwidth * 0.65, -1);
push @table, [], [ gtkpack__(Gtk2::HBox->new(0, 30), '', $e->{widget}),
gtksignal_connect(Gtk2::Button->new(N("Configure")), clicked => sub {
$w->{rwindow}->hide;
$e->{clicked}();
$w->{rwindow}->show;
$set_entry_labels->();
}) ];
}
$set_entry_labels = sub {
foreach (@$l) {
my $t = $_->{val}() || '' . N("not configured") . '';
$_->{widget}->set_markup($_->{label} . ' - ' . $t);
}
};
$set_entry_labels->();
my $help_sub = $o->interactive_help_sub_display_id('summary');
gtkadd($w->{window},
gtkpack_(Gtk2::VBox->new(0,5),
1, create_scrolled_window(create_packtable({ mcc => 1 }, @table)),
0, $w->create_okcancel(undef, '', '', if_($help_sub, [ N("Help"), $help_sub, 1 ]))
));
$w->main($check_complete);
}
1;
ass="hl opt">::Common::System;
use common;
#-######################################################################################
#- Functions
#-######################################################################################
sub getopts {
my $o = shift;
my @r = map { '' } (@_ = split //, $_[0]);
while (1) {
local $_ = $o->[0];
$_ && /^-/ or return @r;
for (my $i = 0; $i < @_; $i++) { /$_[$i]/ and $r[$i] = $_[$i] }
shift @$o;
}
@r;
}
sub true() { exit 0 }
sub false() { exit 1 }
sub cat { @ARGV = @_; print while <> }
sub dirname_ { print dirname(@_), "\n" }
sub basename_ { print basename(@_), "\n" }
sub rmdir_ { foreach (@_) { rmdir $_ or die "rmdir: can't remove $_\n" } }
sub lsmod() { print "Module Size Used by\n"; cat("/proc/modules") }
sub which {
ARG: foreach (@_) { foreach my $c (split /:/, $ENV{PATH}) { -x "$c/$_" and print("$c/$_\n"), next ARG } }
}
sub grep_ {
my ($h, $v, $i) = getopts(\@_, qw(hvi));
@_ == 0 || $h and die "usage: grep <regexp> [files...]\n";
my $r = shift;
$r = qr/$r/i if $i;
@ARGV = @_; (/$r/ xor $v) and print while <>;
}
sub tr_ {
my ($s, $c, $d) = getopts(\@_, qw(s c d));
@_ >= 1 + (!$d || $s) or die "usage: tr [-c] [-s [-d]] <set1> <set2> [files...]\n or tr [-c] -d <set1> [files...]\n";
my $set1 = shift;
my $set2; !$d || $s and $set2 = shift;
@ARGV = @_;
eval "(tr/$set1/$set2/$s$d$c, print) while <>";
}
sub mount {
@_ or return cat("/proc/mounts");
my ($t, $r) = getopts(\@_, qw(tr));
my $fs = $t && shift;
@_ == 2 or die "usage: mount [-r] [-t <fs>] <device> <dir>\n",
" (use -r for readonly)\n",
" (if /dev/ is left off the device name, a temporary node will be created)\n";
my ($dev, $where) = @_;
$fs ||= $where =~ /:/ ? "nfs" :
$dev =~ /fd/ ? "vfat" : "ext2";
require fs;
require modules;
modules::load_dependencies("/modules/modules.dep");
fs::mount($dev, $where, $fs, $r);
}
sub umount {
@_ == 1 or die "umount expects a single argument\n";
require fs;
fs::umount($_[0]);
}
sub mkdir_ {
my ($_rec) = getopts(\@_, qw(p));
mkdir_p($_) foreach @_;
}
sub mknod {
if (@_ == 1) {
require devices;
eval { devices::make($_[0]) }; $@ and die "mknod: failed to create $_[0]\n";
} elsif (@_ == 4) {
require c;
my $mode = ${{ "b" => c::S_IFBLK(), "c" => c::S_IFCHR() }}{$_[1]} or die "unknown node type $_[1]\n";
syscall_('mknod', my $_a = $_[0], $mode | 0600, makedev($_[2], $_[3])) or die "mknod failed: $!\n";
} else { die "usage: mknod <path> [b|c] <major> <minor> or mknod <path>\n" }
}
sub ln {
my ($force, $soft) = getopts(\@_, qw(fs));
@_ >= 1 or die "usage: ln [-s] [-f] <source> [<dest>]\n";
my ($source, $dest) = @_;
$dest ||= basename($source);
$force and unlink $dest;
($soft ? symlink($source, $dest) : link($source, $dest)) or die "ln failed: $!\n";
}
sub rm {
my ($rec, undef) = getopts(\@_, qw(rf));
my $rm; $rm = sub {
foreach (@_) {
if (!-l $_ && -d $_) {
$rec or die "$_ is a directory\n";
&$rm(glob_($_));
rmdir $_ or die "can't remove directory $_: $!\n";
} else { unlink $_ or die "rm of $_ failed: $!\n" }
}
};
&$rm(@_);
}
sub chmod_ {
@_ >= 2 or die "usage: chmod <mode> <files>\n";
my $mode = shift;
$mode =~ /^[0-7]+$/ or die "illegal mode $mode\n";
foreach (@_) { chmod oct($mode), $_ or die "chmod failed $_: $!\n" }
}
sub chown_ {
my ($rec, undef) = getopts(\@_, qw(r));
local $_ = shift or die "usage: chown [-r] name[.group] <files>\n";
my ($name, $group) = (split('\.'), $_);
my ($uid, $gid) = (getpwnam($name) || $name, getgrnam($group) || $group);
my $chown; $chown = sub {
foreach (@_) {
chown $uid, $gid, $_ or die "chown of file $_ failed: $!\n";
-d $_ && $rec and &$chown(glob_($_));
}
};
&$chown(@_);
}
sub swapon {
@_ == 1 or die "swapon <file>\n";
require swap;
swap::swapon($_[0]);
}
sub swapoff {
@_ == 1 or die "swapoff <file>\n";
require swap;
swap::swapoff($_[0]);
}
sub uncpio {
@_ and die "uncpio reads from stdin\n";
# cpioInstallArchive(gzdopen(0, "r"), NULL, 0, NULL, NULL, &fail);
}
sub rights {
my $r = '-' x 9;
my @rights = (qw(x w r x w r x w r), ['t', 0], ['s', 3], ['s', 6]);
for (my $i = 0; $i < @rights; $i++) {
if (vec(pack("S", $_[0]), $i, 1)) {
my ($val, $place) = $i >= 9 ? @{$rights[$i]} : ($rights[$i], $i);
my $old = \substr($r, 8 - $place, 1);
$$old = $$old eq '-' && $i >= 9 ? uc $val : $val;
}
}
my @types = split //, "_pc_d_b_-_l_s";
$types[($_[0] >> 12) & 0xf] . $r;
}
sub displaySize {
my $m = $_[0] >> 12;
$m == 4 || $m == 8 || $m == 10;
}
sub ls {
my ($l, $h) = getopts(\@_, qw(lh));
$h and die "usage: ls [-l] <files...>\n";
@_ or @_ = '.';
@_ == 1 && -d $_[0] and @_ = glob_($_[0]);
foreach (sort @_) {
if ($l) {
my @s = lstat or warn("can't stat file $_\n"), next;
formline(
"@<<<<<<<<< @<<<<<<< @<<<<<<< @>>>>>>>> @>>>>>>>>>>>>>>> @*\n",
rights($s[2]), getpwuid $s[4] || $s[4], getgrgid $s[5] || $s[5],
displaySize($s[2]) ? $s[7] : join(", ", unmakedev($s[6])),
scalar localtime $s[9], -l $_ ? "$_ -> " . readlink $_ : $_);
print $^A; $^A = '';
} else { print "$_\n" }
}
}
sub cp {
@_ >= 2 or die "usage: cp <sources> <dest>\n(this cp does -Rfl by default)\n";
cp_af(@_);
}
sub ps {
@_ and die "usage: ps\n";
my ($pid, $rss, $cpu, $cmd);
my ($uptime) = split ' ', first(cat_("/proc/uptime"));
my $hertz = 100;
require c;
my $page = c::getpagesize() / 1024;
open PS, ">&STDOUT"; #- PS must be not be localised otherwise the "format PS" fails
format PS_TOP =
PID RSS %CPU CMD
.
format PS =
@>>>> @>>>> @>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$pid, $rss, $cpu, $cmd
.
foreach (sort { $a <=> $b } grep { /\d+/ } all('/proc')) {
$pid = $_;
my @l = split(' ', cat_("/proc/$pid/stat"));
$cpu = sprintf "%2.1f", max(0, min(99, ($l[13] + $l[14]) * 100 / $hertz / ($uptime - $l[21] / $hertz)));
$rss = (split ' ', cat_("/proc/$pid/stat"))[23] * $page;
($cmd = cat_("/proc/$pid/cmdline")) =~ s/\0/ /g;
$cmd ||= (split ' ', (cat_("/proc/$pid/stat"))[0])[1];
write PS;
}
}
sub dd {
my $u = "usage: dd [-h] [-p] [if=<file>] [of=<file>] [bs=<number>] [count=<number>]\n";
my ($help, $percent) = getopts(\@_, qw(hp));
die $u if $help;
my %h = (if => *STDIN, of => *STDOUT, bs => 512, count => undef);
foreach (@_) {
/(.*?)=(.*)/ && exists $h{$1} or die $u;
$h{$1} = $2;
}
local (*IF, *OF); my ($tmp, $nb, $read);
ref($h{if}) eq 'GLOB' ? (*IF = $h{if}) : sysopen(IF, $h{if}, 0) || die "error: can't open file $h{if}\n";
ref($h{of}) eq 'GLOB' ? (*OF = $h{of}) : sysopen(OF, $h{of}, 0x41) || die "error: can't open file $h{of}\n";
$h{bs} = removeXiBSuffix($h{bs});
for ($nb = 0; !$h{count} || $nb < $h{count}; $nb++) {
printf "\r%02.1d%%", 100 * $nb / $h{count} if $h{count} && $percent;
$read = sysread(IF, $tmp, $h{bs}) or ($h{count} ? die "error: can't read block $nb\n" : last);
syswrite(OF, $tmp) or die "error: can't write block $nb\n";
$read < $h{bs} and $read = 1, last;
}
print STDERR "\r$nb+$read records in\n";
print STDERR "$nb+$read records out\n";
}
sub head_tail {
my ($h, $n) = getopts(\@_, qw(hn));
$h || @_ < to_bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n";
$n = $n ? shift : 10;
my $fh; @_ ? open($fh, $_[0]) || die "error: can't open file $_[0]\n" : ($fh = *STDIN);
if ($0 eq 'head') {
local $_;
while (<$fh>) { $n-- or return; print }
} else {
@_ = ();
local $_;
while (<$fh>) { push @_, $_; @_ > $n and shift }
print @_;
}
}
sub head { $0 = 'head'; &head_tail }
sub tail { $0 = 'tail'; &head_tail }
sub strings {
my ($h, $o, $n) = getopts(\@_, qw(hon));
$h and die "usage: strings [-o] [-n min-length] [<files>]\n";
$n = $n ? shift : 4;
$/ = "\0"; @ARGV = @_; my $l = 0;
local $_;
while (<>) {
while (/[$printable_chars]{$n,}/og) {
printf "%07d ", ($l + length $') if $o;
print "$&\n";
}
$l += length;
} continue { $l = 0 if eof }
}
sub hexdump {
my $i = 0; $/ = \16; @ARGV = @_;
local $_;
while (<>) {
printf "%08lX ", $i; $i += 16;
print join(" ", (map { sprintf "%02X", $_ } unpack("C*", $_)),
(s/[^$printable_chars]/./og, $_)[1]), "\n";
}
}
sub more {
@ARGV = @_;
require devices;
my $tty = devices::make('tty');
my $n = 0;
open(my $IN, $tty) or die "can't open $tty\n";
local $_;
while (<>) {
if (++$n == 25) {
my $v = <$IN>;
$v =~ /^q/ and exit 0;
$n = 0;
}
print
}
}
sub insmod {
my ($h) = getopts(\@_, qw(h));
$h || @_ == 0 and die "usage: insmod <module> [options]\n";
my $f = shift;
require run_program;
require modules;
if (! -r $f) {
my $name = basename($f);
$name =~ s/\.k?o$//;
($f) = modules::extract_modules('/tmp', $name);
}
if (! -r $f) {
die "can't find module $f\n";
}
run_program::run(["/usr/bin/insmod_", "insmod"], "-f", $f, @_) or die("insmod $f failed");
unlink $f;
}
sub modprobe {
my ($h) = getopts(\@_, qw(h));
$h || @_ == 0 and die "usage: modprobe <module> [options]\n";
my $name = shift;
require modules;
modules::load_dependencies("/modules/modules.dep");
modules::load([ $name, @_ ]);
}
sub route {
@_ == 0 or die "usage: route\nsorry, no modification handled\n";
my ($titles, @l) = cat_("/proc/net/route");
my @titles = split ' ', $titles;
my %l;
open ROUTE, ">&STDOUT"; #- ROUTE must be not be localised otherwise the "format ROUTE" fails
format ROUTE_TOP =
Destination Gateway Mask Iface
.
format ROUTE =
@<<<<<<<<<<<< @<<<<<<<<<<<< @<<<<<<<<<<<< @<<<<<<<
$l{Destination}, $l{Gateway}, $l{Mask}, $l{Iface}
.
foreach (@l) {
/^\s*$/ and next;
@l{@titles} = split;
$_ = join ".", reverse map { hex $_ } unpack "a2a2a2a2", $_ foreach @l{qw(Destination Gateway Mask)};
$l{Destination} = 'default' if $l{Destination} eq "0.0.0.0";
$l{Gateway} = '*' if $l{Gateway} eq "0.0.0.0";
write ROUTE;
}
}