summaryrefslogtreecommitdiffstats
path: root/perl-install/standalone
diff options
context:
space:
mode:
authorMystery Man <unknown@mandriva.org>2004-11-06 08:30:59 +0000
committerMystery Man <unknown@mandriva.org>2004-11-06 08:30:59 +0000
commit42e38e074bf1200783849ea85e205e6614f988d7 (patch)
tree3c218a7ef3c66c8064eb2f6fa84ef44cef7b55a6 /perl-install/standalone
parenta4a67fd68bcffc42eb98871618c8f07b55157d5e (diff)
downloaddrakx-topic/a.tar
drakx-topic/a.tar.gz
drakx-topic/a.tar.bz2
drakx-topic/a.tar.xz
drakx-topic/a.zip
This commit was manufactured by cvs2svn to create branch 'a'.topic/a
Diffstat (limited to 'perl-install/standalone')
-rw-r--r--perl-install/standalone/.perl_checker1
-rwxr-xr-xperl-install/standalone/XFdrake106
-rwxr-xr-xperl-install/standalone/adduserdrake31
-rwxr-xr-xperl-install/standalone/autosetupprintqueues51
-rwxr-xr-xperl-install/standalone/bootloader-config188
-rwxr-xr-xperl-install/standalone/diskdrake126
-rwxr-xr-xperl-install/standalone/drakTermServ2017
-rwxr-xr-xperl-install/standalone/drakauth42
-rwxr-xr-xperl-install/standalone/drakautoinst373
-rwxr-xr-xperl-install/standalone/drakbackup4387
-rwxr-xr-xperl-install/standalone/drakboot334
-rwxr-xr-xperl-install/standalone/drakbug296
-rwxr-xr-xperl-install/standalone/drakbug_report15
-rwxr-xr-xperl-install/standalone/drakclock397
-rwxr-xr-xperl-install/standalone/drakconnect1061
-rw-r--r--perl-install/standalone/drakedm85
-rwxr-xr-xperl-install/standalone/drakfirewall32
-rwxr-xr-xperl-install/standalone/drakfloppy341
-rwxr-xr-xperl-install/standalone/drakfont796
-rwxr-xr-xperl-install/standalone/drakgw613
-rw-r--r--perl-install/standalone/drakhelp48
-rwxr-xr-xperl-install/standalone/drakperm433
-rwxr-xr-xperl-install/standalone/drakproxy34
-rwxr-xr-xperl-install/standalone/drakpxe515
-rwxr-xr-xperl-install/standalone/drakroam397
-rwxr-xr-xperl-install/standalone/draksec364
-rwxr-xr-xperl-install/standalone/draksound61
-rwxr-xr-xperl-install/standalone/draksplash558
-rw-r--r--perl-install/standalone/draksplash2351
-rwxr-xr-xperl-install/standalone/drakupdate_fstab201
-rwxr-xr-xperl-install/standalone/drakups412
-rw-r--r--perl-install/standalone/drakvpn1150
-rwxr-xr-xperl-install/standalone/drakxservices18
-rwxr-xr-xperl-install/standalone/drakxtv151
-rwxr-xr-xperl-install/standalone/fileshareset384
-rwxr-xr-xperl-install/standalone/harddrake2529
-rw-r--r--perl-install/standalone/icons/categ.pngbin5173 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakconnect.pngbin4854 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakfirewall.pngbin3052 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakfont.pngbin2965 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakgw.pngbin3391 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakups.pngbin3214 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakvpn.pngbin3313 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/eth_card_mini2.pngbin1538 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/fileopen.xpm34
-rw-r--r--perl-install/standalone/icons/find.xpm34
-rw-r--r--perl-install/standalone/icons/findf.xpm31
-rw-r--r--perl-install/standalone/icons/ftin.xpm30
-rw-r--r--perl-install/standalone/icons/ftout.xpm30
-rw-r--r--perl-install/standalone/icons/gmon.pngbin17411 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/cd.pngbin834 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/cpu.pngbin566 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/floppy.pngbin730 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/harddisk.pngbin725 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/harddrake.pngbin970 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/hw_mouse.pngbin751 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/hw_network.pngbin922 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/hw_printer.pngbin603 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/ide_hd.pngbin725 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/isdn.pngbin710 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/joystick.pngbin730 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/keyboard.pngbin533 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/memory.pngbin675 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/menu/harddrake-menu16.pngbin970 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/menu/harddrake-menu32.pngbin2447 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/menu/harddrake-menu48.pngbin4214 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/modem.pngbin847 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/multimedia.pngbin1010 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/scanner.pngbin809 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/scsi.pngbin275 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/scsi_hd.pngbin725 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/sound.pngbin1042 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/tape.pngbin920 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/tv.pngbin647 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/unknown.pngbin858 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/ups.pngbin699 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/usb.pngbin316 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/video.pngbin806 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/webcam.pngbin842 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/hori.pngbin7232 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic-drakfont-48.pngbin3290 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-CD-40.pngbin3436 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-back-up-16.pngbin1027 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-back-up-32.pngbin2977 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-back-up-48.pngbin4565 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-discdurwhat-40.pngbin2023 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-dossier-32.pngbin1858 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-moreoption-40.pngbin2354 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-network-40.pngbin2145 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-others-40.pngbin2023 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-system-40.pngbin2370 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-users-40.pngbin1638 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-when-40.pngbin2933 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-where-40.pngbin2514 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/localedrake-16.pngbin1327 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/localedrake-32.pngbin1991 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/localedrake-48.pngbin3087 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/logdrake.pngbin1760 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/mdk_logo.pngbin15639 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/net_c.pngbin3198 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/net_d.pngbin3192 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/net_u.pngbin2866 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/non-editable.pngbin872 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/printerdrake.pngbin1602 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/reload.xpm31
-rw-r--r--perl-install/standalone/icons/scannerdrake.pngbin2669 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/smbnfs_default.pngbin260 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/smbnfs_has_mntpoint.pngbin287 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/smbnfs_mounted.pngbin282 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/smbnfs_server.pngbin314 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/tradi.pngbin32579 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/verti.pngbin21123 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/wiz_default_up.pngbin2686 -> 0 bytes
-rw-r--r--perl-install/standalone/interactive_http/Makefile21
-rw-r--r--perl-install/standalone/interactive_http/authorised_progs12
-rw-r--r--perl-install/standalone/interactive_http/index.html.pl14
-rwxr-xr-xperl-install/standalone/interactive_http/interactive_http.cgi95
-rw-r--r--perl-install/standalone/interactive_http/miniserv.conf13
-rw-r--r--perl-install/standalone/interactive_http/miniserv.init60
-rw-r--r--perl-install/standalone/interactive_http/miniserv.logrotate7
-rw-r--r--perl-install/standalone/interactive_http/miniserv.pam5
-rw-r--r--perl-install/standalone/interactive_http/miniserv.pem18
-rw-r--r--perl-install/standalone/interactive_http/miniserv.pl1817
-rw-r--r--perl-install/standalone/interactive_http/miniserv.users1
-rwxr-xr-xperl-install/standalone/keyboarddrake50
-rwxr-xr-xperl-install/standalone/listsupportedprinters64
-rw-r--r--perl-install/standalone/localedrake70
-rwxr-xr-xperl-install/standalone/logdrake517
-rwxr-xr-xperl-install/standalone/lsnetdrake27
-rw-r--r--perl-install/standalone/man/C/man5/drakbackup.conf.5180
-rw-r--r--perl-install/standalone/man/C/man8/drakconnect.8109
-rwxr-xr-xperl-install/standalone/mousedrake74
-rw-r--r--perl-install/standalone/net_applet173
-rwxr-xr-xperl-install/standalone/net_monitor593
-rwxr-xr-xperl-install/standalone/printerdrake589
-rwxr-xr-xperl-install/standalone/scannerdrake950
-rwxr-xr-xperl-install/standalone/service_harddrake212
-rw-r--r--perl-install/standalone/service_harddrake.sh54
-rw-r--r--perl-install/standalone/service_harddrake_confirm9
139 files changed, 0 insertions, 22822 deletions
diff --git a/perl-install/standalone/.perl_checker b/perl-install/standalone/.perl_checker
deleted file mode 100644
index 202e0535f..000000000
--- a/perl-install/standalone/.perl_checker
+++ /dev/null
@@ -1 +0,0 @@
-Basedir ..
diff --git a/perl-install/standalone/XFdrake b/perl-install/standalone/XFdrake
deleted file mode 100755
index ee5fda955..000000000
--- a/perl-install/standalone/XFdrake
+++ /dev/null
@@ -1,106 +0,0 @@
-#!/usr/bin/perl
-
-# XFdrake
-# Copyright (C) 1999-2004 Mandrakesoft (pixel@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use Xconfig::main;
-use Xconfig::xfree;
-use Xconfig::default;
-use interactive;
-use modules;
-use common;
-use any;
-use c;
-
-local $_ = join '', @ARGV;
-
-my ($configure_this) = grep { !/^-/ } @ARGV;
-$configure_this = 'resolution' if $0 =~ /Xdrakres/;
-$configure_this ||= 'everything';
-
-{
- my $in = 'interactive'->vnew('su');
-
- my $rc = do {
- my $options = { allowFB => listlength(cat_("/proc/fb")) };
-
- if ($configure_this eq 'everything') {
- check_XFree($in);
- Xconfig::main::configure_everything_or_configure_chooser($in, $options, $::auto);
- } elsif ($configure_this eq 'auto_install') {
- Xconfig::main::configure_everything_auto_install(Xconfig::default::configure(), $in->do_pkgs, {}, $options);
- } elsif ($configure_this eq 'monitor') {
- Xconfig::main::configure_monitor($in, Xconfig::xfree->read);
- } elsif ($configure_this eq 'resolution') {
- Xconfig::main::configure_resolution($in, Xconfig::xfree->read);
- }
- };
- ask_for_X_restart($in) if $rc;
-
- $in->exit(0);
-}
-
-sub check_XFree {
- my ($in) = @_;
-
- #- set the standard configuration
- foreach ('XF86Config', 'XF86Config-4') {
- my $f = "/etc/X11/$_";
- symlinkf("$_.standard", $f) if -l $f && -e "$f.standard";
- }
-
- my $f = "/usr/X11R6/lib/X11/rgb.txt"; #- this one is on all platform
- -e $f or $in->do_pkgs->install('xorg-x11', 'xorg-x11-75dpi-fonts');
- -e $f or die "install Xorg first!\n";
-
- system("mount /proc 2>/dev/null"); # ensure /proc is mounted for pci probing
-}
-
-sub ask_for_X_restart {
- my ($in) = @_;
-
- $::isStandalone && $in->isa('interactive::gtk') or return;
-
- my ($wm, $pid) = any::running_window_manager();
-
- if (!$wm) {
- $in->ask_warn('', N("Please log out and then use Ctrl-Alt-BackSpace"));
- return;
- }
-
- $in->ask_okcancel('', N("You need to log out and back in again for changes to take effect"), 1) or return;
-
- if (fork()) {
- any::ask_window_manager_to_logout($wm);
- return;
- }
-
- open STDIN, "</dev/zero";
- open STDOUT, ">/dev/null";
- open STDERR, ">&STDERR";
- c::setsid();
- exec 'perl', '-e', q(
- my ($wm, $pid) = @ARGV;
- my $nb;
- for ($nb = 30; $nb && -e "/proc/$pid"; $nb--) { sleep 1 }
- system("killall X") if $nb;
- ), $wm, $pid;
-}
diff --git a/perl-install/standalone/adduserdrake b/perl-install/standalone/adduserdrake
deleted file mode 100755
index 40659017f..000000000
--- a/perl-install/standalone/adduserdrake
+++ /dev/null
@@ -1,31 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use interactive;
-use any;
-
-my $isMD5 = cat_("/etc/pam.d/system-auth") =~ /md5/;
-my $isShadow = cat_("/etc/pam.d/system-auth") =~ /shadow/;
-
-
-my $users = [];
-my $in;
-
-if (my @l = grep { ! /^-/ } @ARGV) {
- $users = [ map { { name => $_, realname => $_ } } @l ];
-} else {
- $in = 'interactive'->vnew('su');
- any::ask_users($in, $users, $ENV{SECURE_LEVEL}, []);
-}
-
-system("adduser", $_->{name}) foreach @$users;
-any::write_passwd_user($_, $isMD5) foreach @$users;
-system("pwconv") if $isShadow;
-
-any::addUsers($users);
-
-$in->exit(0) if $in;
diff --git a/perl-install/standalone/autosetupprintqueues b/perl-install/standalone/autosetupprintqueues
deleted file mode 100755
index 85a688af5..000000000
--- a/perl-install/standalone/autosetupprintqueues
+++ /dev/null
@@ -1,51 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2003-2004 Mandrakesoft
-#
-# Till Kamppeter <till@mandrakesoft.com>
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License Version 2 as
-# published by the Free Software Foundation.
-#
-# 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-use printer::printerdrake;
-use printer::main;
-
-# Data structure for printer data
-my $printer;
-
-# Dummy variable needed to call the subroutines of the printerdrak.pm module
-# The real data structure is not needed for non-interactive mode
-my $in;
-
-# Run the subroutines of printerdrake.pm in non-interactive non-X mode
-$::noX = 1;
-
-# Do not let printerdrake ask for the spooler
-$printer->{SPOOLER} ||= 'cups';
-
-# Were we in expert mode last time?
-$printer->{expert} = printer::main::get_usermode();
-
-# Do not auto-install queues in expert mode
-exit 0 if $printer->{expert};
-
-# Get info about already installed print queues
-eval { $printer = printer::main::getinfo('') };
-
-# Run the automatic, non-interactive print queue setup of printerdrake
-printer::printerdrake::init($printer, $in);
-
diff --git a/perl-install/standalone/bootloader-config b/perl-install/standalone/bootloader-config
deleted file mode 100755
index 0bcd4d377..000000000
--- a/perl-install/standalone/bootloader-config
+++ /dev/null
@@ -1,188 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-use Getopt::Long;
-
-use common;
-use bootloader;
-
-$::isStandalone = 1; #- not using standalone which messes with @ARGV and usage
-
-my %options = (
- 'action=s' => \ (my $action),
-
- 'label=s' => \ (my $label),
-
- 'chainload=s' => \ (my $chainload),
-
- 'image=s' => \ (my $image),
- 'kernel-version=s' => \ (my $kernel_version),
-
- 'initrd-options=s' => \ (my $initrd_options),
- 'no-short-name' => \ (my $no_short_name),
- 'no-entry' => \ (my $no_entry),
- 'no-launch' => \ (my $no_launch),
- 'no-initrd' => \ (my $no_initrd),
- );
-
-GetOptions(%options) or die <<'EOF';
-usage: bootloader-config --action add-kernel (--image <vmlinuz> | --kernel-version <2.6.xxx>) [--label <...>] [--no-short-name] [--initrd-options <options>]
- bootloader-config --action remove-kernel (--image <vmlinuz> | --kernel-version <2.6.xxx>)
-
- bootloader-config --action add-entry (--image <image> | --chainload <device>) --label <...>
- bootloader-config --action remove-entry (--image <image> | --chainload <device> | --label <...>)
-
- bootloader-config --action update-splash
- bootloader-config --action remove-splash
-EOF
-
-my @known_actions = qw(add-kernel remove-kernel update-splash remove-splash detectloader add-entry remove-entry);
-$action && member($action, @known_actions) or die "<action> must be one of " . join(' ', @known_actions) . "\n";
-
-if ($image) {
- if (my $ver = bootloader::vmlinuz2version($image)) {
- if ($kernel_version) {
- $kernel_version eq $ver or die "$kernel_version and $ver don't match (hint: don't pass both --image and --kernel-version)\n";
- } else {
- $kernel_version = $ver;
- }
- }
- $image = "/boot/$image" if $image !~ m!^/!;
-} elsif ($kernel_version) {
- $image = "/boot/vmlinuz-$kernel_version";
-}
-
-
-my $all_hds = fsedit::get_hds();
-fs::get_info_from_fstab($all_hds);
-
-my $bootloader = bootloader::read($all_hds) or die "Cannot find a boot loader installed\n";
-
-
-$action =~ s/-/_/g;
-$::{$action}->();
-
-
-#-###############################################################################
-sub remove_now_broken_boot_symlinks() {
- foreach (glob("/boot/vmlinuz*"), glob("/boot/initrd*")) {
- -l $_ && !-e $_ or next;
- log::l("removing now broken symlink $_");
- unlink $_;
- }
-}
-sub remove_kernel() {
- unlink "/lib/modules/$kernel_version/build";
- remove_now_broken_boot_symlinks();
-
- my %proposed_labels;
- my @new_entries;
-
- my ($to_remove, $to_keep) = partition {
- if ($_->{kernel_or_dev} && $_->{kernel_or_dev} eq $image) {
- 1;
- } else {
- my $vmlinuz = $_->{kernel_or_dev} && bootloader::expand_vmlinuz_symlink($_->{kernel_or_dev});
- if ($vmlinuz && "/boot/$vmlinuz" eq $image) {
- if (!%proposed_labels) {
- %proposed_labels = bootloader::get_kernels_and_labels_before_kernel_remove($vmlinuz);
- }
- if (my $proposed = $proposed_labels{$_->{label}}) {
- my %to_add = %$_;
- put_in_hash(\%to_add, $proposed);
- push @new_entries, \%to_add;
- }
- 1;
- } else {
- 0;
- }
- }
- } @{$bootloader->{entries}};
-
- $_->{initrd} && unlink $_->{initrd} foreach @$to_remove;
-
- @{$bootloader->{entries}} = @$to_keep;
-
- foreach (@new_entries) {
- bootloader::add_kernel($bootloader, $_, {});
- }
-
- modify_bootloader();
-}
-
-
-#-###############################################################################
-sub add_kernel() {
- bootloader::create_link_source();
-
- my $kernel_str = bootloader::vmlinuz2kernel_str($image) or die "bad kernel name $image\n";
-
- my $root_part = fs::get::root([ fs::get::fstab($all_hds) ]) or die "can't find root partition\n";
- my %opts = (
- root => "/dev/$root_part->{device}",
- initrd_options => $initrd_options,
- if_($label, label => $label),
- if_($bootloader->{default_vga}, vga => $bootloader->{default_vga}),
- );
- #- short name
- bootloader::add_kernel($bootloader, $kernel_str, { %opts }, 0, $no_initrd) if !$no_short_name;
-
- #- long name
- $kernel_str->{use_long_name} = 1;
- bootloader::add_kernel($bootloader, $kernel_str, { %opts }, 1, $no_initrd);
-
- modify_bootloader();
-}
-
-sub modify_bootloader() {
- !$no_entry or return;
-
- bootloader::action($bootloader, 'write', $all_hds);
- bootloader::action($bootloader, 'when_config_changed') if !$no_launch;
-}
-
-#-###############################################################################
-sub add_entry() {
- $label or die "you must give a label\n";
- ($image xor $chainload) or die "you must give an image or a chainload\n";
-
- my $entry = {
- type => $image ? 'image' : 'other',
- label => $label,
- kernel_or_dev => $image || $chainload,
- };
- bootloader::add_entry($bootloader, $entry);
- modify_bootloader();
-}
-
-sub remove_entry() {
- listlength(grep { $_ } $label, $image, $chainload) == 1 or die "you must give one of --label, --image and --chainload\n";
-
- my $e = $label ? bootloader::get_label($label, $bootloader) :
- find { $_->{kernel_or_dev} && $_->{kernel_or_dev} eq ($image || $chainload) } @{$bootloader->{entries}};
-
- if ($e) {
- @{$bootloader->{entries}} = grep { $_ != $e } @{$bootloader->{entries}};
- }
-
- modify_bootloader();
-}
-
-#-###############################################################################
-sub update_splash() {
- foreach (@{$bootloader->{entries}}) {
- bootloader::add_boot_splash($_->{initrd}, $_->{vga}) if $_->{initrd};
- }
- bootloader::action($bootloader, 'when_config_changed') if !$no_launch;
-}
-
-sub remove_splash() {
- foreach (@{$bootloader->{entries}}) {
- bootloader::remove_boot_splash($_->{initrd}) if $_->{initrd};
- }
- bootloader::action($bootloader, 'when_config_changed') if !$no_launch;
-}
-
-sub detectloader() {
- print uc(bootloader::main_method($bootloader->{method})), "\n" if $bootloader;
-}
diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake
deleted file mode 100755
index 77d30bedc..000000000
--- a/perl-install/standalone/diskdrake
+++ /dev/null
@@ -1,126 +0,0 @@
-#!/usr/bin/perl
-
-# DiskDrake
-# Copyright (C) 1999-2004 Mandrakesoft (pixel@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-# DiskDrake uses resize_fat which is a perl rewrite of the work of Andrew
-# Clausen (libresize).
-# DiskDrake is also based upon the libfdisk and the install from Red Hat Software
-
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use interactive;
-use detect_devices;
-use fsedit;
-use fs;
-use log;
-use c;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/diskdrake_hd.png";
-
-my %options;
-my @l = @ARGV;
-while (my $e = shift @l) {
- my ($option) = $e =~ /--?(.*)/ or next;
- if ($option =~ /(.*?)=(.*)/) {
- $options{$1} = $2;
- } else {
- $options{$option} = '';
- }
-}
-
-my @types = qw(hd nfs smb dav removable fileshare list-hd change-geometry);
-my ($type, $para) = ('hd', '');
-foreach (@types) {
- if (exists $options{$_}) {
- $para = delete $options{$_};
- $type = $_;
- last;
- }
-}
-keys %options and die "usage: diskdrake [--expert] [--testing] [--{" . join(",", @types) . "}]\n";
-
-if ($>) {
- $ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";
-}
-
-
-my $in = 'interactive'->vnew('su');
-
-if ($type eq 'fileshare') {
- require any;
- any::fileshare_config($in, '');
- $in->exit(0);
-}
-
-my $all_hds = fsedit::get_hds({}, $in);
-
-fs::get_raw_hds('', $all_hds);
-
-fs::get_info_from_fstab($all_hds);
-fs::merge_info_from_mtab([ fs::get::really_all_fstab($all_hds) ]);
-
-$all_hds->{current_fstab} = fs::fstab_to_string($all_hds, '');
-
-if ($type eq 'list-hd') {
- print partition_table::description($_), "\n" foreach fs::get::fstab($all_hds);
-} elsif ($type eq 'change-geometry') {
- $para =~ s|^/dev/||;
- my ($device, undef, $heads, $sectors) = $para =~ /(.+)=(\d+,)?(\d+),(\d+)$/ or die "usage: diskdrake --change-geometry=<device>=[<cylinders>,]<heads>,<sectors>\n";
- my $hd = find { $_->{device} eq $device } @{$all_hds->{hds}};
- put_in_hash($hd->{geom}, { heads => $heads, sectors => $sectors });
- $hd->{isDirty} = 1;
- partition_table::write($hd);
-} elsif ($type eq 'hd') {
- require diskdrake::interactive;
- diskdrake::interactive::main($in, $all_hds, 0, '', sub {
- exec("drakhelp --id diskdrake") unless fork() });
-} elsif ($type eq 'removable') {
- require diskdrake::removable;
- $para =~ s|^/dev/||;
- my ($raw_hd) = $para ?
- first(grep { $para eq $_->{device} } @{$all_hds->{raw_hds}}) || die "unknown removable $para\n" :
- $in->ask_from_listf('', '', \&diskdrake::interactive::format_raw_hd_info, $all_hds->{raw_hds}) or $in->exit(0);
-
- if (!$raw_hd->{mntpoint}) {
- my $mntpoint = detect_devices::suggest_mount_point($raw_hd);
- $raw_hd->{mntpoint} ||= find { !fs::get::has_mntpoint($_, $all_hds) } map { "/mnt/$mntpoint$_" } '', 2 .. 10;
- $raw_hd->{is_removable} = 1; #- force removable flag
-
- my $useSupermount = 'magicdev';
- require security::level;
- require lang;
- fs::mount_options::set_default($raw_hd,
- useSupermount => $useSupermount,
- security => security::level::get(),
- lang::fs_options(lang::read()));
- }
- diskdrake::removable::main($in, $all_hds, $raw_hd);
-} elsif ($type eq 'dav') {
- require diskdrake::dav;
- diskdrake::dav::main($in, $all_hds);
-} else {
- $in->ask_warn('', "Sorry only a gtk frontend is available") if !$in->isa('interactive::gtk');
- require diskdrake::smbnfs_gtk;
- diskdrake::smbnfs_gtk::main($in, $all_hds, $type);
-}
-
-$in->exit(0);
diff --git a/perl-install/standalone/drakTermServ b/perl-install/standalone/drakTermServ
deleted file mode 100755
index d438055ee..000000000
--- a/perl-install/standalone/drakTermServ
+++ /dev/null
@@ -1,2017 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2002-2004 by Mandrakesoft (sbenedict@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use strict;
-
-use interactive;
-use ugtk2 qw(:helpers :wrappers :create);
-use common;
-use run_program;
-use bootloader;
-use MDK::Common::File qw(:all);
-
-use Config;
-use POSIX;
-
-my $in = 'interactive'->vnew('su');
-
-my @buff; #- used to display status info
-
-my $central_widget;
-my $window1;
-my $status_box;
-my $main_box;
-my $wizard_buttons;
-my $previous_button;
-my $cancel_button;
-my $next_button;
-my $main_buttons;
-my $in_wizard = 0;
-my $config_written = 0;
-my $clients_set = 0;
-my @nothing = (0..10);
-my %conf;
-$conf{ALLOW_THIN} = 0;
-$conf{CREATE_PXE} = 0;
-
-my $nfs_subnet;
-my $nfs_mask;
-my $cfg_dir = "/etc/drakxtools/draktermserv/";
--e $cfg_dir or mkdir_p($cfg_dir);
-my $cfg_file = $cfg_dir . "draktermserv.conf";
-my $interface = get_net_interface();
-my $server_ip = get_ip_from_sys();
-my $changes_made = 0;
-my $client_cfg = "/etc/dhcpd.conf.etherboot.clients";
-my $tftpboot = "/var/lib/tftpboot";
-my @kernels = bootloader::installed_vmlinuz();
-my $cmd_line = 1;
-
-#- make sure terminal server and friends are installed
-my $ts = system("rpm -q terminal-server > /dev/null");
-if ($ts == 256) {
- if ($ENV{DISPLAY}) {
- system("urpmi --X terminal-server > /dev/null");
- } else {
- system("urpmi terminal-server > /dev/null");
- }
- $ts = system("rpm -q terminal-server > /dev/null");
- if ($ts == 256 && !$::testing) {
- warn(N("Useless without Terminal Server"));
- exit(1);
- }
-}
-
-if ("@ARGV" =~ /--enable/) {
- enable_ts();
- exit(0);
-}
-
-if ("@ARGV" =~ /--disable/) {
- disable_ts();
- exit(0);
-}
-
-if ("@ARGV" =~ /--restart/) {
- stop_ts();
- start_ts();
- exit(0);
-}
-
-if ("@ARGV" =~ /--start/) {
- start_ts();
- exit(0);
-}
-
-if ("@ARGV" =~ /--stop/) {
- stop_ts();
- exit(0);
-}
-
-if ("@ARGV" =~ /--adduser/) {
- die N("%s: %s requires a username...\n", $0, $ARGV[0]) if $#ARGV < 1;
- adduser($ARGV[1]);
- exit(0);
-}
-
-if ("@ARGV" =~ /--deluser/) {
- die N("%s: %s requires a username...\n", $0, $ARGV[0]) if $#ARGV < 1;
- deluser($ARGV[1]);
- exit(0);
-}
-
-if ("@ARGV" =~ /--syncusers/) {
- sync_users();
- exit(0);
-}
-
-if ("@ARGV" =~ /--addclient/) {
- die N("%s: %s requires hostname, MAC address, IP, nbi-image, 0/1 for THIN_CLIENT, 0/1 for Local Config...\n", $0, $ARGV[0]) if $#ARGV < 6;
- addclient(@ARGV[1..6]);
- exit(0);
-}
-
-if ("@ARGV" =~ /--delclient/) {
- die N("%s: %s requires hostname...\n", $0, $ARGV[0]) if $#ARGV < 1;
- delclient($ARGV[1]);
- exit(0);
-}
-
-read_conf_file();
-interactive_mode() if $#ARGV < 1;
-
-sub read_conf_file() {
- if (-e $cfg_file) {
- substInFile { s/ALLOW_THIN$/ALLOW_THIN=1/ } $cfg_file;
- %conf = getVarsFromSh($cfg_file);
- }
-}
-
-sub write_conf_file() {
- setVarsInSh($cfg_file, \%conf);
- chmod(0600, $cfg_file);
-}
-
-sub write_thin_inittab {
- my ($client_ip) = @_;
- my $suffix;
- if ($client_ip eq "CLIENT") {
- $suffix = '$$CLIENT$$';
- } else {
- $suffix = "\$\$IP=$client_ip\$\$";
- }
-
- my $inittab = "
-# /etc/inittab$suffix
-# created by drakTermServ
-
-id:5:initdefault:
-
-# System initialization.
-si::sysinit:/etc/rc.d/rc.sysinit
-
-l0:0:wait:/etc/rc.d/rc 0
-l1:1:wait:/etc/rc.d/rc 1
-l2:2:wait:/etc/rc.d/rc 2
-l3:3:wait:/etc/rc.d/rc 3
-l4:4:wait:/etc/rc.d/rc 4
-l5:5:wait:/etc/rc.d/rc 5
-l6:6:wait:/etc/rc.d/rc 6
-
-# Things to run in every runlevel.
-ud::once:/sbin/update
-
-# Trap CTRL-ALT-DELETE
-ca::ctrlaltdel:/sbin/reboot -f
-
-# Run gettys in standard runlevels
-1:2345:respawn:/sbin/mingetty tty1
-
-# Connect to X server
-x:5:respawn:/usr/X11R6/bin/X -ac -query $server_ip\n";
-
- my $inittab_file = "/etc/inittab$suffix";
- output_p($inittab_file, $inittab);
-}
-
-sub display_error {
- my ($message) = @_;
- my $error_box;
- destroy_widget();
- gtkpack($status_box,
- $error_box = gtkpack_(Gtk2::VBox->new(0,0),
- 1, Gtk2::Label->new($message),
- 0, gtkadd(gtkset_layout(Gtk2::HButtonBox->new, 'spread'),
- gtksignal_connect(Gtk2::Button->new(N("Ok")), clicked => sub {
- destroy_widget();
- }),
- ),
- )
- );
- $central_widget = \$error_box;
-}
-
-sub interactive_mode() {
- $cmd_line = 0;
- $in = 'interactive'->vnew;
- $::Wizard_title = N("Terminal Server Configuration");
- $::Wizard_pix_up = "ic82-network-40.png";
- $in->isa('interactive::gtk') and $::isWizard = 1;
- $window1 = ugtk2->new(N("Terminal Server Configuration"));
- $window1->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) });
- $window1->{rwindow}->set_border_width(5);
-
- gtkadd($window1->{window},
- gtkpack_(gtkset_size_request(Gtk2::VBox->new(0,2), 620, 400),
- 1, gtkpack_(Gtk2::HBox->new(0,2),
- 1, gtkpack_(Gtk2::VBox->new(0,2),
- 1, gtkpack($status_box = Gtk2::VBox->new(0,5),
- $main_box = Gtk2::VBox->new(0,10),
- ),
- 0, $wizard_buttons = gtkpack_(Gtk2::HBox->new(1,2)),
- 0, gtkpack_($main_buttons = Gtk2::VBox->new(0,2),
- 1, gtkpack_(Gtk2::HBox->new(1,2),
- 1, gtkpack_(Gtk2::VBox->new(1,0),
- 1, gtksignal_connect(Gtk2::Button->new(N("Enable Server")), clicked => sub {
- destroy_widget();
- gtkset_mousecursor_wait();
- enable_ts();
- gtkset_mousecursor_normal();
- }),
- 1, gtksignal_connect(Gtk2::Button->new(N("Disable Server")), clicked => sub {
- destroy_widget();
- gtkset_mousecursor_wait();
- disable_ts();
- gtkset_mousecursor_normal();
- }),
- ),
- 1, gtkpack_(Gtk2::VBox->new(1,0),
- 1, gtksignal_connect(Gtk2::Button->new(N("Start Server")), clicked => sub {
- destroy_widget();
- gtkset_mousecursor_wait();
- start_ts();
- gtkset_mousecursor_normal();
- }),
- 1, gtksignal_connect(Gtk2::Button->new(N("Stop Server")), clicked => sub {
- destroy_widget();
- gtkset_mousecursor_wait();
- stop_ts();
- gtkset_mousecursor_normal();
- }),
- ),
- 1, gtkpack_(Gtk2::VBox->new(1,0),
- 1, gtksignal_connect(Gtk2::Button->new(N("Etherboot Floppy/ISO")), clicked => sub {
- destroy_widget();
- make_boot();
- }),
- 1, gtksignal_connect(Gtk2::Button->new(N("Net Boot Images")), clicked => sub {
- destroy_widget();
- make_nbi();
- }),
- ),
- 1, gtkpack_(Gtk2::VBox->new(1,0),
- 1, gtksignal_connect(Gtk2::Button->new(N("Add/Del Users")), clicked => sub {
- destroy_widget();
- maintain_users();
- }),
- 1, gtksignal_connect(Gtk2::Button->new(N("Add/Del Clients")), clicked => sub {
- destroy_widget();
- maintain_clients()
- }),
- ),
- ),
- 0, gtkpack_(Gtk2::HBox->new,
- 0, gtksignal_connect(Gtk2::Button->new(N("Help")),clicked => sub {
- destroy_widget();
- help();
- }),
- 0, gtksignal_connect(Gtk2::Button->new(N("First Time Wizard")), clicked => sub {
- destroy_widget();
- start_wizard();
- }),
- 1, "",
- 0, gtksignal_connect(Gtk2::Button->new(N("Close")), clicked => sub {
- write_conf_file();
- restart_server() if $changes_made == 1;
- Gtk2->main_quit;
- }),
- ),
- ),
- ),
- ),
- ),
- );
- $central_widget = \$main_box;
- $window1->{rwindow}->show_all;
- $window1->{rwindow}->realize;
- $window1->{rwindow}->show_all;
- $window1->main;
- ugtk2->exit(0);
-}
-
-sub check_gdm() {
- #- gdm now needs gdm user in /etc/passwd$$CLIENT$$
- my %desktop = getVarsFromSh("/etc/sysconfig/desktop");
- my $dm = $desktop{DISPLAYMANAGER};
- $dm =~ tr/a-z/A-Z/;
- my $gdm = `grep gdm '/etc/passwd\$\$CLIENT\$\$'`;
- if ($dm =~ /GNOME|GDM/ && !$gdm) {
- $in->ask_warn(N("Warning"), N("%s defined as dm, adding gdm user to /etc/passwd\$\$CLIENT\$\$", $dm)) if !$cmd_line;
- warn(N("%s defined as dm, adding gdm user to /etc/passwd\$\$CLIENT\$\$", $dm)) if $cmd_line;
- adduser("gdm");
- }
-}
-
-sub start_wizard() {
- text_view(N("
- This wizard routine will:
- 1) Ask you to select either 'thin' or 'fat' clients.
- 2) Setup DHCP.
-
-After doing these steps, the wizard will:
-
- a) Make all nbis.
- b) Activate the server.
- c) Start the server.
- d) Synchronize the shadow files so that all users, including root,
- are added to the shadow\$\$CLIENT\$\$ file.
- e) Ask you to make a boot floppy.
- f) If it's thin clients, ask if you want to restart KDM.
-"), "wizard");
-}
-
-sub do_wizard() {
- destroy_widget();
- $main_buttons->hide;
- $in_wizard = 1;
- $config_written = 0;
- wizard_step(\&client_type, 1);
-}
-
-sub wizard_step {
- my ($do_step, $step) = @_;
- &$do_step();
- gtkadd($wizard_buttons,
- gtksignal_connect($previous_button = Gtk2::Button->new(N("Previous")), clicked => sub {
- clear_buttons();
- if ($step == 1) {
- exit_wizard();
- start_wizard();
- }
- wizard_step(\&client_type, 1) if $step == 2;
- wizard_step(\&dhcpd_config, 2) if $step == 3;
- wizard_step(\&make_nbis, 3) if $step == 4;
- wizard_step(\&enable_ts, 4) if $step == 5;
- wizard_step(\&restart_ts, 5) if $step == 6;
- wizard_step(\&sync_users, 6) if $step == 7;
- wizard_step(\&make_boot, 7) if $step == 8;
- })
- );
- gtkadd($wizard_buttons,
- gtksignal_connect($cancel_button = Gtk2::Button->new(N("Cancel Wizard")), clicked => sub {
- exit_wizard();
- })
- );
- gtkadd($wizard_buttons,
- gtksignal_connect($next_button = Gtk2::Button->new(N("Next")), clicked => sub {
- clear_buttons();
- wizard_step(\&dhcpd_config, 2) if $step == 1;
- if ($step == 2) {
- if ($config_written == 1) {
- wizard_step(\&make_nbis, 3);
- } else {
- $in->ask_warn(N("Error"), N("Please save dhcpd config!"));
- wizard_step(\&dhcpd_config, 2);
- }
- }
- wizard_step(\&enable_ts, 4) if $step == 3;
- wizard_step(\&restart_ts, 5) if $step == 4;
- wizard_step(\&sync_users, 6) if $step == 5;
- wizard_step(\&make_boot, 7) if $step == 6;
- wizard_step(\&restart_dm, 8) if $step == 7;
- })
- );
- exit_wizard() if $step == 8;
-}
-
-sub exit_wizard() {
- clear_buttons();
- $in_wizard = 0;
- $main_buttons->show;
-}
-
-sub clear_buttons() {
- destroy_widget();
- $previous_button->destroy;
- $cancel_button->destroy;
- $next_button->destroy;
-}
-
-sub client_type() {
- my $check_allow_thin = Gtk2::CheckButton->new(N("Use thin clients."));
- $check_allow_thin->set_active($conf{ALLOW_THIN});
- text_view(N("Please select default client type.
- 'Thin' clients run everything off the server's CPU/RAM, using the client display.
- 'Fat' clients use their own CPU/RAM but the server's filesystem."), "wizard");
- gtkpack_($$central_widget,
- 0, gtkpack_(Gtk2::HBox->new(1,0),
- 1, Gtk2::VBox->new,
- 0, gtksignal_connect($check_allow_thin, clicked => sub {
- invbool \$conf{ALLOW_THIN};
- client_set("all");
- }),
- 0, Gtk2::VBox->new,
- ),
- 0, gtksignal_connect(Gtk2::Button->new(N("Sync client X keyboard settings with server.")),
- clicked => sub { client_X_keyboard() }),
- 1, Gtk2::HBox->new(0,0),
- );
-}
-
-sub make_nbis() {
- my $buff = N("Creating net boot images for all kernels");
- $in->ask_warn(N("Information"), N("This will take a few minutes."));
- gtkset_mousecursor_wait();
- system("/usr/bin/mknbi-set -k /boot/$_") foreach @kernels;
- gtkset_mousecursor_normal();
- $buff .= "\n\n\t" . N("Done!");
- text_view($buff, "wizard");
-}
-
-sub sync_users() {
- my $buff = N("Syncing server user list with client list, including root.");
- my @active_users = cat_("/etc/shadow");
-
- my $shadow = '/etc/shadow$$CLIENT$$';
- my @userlist;
-
- #- only users with home dirs, and root
- foreach my $user (@active_users) {
- my @fields = split(/:/, $user);
- if (-d "/home/" . $fields[0] || $fields[0] eq "root") {
- push @userlist, $user;
- }
- }
- output_p($shadow, @userlist);
- $buff .= "\n\n\t" . N("Done!");
- text_view($buff, "wizard") if !$cmd_line;
-}
-
-sub restart_dm() {
- if ($clients_set) {
- my $result = $in->ask_okcancel('', N("In order to enable changes made for thin clients, the display manager must be restarted. Restart now?"));
- system('nohup /sbin/service dm restart') if $result;
- }
-}
-
-sub text_view {
- my ($text, $option) = @_;
- my $box;
- gtkpack($status_box,
- $box = gtkpack_(Gtk2::VBox->new(0,10),
- 1, gtkpack_(Gtk2::HBox->new(0,0),
- 1, create_scrolled_window(gtktext_insert(
- Gtk2::TextView->new, [ [ $text ] ])
- ),
- ),
- 0, gtkpack(gtkset_layout(Gtk2::HButtonBox->new, 'spread'),
- gtksignal_connect(my $ok_button = Gtk2::Button->new(N("Ok")), clicked => sub {
- destroy_widget() if $option eq "close";
- do_wizard() if $option eq "wizard";
- }),
- ),
- )
- );
- gtkset_size_request($box, 580, 280);
- $central_widget = \$box;
- $status_box->show_all;
- $ok_button->hide if $in_wizard;
- $main_buttons->hide if $in_wizard;
-}
-
-sub help() {
- my $inittab_str = '/etc/inittab$$IP=client_ip$$';
- my $shadow_str = '/etc/shadow$$CLIENT$$';
- my $xfconfig_str = '/etc/X11/xorg.conf$$IP=client_ip$$';
-
- text_view(N("Terminal Server Overview") . "\n\n" .
-N(" - Create Etherboot Enabled Boot Images:
- To boot a kernel via etherboot, a special kernel/initrd image must be created.
- mkinitrd-net does much of this work and drakTermServ is just a graphical
- interface to help manage/customize these images. To create the file
- /etc/dhcpd.conf.etherboot-pcimap.include that is pulled in as an include in
- dhcpd.conf, you should create the etherboot images for at least one full kernel.") . "\n\n" .
-N(" - Maintain /etc/dhcpd.conf:
- To net boot clients, each client needs a dhcpd.conf entry, assigning an IP
- address and net boot images to the machine. drakTermServ helps create/remove
- these entries.
-
- (PCI cards may omit the image - etherboot will request the correct image.
- You should also consider that when etherboot looks for the images, it expects
- names like boot-3c59x.nbi, rather than boot-3c59x.2.4.19-16mdk.nbi).
-
- A typical dhcpd.conf stanza to support a diskless client looks like:") . "\n\n" .
-' host curly {
- hardware ethernet 00:20:af:2f:f7:9d;
- fixed-address 192.168.192.3;
- #type fat;
- filename "i386/boot/boot-3c509.2.4.18-6mdk.nbi";
- #hdw_config true;
- }
- ' . "\n" .
-N(" While you can use a pool of IP addresses, rather than setup a specific entry for
- a client machine, using a fixed address scheme facilitates using the functionality
- of client-specific configuration files that ClusterNFS provides.
-
- Note: The '#type' entry is only used by drakTermServ. Clients can either be 'thin'
- or 'fat'. Thin clients run most software on the server via XDMCP, while fat clients run
- most software on the client machine. A special inittab, %s is
- written for thin clients. System config files xdm-config, kdmrc, and gdm.conf are
- modified if thin clients are used, to enable XDMCP. Since there are security issues in
- using XDMCP, hosts.deny and hosts.allow are modified to limit access to the local
- subnet.
-
- Note: The '#hdw_config' entry is also only used by drakTermServ. Clients can either
- be 'true' or 'false'. 'true' enables root login at the client machine and allows local
- hardware configuration of sound, mouse, and X, using the 'drak' tools. This is enabled
- by creating separate config files associated with the client's IP address and creating
- read/write mount points to allow the client to alter the file. Once you are satisfied
- with the configuration, you can remove root login privileges from the client.
-
- Note: You must stop/start the server after adding or changing clients.", $inittab_str) . "\n\n" .
-N(" - Maintain /etc/exports:
- Clusternfs allows export of the root filesystem to diskless clients. drakTermServ
- sets up the correct entry to allow anonymous access to the root filesystem from
- diskless clients.
-
- A typical exports entry for clusternfs is:
-
- / (ro,all_squash)
- /home SUBNET/MASK(rw,root_squash)
-
- With SUBNET/MASK being defined for your network.") .
- "\n\n" .
-N(" - Maintain %s:
- For users to be able to log into the system from a diskless client, their entry in
- /etc/shadow needs to be duplicated in %s. drakTermServ
- helps in this respect by adding or removing system users from this file.", $shadow_str, $shadow_str) . "\n\n" .
-N(" - Per client %s:
- Through clusternfs, each diskless client can have its own unique configuration files
- on the root filesystem of the server. By allowing local client hardware configuration,
- drakTermServ will help create these files.", $xfconfig_str) .
-"\n\n" .
-N(" - Per client system configuration files:
- Through clusternfs, each diskless client can have its own unique configuration files
- on the root filesystem of the server. By allowing local client hardware configuration,
- clients can customize files such as /etc/modules.conf, /etc/sysconfig/mouse,
- /etc/sysconfig/keyboard on a per-client basis.
-
- Note: Enabling local client hardware configuration does enable root login to the terminal
- server on each client machine that has this feature enabled. Local configuration can be
- turned back off, retaining the configuration files, once the client machine is configured.") . "\n\n" .
-N(" - /etc/xinetd.d/tftp:
- drakTermServ will configure this file to work in conjunction with the images created
- by mkinitrd-net, and the entries in /etc/dhcpd.conf, to serve up the boot image to
- each diskless client.
-
- A typical TFTP configuration file looks like:
-
- service tftp
- {
- disable = no
- socket_type = dgram
- protocol = udp
- wait = yes
- user = root
- server = /usr/sbin/in.tftpd
- server_args = -s /var/lib/tftpboot
- }
-
- The changes here from the default installation are changing the disable flag to
- 'no' and changing the directory path to /var/lib/tftpboot, where mkinitrd-net
- puts its images.") . "\n\n" .
-N(" - Create etherboot floppies/CDs:
- The diskless client machines need either ROM images on the NIC, or a boot floppy
- or CD to initiate the boot sequence. drakTermServ will help generate these
- images, based on the NIC in the client machine.
-
- A basic example of creating a boot floppy for a 3Com 3c509 manually:
-
- cat /usr/lib/etherboot/floppyload.bin \\
- /usr/share/etherboot/start16.bin \\
- /usr/lib/etherboot/zimg/3c509.zimg > /dev/fd0") . "\n\n", "close");
-}
-
-sub make_boot() {
- #- make a boot image on floppy or iso from etherboot images
- my $boot_box;
- my $rom_path = "/usr/share/etherboot";
- #- doesn't return list sorted
- my @nics = sort(all("/usr/share/etherboot/zimg"));
- my $list_nics = Gtk2::List->new;
- my $nic;
-
- foreach (@nics) {
- my $t = $_;
- $list_nics->add(gtkshow(gtksignal_connect(Gtk2::ListItem->new($t),
- select => sub { $nic = $t })));
- }
- $list_nics->set_selection_mode('single');
-
- gtkpack($status_box,
- $boot_box = gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkadd(Gtk2::HBox->new(0,10),
- Gtk2::HBox->new(0,5),
- create_scrolled_window($list_nics),
- gtkadd(Gtk2::VBox->new(1,10),
- Gtk2::HBox->new(0,20),
- gtksignal_connect(Gtk2::Button->new(N("Boot Floppy")), clicked =>
- sub { write_eb_image($nic, $rom_path, "floppy") }),
- gtksignal_connect(Gtk2::Button->new(N("Boot ISO")), clicked =>
- sub { write_eb_image($nic, $rom_path, "iso") }),
- gtksignal_connect(Gtk2::Button->new(N("PXE Image")), clicked =>
- sub { write_eb_image($nic, $rom_path, "pxe") }),
- Gtk2::HBox->new(0,20),
- ),
- Gtk2::HBox->new(0,5),
- ),
- ),
- );
-
- $central_widget = \$boot_box;
- $boot_box->show_all;
-}
-
-sub make_nbi() {
- my $nbi_box;
- my $kernel;
- my $nic;
-
- #- just a static list for the moment
- #- method in mknbi-net is much better
- my @nics = ("3c509", "3c59x", "3c90x", "8139cp", "8139too", "acenic", "airo",
- "aironet4500_card", "bcm5700", "dgrs", "dl2k", "dmfe", "e100",
- "e1000", "eepro100", "epic100", "fealnx", "hamachi", "hp100",
- "hysdn", "natsemi", "natsemi_old", "ne", "ne2k-pci", "ns83820",
- "pcnet32", "pegasus", "prism2_pci", "prism2_plx", "rcpci", "sis900",
- "starfire", "sundance", "sungem", "sunhme", "tlan", "tulip-old",
- "via-rhine", "winbond-840", "xircom_cb", "xircom_tulip_cb", "yellowfin");
-
- #- kernel/module info in tree view
- my $model = Gtk2::TreeStore->new("Glib::String");
- my $tree_kernels = Gtk2::TreeView->new_with_model($model);
- $tree_kernels->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $tree_kernels->set_headers_visible(0);
- $tree_kernels->get_selection->set_mode('single');
-
- foreach (@kernels) {
- my $t_kernel = $model->append_set(undef, [ 0 => $_ ]);
- foreach (@nics) {
- $model->append_set($t_kernel, [ 0 => $_ ]);
- }
- }
-
- $tree_kernels->get_selection->signal_connect(changed => sub {
- $kernel = '';
- $nic = '';
- my ($model, $iter) = $_[0]->get_selected;
- $model && $iter or return;
- my $value = $model->get($iter, 0);
- my $path = $model->get_path_str($iter);
- if ($path !~ /:/) {
- $kernel = $value;
- } else {
- my @elements = split(/:/, $path);
- $nic = $value;
- $kernel = $kernels[$elements[0]];
- }
- });
-
- # existing nbi images in list
- my $list_model = Gtk2::ListStore->new("Glib::String");
- my $list_nbis = Gtk2::TreeView->new_with_model($list_model);
- $list_nbis->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $list_nbis->set_headers_visible(0);
- my $nbi;
- my $nbi_iter;
-
- update_list($list_model);
-
- my $combo_default_kernel = Gtk2::ComboBox->new_with_strings([ N("Default kernel version"),
- map { bootloader::vmlinuz2version($_) } @kernels ]);
-
- my $check_pxe = Gtk2::CheckButton->new(N("Create PXE images."));
- $check_pxe->set_active($conf{CREATE_PXE});
- $check_pxe->signal_connect('clicked' => sub { invbool \$conf{CREATE_PXE} });
-
- $combo_default_kernel->set_active(0);
- $combo_default_kernel->entry->signal_connect('changed', sub {
- my $default_kernel = $combo_default_kernel->entry->get_text;
- my $config;
- if ($default_kernel eq translate("Default kernel version")) {
- $config = "";
- } else {
- $config = 'option bootfile-name = pick-first-value ( concat ( "boot-",' . "\n";
- $config .= ' config-option etherboot.kmod, ".' . $default_kernel . '", ".nbi" ), concat' . "\n";
- $config .= ' ( "boot-", config-option etherboot.kmod, ".nbi") ,"boot.nbi" );' . "\n";
- }
- output_p("/etc/dhcpd.conf.etherboot.kernel", $config);
- });
-
- $list_nbis->get_selection->signal_connect(changed => sub {
- my ($model, $iter) = $_[0]->get_selected;
- $model && $iter or return;
- $nbi = $model->get($iter, 0);
- $nbi_iter = $iter;
- });
-
- gtkpack($status_box,
- $nbi_box = gtkpack_(Gtk2::VBox->new(1,10),
- 0, gtkadd(Gtk2::HBox->new(0,10),
- create_scrolled_window($tree_kernels),
- gtkadd(Gtk2::VBox->new(1,10),
- gtksignal_connect(Gtk2::Button->new(N("Build Whole Kernel -->")), clicked => sub {
- if ($kernel) {
- $in->ask_warn(N("Information"), N("This will take a few minutes."));
- gtkset_mousecursor_wait();
- build_n_update($list_model, $kernel, undef);
- link_pxe($kernel, undef) if $conf{CREATE_PXE};
- gtkset_mousecursor_normal();
- } else {
- $in->ask_warn(N("Error"), N("No kernel selected!")) if !($kernel);
- }
- }),
- gtksignal_connect(Gtk2::Button->new(N("Build Single NIC -->")), clicked => sub {
- if ($nic) {
- build_n_update($list_model, $kernel, $nic);
- } else {
- $in->ask_warn(N("Error"), N("No NIC selected!"));
- }
- }),
- gtksignal_connect(Gtk2::Button->new(N("Build All Kernels -->")), clicked => sub {
- $in->ask_warn(N("Information"), N("This will take a few minutes."));
- gtkset_mousecursor_wait();
- foreach (@kernels) {
- build_n_update($list_model, $_, undef);
- link_pxe($kernel, undef) if $conf{CREATE_PXE};
- }
- gtkset_mousecursor_normal();
- }),
- $combo_default_kernel,
- $check_pxe,
- Gtk2::HBox->new(1,1),
- gtksignal_connect(Gtk2::Button->new(N("<-- Delete")), clicked => sub {
- if ($nbi) {
- my $result = clear_nbi($nbi);
- $list_model->remove($nbi_iter) if $result == 1;
- } else {
- $in->ask_warn(N("Error"), N("No image selected!"));
- }
- }),
- gtksignal_connect(Gtk2::Button->new(N("Delete All NBIs")), clicked => sub {
- gtkset_mousecursor_wait();
- foreach (grep { /\.nbi/ } all($tftpboot)) {
- clear_nbi($_);
- }
- $list_model->clear;
- gtkset_mousecursor_normal();
- }),
- Gtk2::HBox->new(1,1),
- ),
- create_scrolled_window($list_nbis),
- ),),
- );
-
- $central_widget = \$nbi_box;
- $nbi_box->show_all;
-}
-
-sub clear_nbi {
- my ($nbi) = @_;
- $nbi = $tftpboot . "/" . $nbi;
- my $result = unlink($nbi) or warn("Can't delete $nbi...");
- $nbi =~ s|boot-|initrd-|;
- $nbi =~ s|nbi|img|;
- unlink($nbi);
- if ($conf{CREATE_PXE}) {
- my $pxe = get_platform_pxe();
- $nbi =~ s|$tftpboot/|$pxe|;
- unlink($nbi);
- }
- return $result;
-}
-
-sub update_list {
- my ($list_model) = @_;
- $list_model->clear;
- $list_model->append_set(0, $_) foreach grep { /\.nbi/ } all($tftpboot);
-}
-
-sub build_n_update {
- my ($list_model, $kernel, $nic) = @_;
- my $command = "-k /boot/$kernel";
- $command .= " -r $nic" if $nic;
- system("/usr/bin/mknbi-set -v $command");
- if ($conf{CREATE_PXE}) {
- my $pxedir = get_platform_pxe();
- cp_af("/boot/$kernel", $pxedir) if !-f "$pxedir/$kernel";
- link_pxe($kernel, $nic) if $nic;
- }
- update_list($list_model);
-}
-
-sub link_pxe {
- my ($kernel, $nic) = @_;
- my $pxedir = get_platform_pxe();
- $kernel =~ s|vmlinuz-||;
- if ($nic) {
- #- symlinkf doesn't work?
- `ln -sf ../../initrd-$nic.$kernel.img $pxedir`;
- } else {
- `ln -sf ../../initrd-*.$kernel.img $pxedir`;
- }
-}
-
-sub get_platform_pxe {
- my $adir = "X86PC";
- $adir = "IA64PC" if arch() =~ /x86_64|ia64/;
- $adir = "$tftpboot/$adir/linux/";
- return $adir;
-}
-
-sub maintain_users() {
- #- copy users from /etc/shadow to /etc/shadow$$CLIENT$$ to allow ts login
- my $user_box;
- my @sys_users = cat_("/etc/shadow");
- my @ts_users = cat_('/etc/shadow$$CLIENT$$');
- my $titer;
-
- #- use /homes to filter system daemons
- #- seems suppressing root is less than useful, let it be added
- my @homes = (all("/home"), "root");
-
- my $list_model = Gtk2::ListStore->new("Glib::String");
- my $list_sys_users = Gtk2::TreeView->new_with_model($list_model);
- $list_sys_users->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $list_sys_users->set_headers_visible(0);
-
- my $sys_user;
-
- foreach (@sys_users) {
- my ($s_label) = split(/:/, $_, 2);
- if (any { /$s_label/ } @homes) {
- $list_model->append_set(0, $s_label);
- }
- }
-
- $list_sys_users->get_selection->signal_connect(changed => sub {
- my ($model, $iter) = $_[0]->get_selected;
- $model && $iter or return;
- $sys_user = $model->get($iter, 0);
- });
-
- $list_model = Gtk2::ListStore->new("Glib::String");
- my $list_ts_users = Gtk2::TreeView->new_with_model($list_model);
- $list_ts_users->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $list_ts_users->set_headers_visible(0);
-
- my $ts_user;
-
- foreach (@ts_users) {
- my ($t_label) = split(/:/, $_, 2);
- my @system_entry = grep { /$t_label/ } @sys_users;
- $t_label = $t_label . " !!!" if $_ ne $system_entry[0];
- $list_model->append_set(0, $t_label);
- }
-
- $list_ts_users->get_selection->signal_connect(changed => sub {
- my ($model, $iter) = $_[0]->get_selected;
- $model && $iter or return;
- $ts_user = $model->get($iter, 0);
- $ts_user =~ s| !!!||;
- $titer = $iter;
- });
-
- gtkpack($status_box,
- $user_box = gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkadd(Gtk2::Label->new(N("!!! Indicates the password in the system database is different than\n the one in the Terminal Server database.\nDelete/re-add the user to the Terminal Server to enable login."))),
- 0, gtkadd(Gtk2::HBox->new(0,20),
- create_scrolled_window($list_sys_users),
- gtkadd(Gtk2::VBox->new(1,10),
- Gtk2::HBox->new(0,10),
- gtksignal_connect(Gtk2::Button->new(N("Add User -->")), clicked =>
- sub { my $result = adduser($sys_user);
- if ($result == 0) {
- $list_model->append_set(0, $sys_user);
- }
- }),
- gtksignal_connect(Gtk2::Button->new(N("<-- Del User")), clicked =>
- sub { deluser($ts_user);
- $list_model->remove($titer);
- }),
- Gtk2::HBox->new(0,10),
- ),
- create_scrolled_window($list_ts_users),
- ),),
- );
-
- $central_widget = \$user_box;
- $user_box->show_all;
-}
-
-sub maintain_clients() {
- #- add client machines to Terminal Server config
- my $client_box;
- my %clients = read_dhcpd_conf();
- my $client;
- my $citer;
- my $local_config = 0;
- my $button_edit;
- my $button_config;
- my $button_delete;
-
- #- client info in tree view
- my $model = Gtk2::TreeStore->new("Glib::String");
- my $tree_clients = Gtk2::TreeView->new_with_model($model);
- $tree_clients->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $tree_clients->set_headers_visible(0);
- $tree_clients->get_selection->set_mode('browse');
-
- foreach my $key (keys(%clients)) {
- my $t_client = $model->append_set(undef, [ 0 => $key ]);
- $model->append_set($t_client, [ 0 => $clients{$key}{hardware} ]);
- $model->append_set($t_client, [ 0 => $clients{$key}{address} ]);
- $model->append_set($t_client, [ 0 => N("type: %s", $clients{$key}{type}) ]);
- if ($clients{$key}{filename}) {
- $model->append_set($t_client, [ 0 => $clients{$key}{filename} ]);
- }
- $model->append_set($t_client, [ 0 => N("local config: %s", $clients{$key}{hdw_config}) ]);
-
- }
-
- $tree_clients->get_selection->signal_connect(changed => sub {
- my ($model, $iter) = $_[0]->get_selected;
- $model && $iter or return;
- my $value = $model->get($iter, 0);
- my $path = $model->get_path_str($iter);
- if ($path !~ /:/) {
- $client = $value;
- $citer = $iter;
- } else {
- $client = '';
- }
- $button_edit->set_sensitive(1);
- $button_config->set_sensitive(1);
- $button_delete->set_sensitive(1);
- });
-
- #- entry boxes for client data entry
- my $label_host = Gtk2::Label->new("Client Name:");
- my $entry_host = Gtk2::Entry->new;
- my $label_mac = Gtk2::Label->new("MAC Address:");
- my $entry_mac = Gtk2::Entry->new;
- my $label_ip = Gtk2::Label->new("IP Address:");
- my $entry_ip = Gtk2::Entry->new;
- my $label_nbi = Gtk2::Label->new("Kernel Netboot Image:");
- my $entry_nbi = Gtk2::Combo->new;
-
- gtksignal_connect(my $check_hdw_config = Gtk2::CheckButton->new(N("Allow local hardware\nconfiguration.")),
- clicked => sub { invbool \$local_config });
-
- my @images = grep { /\.nbi/ } all($tftpboot);
- my $have_nbis = @images;
- if ($have_nbis) {
- unshift(@images, "");
- $entry_nbi->set_popdown_strings(@images);
- } else {
- $in->ask_warn(N("Error"), N("No net boot images created!"));
- make_nbi();
- return 1;
- }
-
- my $check_thin;
- my $check_allow_thin;
- my $is_thin = 0;
-
- gtkpack($status_box,
- $client_box = gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkadd(Gtk2::HBox->new(1,5),
- gtkadd(Gtk2::VBox->new(0,5),
- gtkadd($label_host), gtkadd($entry_host),
- gtkadd($label_mac), gtkadd($entry_mac),
- gtkadd($label_ip), gtkadd($entry_ip),
- gtkadd($label_nbi), gtkadd($entry_nbi),
- gtkadd($check_hdw_config),
- gtksignal_connect($check_thin = Gtk2::CheckButton->new(N("Thin Client")),
- clicked => sub { invbool \$is_thin }),
- ),
- gtkadd(Gtk2::VBox->new(1,10),
- $check_allow_thin = Gtk2::CheckButton->new(N("Allow Thin Clients")),
- gtksignal_connect(Gtk2::Button->new(N("Add Client -->")), clicked =>
- sub { my $hostname = $entry_host->get_text;
- my $mac = $entry_mac->get_text;
- my $ip = $entry_ip->get_text;
- my $nbi = $entry_nbi->entry->get_text;
- if ($hostname && $mac && $ip) {
-
- my $result = addclient($hostname, $mac, $ip, $nbi, $is_thin, $local_config);
-
- if ($result == 0) {
- my $t_client = $model->append_set(undef, [ 0 => $hostname ]);
- $model->append_set($t_client, [ 0 => $mac ]);
- $model->append_set($t_client, [ 0 => $ip ]);
-
- my $client_type = N("type: fat");
- $client_type = N("type: thin") if $is_thin == 1;
- $model->append_set($t_client, [ 0 => $client_type ]);
-
- $model->append_set($t_client, [ 0 => $nbi ]) if $nbi;
- $check_thin->set_active(0);
- $is_thin = 0;
-
- my $hdw_config = N("local config: false");
- $hdw_config = N("local config: true") if $local_config == 1;
- $model->append_set($t_client, [ 0 => $hdw_config ]);
- $check_hdw_config->set_active(0);
- $local_config = 0;
- %clients = read_dhcpd_conf();
- }
- }
- }),
- gtksignal_connect($button_edit = Gtk2::Button->new(N("<-- Edit Client")), clicked =>
- sub { $entry_host->set_text($client);
- $entry_mac->set_text($clients{$client}{hardware});
- $entry_ip->set_text($clients{$client}{address});
- my $type = $clients{$client}{type};
- if ($type eq "thin") {
- $check_thin->set_active(1);
- } else {
- $check_thin->set_active(0);
- }
- $entry_nbi->entry->set_text($clients{$client}{filename});
- my $hdw_config = $clients{$client}{hdw_config};
- if ($hdw_config eq "true") {
- $check_hdw_config->set_active(1);
- } else {
- $check_hdw_config->set_active(0);
- }
-
- my $result = delclient($client);
- if ($result == 0) {
- $model->remove($citer);
- $button_edit->set_sensitive(0);
- $button_config->set_sensitive(0);
- $button_delete->set_sensitive(0);
- }
- }),
- gtksignal_connect($button_config = Gtk2::Button->new(N("Disable Local Config")), clicked =>
- sub {
- my $hdw_config = $clients{$client}{hdw_config};
- if ($hdw_config eq "true") {
- client_hdw_config($clients{$client}{address}, 0);
- }
- }),
- gtksignal_connect($button_delete = Gtk2::Button->new(N("Delete Client")), clicked =>
- sub { my $result = delclient($client);
- if ($result == 0) {
- $model->remove($citer);
- $button_edit->set_sensitive(0);
- $button_config->set_sensitive(0);
- $button_delete->set_sensitive(0);
- }
- }),
- gtksignal_connect(Gtk2::Button->new(N("dhcpd Config...")), clicked =>
- sub { $client_box->destroy; dhcpd_config() }),
- ),
- create_scrolled_window($tree_clients),
- ),
- 0, gtksignal_connect(Gtk2::Button->new(N("Sync client X keyboard settings with server.")),
- clicked => sub { client_X_keyboard() }),
- ),
- );
-
- $check_allow_thin->set_active($conf{ALLOW_THIN});
- $check_thin->set_sensitive($conf{ALLOW_THIN});
- gtksignal_connect($check_allow_thin, clicked =>
- sub { invbool \$conf{ALLOW_THIN};
- $check_thin->set_sensitive($conf{ALLOW_THIN});
- client_set("single");
- $in->ask_warn(N("Warning"), N("Need to restart the Display Manager for full changes to take effect. \n(service dm restart - at the console)"));
- }
- );
- $button_edit->set_sensitive(0);
- $button_config->set_sensitive(0);
- $button_delete->set_sensitive(0);
- $central_widget = \$client_box;
- $client_box->show_all;
-}
-
-sub client_X_keyboard() {
- my $server_conf = "/etc/X11/xorg.conf";
- my $client_conf = '/etc/X11/xorg.conf$$CLIENT$$';
- my @server_X_config = cat_($server_conf);
- foreach (@server_X_config) {
- chomp;
- if (/XkbModel/) {
- my $oldmodel = `grep XkbModel '/etc/X11/xorg.conf\$\$CLIENT\$\$'`;
- chomp $oldmodel;
- my $newmodel = $_;
- substInFile { s/$oldmodel/$newmodel/ } $client_conf;
- log::explanations("Sync XkbModel in $client_conf from $server_conf");
- }
- if (/XkbLayout/) {
- my $oldlayout = `grep XkbLayout '/etc/X11/xorg.conf\$\$CLIENT\$\$'`;
- chomp $oldlayout;
- my $newlayout = $_;
- substInFile { s/$oldlayout/$newlayout/ } $client_conf;
- log::explanations("Sync XkbLayout in $client_conf from $server_conf");
- }
- }
-}
-
-sub client_set {
- my ($default) = @_;
- # we need to change some system files to allow the thin clients
- # to access the server - enabling XDMCP and modify hosts.deny/hosts.allow for some security
- # we also need to set runlevel to 5 and restart the display manager
- if ($conf{ALLOW_THIN} == 1) {
- if (-f "/etc/sysconfig/autologin") {
- my $answer = $in->ask_yesorno('', N("Thin clients won't work with autologin. Disable autologin?"));
- if ($answer == 1) {
- log::explanations("Renaming /etc/sysconfig/autologin to /etc/sysconfig/autologin.bak");
- `mv /etc/sysconfig/autologin /etc/sysconfig/autologin.bak`;
- }
- }
- substInFile { s/id:3:initdefault:/id:5:initdefault:/ } "/etc/inittab";
- substInFile { s/! DisplayManager.requestPort:/DisplayManager.requestPort:/ } "/etc/X11/xdm/xdm-config";
- substInFile { s/Enable=false/Enable=true/ } "/usr/share/config/kdm/kdmrc";
- # This file had 2 "Enable=" entries, one for XDMCP and one for debug
- change_gdm_xdmcp("true");
- log::explanations("Modified files /etc/inittab, /etc/X11/xdm/xdm-config, /usr/share/config/kdm/kdmrc, /etc/X11/gdm/gdm.conf");
- # just XDMCP in hosts.allow is enough for xdm & kdm, but gdm doesn't work - x11 doesn't help either
- update_hosts_allow("enable");
- if ($default eq "all") {
- my $inittab = '/etc/initab$$CLIENT$$';
- $in->ask_warn(N("Warning"), N("All clients will use %s", $inittab));
- `mv '/etc/inittab\$\$CLIENT\$\$' '/etc/inittab\$\$CLIENT\$\$.fat'` if -f '/etc/inittab$$CLIENT$$';;
- write_thin_inittab("CLIENT");
- }
- } else {
- if (-f "/etc/sysconfig/autologin.bak") {
- log::explanations("Renaming /etc/sysconfig/autologin.bak to /etc/sysconfig/autologin");
- `mv /etc/sysconfig/autologin.bak /etc/sysconfig/autologin`;
- }
- substInFile { s/id:5:initdefault:/id:3:initdefault:/ } '/etc/inittab';
- substInFile { s/DisplayManager.requestPort:/! DisplayManager.requestPort:/ } "/etc/X11/xdm/xdm-config";
- substInFile { s/Enable=true/Enable=false/ } "/usr/share/config/kdm/kdmrc";
- change_gdm_xdmcp("false");
- log::explanations("Modified files /etc/inittab, /etc/X11/xdm/xdm-config, /usr/share/config/kdm/kdmrc, /etc/X11/gdm/gdm.conf");
- update_hosts_allow("disable");
- `mv '/etc/inittab\$\$CLIENT\$\$.fat' '/etc/inittab\$\$CLIENT\$\$'` if $default eq "all" && -f '/etc/inittab$$CLIENT$$.fat';
- }
- $clients_set = 1;
-}
-
-sub dhcpd_config() {
- #- do main dhcp server config
- my $dhcpd_box;
- my @ifvalues;
- my @resolve;
- my %netconfig;
- my @nservers;
- my $button_msg;
- my $new_config = 0;
-
- #- entry boxes for data entry
- my $box_subnet = Gtk2::HBox->new(0,0);
- my $label_subnet = Gtk2::Label->new(N("Subnet:"));
- $label_subnet->set_justify('right');
- my $entry_subnet = Gtk2::Entry->new;
- $box_subnet->pack_end($entry_subnet, 0, 0, 2);
- $box_subnet->pack_end($label_subnet, 0, 0, 2);
-
- my $box_netmask = Gtk2::HBox->new(0,0);
- my $label_netmask = Gtk2::Label->new(N("Netmask:"));
- $label_netmask->set_justify('left');
- my $entry_netmask = Gtk2::Entry->new;
- $box_netmask->pack_end($entry_netmask, 0, 0, 2);
- $box_netmask->pack_end($label_netmask, 0, 0, 2);
-
- my $box_routers = Gtk2::HBox->new(0,0);
- my $label_routers = Gtk2::Label->new(N("Routers:"));
- $label_routers->set_justify('left');
- my $entry_routers = Gtk2::Entry->new;
- $box_routers->pack_end($entry_routers, 0, 0, 2);
- $box_routers->pack_end($label_routers, 0, 0, 2);
-
- my $box_subnet_mask = Gtk2::HBox->new(0,0);
- my $label_subnet_mask = Gtk2::Label->new(N("Subnet Mask:"));
- $label_subnet_mask->set_justify('left');
- my $entry_subnet_mask = Gtk2::Entry->new;
- $box_subnet_mask->pack_end($entry_subnet_mask, 0, 0, 2);
- $box_subnet_mask->pack_end($label_subnet_mask, 0, 0, 2);
-
- my $box_broadcast = Gtk2::HBox->new(0,0);
- my $label_broadcast = Gtk2::Label->new(N("Broadcast Address:"));
- $label_broadcast->set_justify('left');
- my $entry_broadcast = Gtk2::Entry->new;
- $box_broadcast->pack_end($entry_broadcast, 0, 0, 2);
- $box_broadcast->pack_end($label_broadcast, 0, 0, 2);
-
- my $box_domain = Gtk2::HBox->new(0,0);
- my $label_domain = Gtk2::Label->new(N("Domain Name:"));
- $label_domain->set_justify('left');
- my $entry_domain = Gtk2::Entry->new;
- $box_domain->pack_end($entry_domain, 0, 0, 2);
- $box_domain->pack_end($label_domain, 0, 0, 2);
-
- my $box_name_servers = Gtk2::HBox->new(0,0);
- my $box_name_servers_entry = Gtk2::VBox->new(0,0);
- my $label_name_servers = Gtk2::Label->new(N("Name Servers:"));
- $label_name_servers->set_justify('left');
- my $entry_name_server1 = Gtk2::Entry->new;
- my $entry_name_server2 = Gtk2::Entry->new;
- my $entry_name_server3 = Gtk2::Entry->new;
- $box_name_servers_entry->pack_start($entry_name_server1, 0, 0, 0);
- $box_name_servers_entry->pack_start($entry_name_server2, 0, 0, 0);
- $box_name_servers_entry->pack_start($entry_name_server3, 0, 0, 0);
- $box_name_servers->pack_end($box_name_servers_entry, 0, 0, 2);
- $box_name_servers->pack_end($label_name_servers, 0, 0, 2);
-
- my $label_ip_range_start = Gtk2::Label->new(N("IP Range Start:"));
- my $label_ip_range_end = Gtk2::Label->new(N("IP Range End:"));
- my $entry_ip_range_start = Gtk2::Entry->new;
- my $entry_ip_range_end = Gtk2::Entry->new;
-
- #- grab some default entries from the running system
-
- if (-e "/etc/sysconfig/network") {
- %netconfig = getVarsFromSh("/etc/sysconfig/network");
- $entry_domain->set_text($netconfig{DOMAINNAME});
- }
-
- my $sys_netmask = get_mask_from_sys();
- $entry_netmask->set_text($sys_netmask);
- $entry_subnet_mask->set_text($sys_netmask);
-
- my $sys_broadcast = get_broadcast_from_sys();
- $entry_broadcast->set_text($sys_broadcast);
- my $sys_subnet = get_subnet_from_sys($sys_broadcast, $sys_netmask);
-
- $entry_subnet->set_text($sys_subnet);
-
- my @route = grep { /^0.0.0.0/ } `/sbin/route -n`;
- @ifvalues = split(/[ \t]+/, $route[0]);
- $entry_routers->set_text($ifvalues[1]);
-
- @resolve = cat_("/etc/resolv.conf");
- my $i = 1;
- chop(@resolve);
-
- foreach (@resolve) {
- @ifvalues = split / /;
- if ($ifvalues[0] =~ /nameserver/ && $i < 4) {
- $nservers[$i++] = $ifvalues[1];
- }
- }
-
- $entry_name_server1->set_text($nservers[1]);
- $entry_name_server2->set_text($nservers[2]);
- $entry_name_server3->set_text($nservers[3]);
-
- my $dhcpd_conf = cat_("/etc/dhcpd.conf");
- if (-e "/etc/dhcpd.conf" && $dhcpd_conf !~ /drakTermServ/) {
- $button_msg = N("Append TS Includes To Existing Config");
- } else {
- $button_msg = N("Write Config");
- $new_config = 1;
- }
-
- gtkpack($status_box,
- $dhcpd_box = gtkpack_(Gtk2::HBox->new(1,10),
- 0, gtkadd(Gtk2::VBox->new,
- gtkadd($box_subnet),
- gtkadd($box_netmask),
- gtkadd($box_routers),
- gtkadd($box_subnet_mask),
- gtkadd($box_broadcast),
- gtkadd($box_domain),
- gtkadd($box_name_servers),
- ),
- 0, gtkadd(Gtk2::VBox->new(0,0),
- Gtk2::Label->new(N("dhcpd Server Configuration") . "\n\n" .
- N("Most of these values were extracted\nfrom your running system.\nYou can modify as needed.")),
- Gtk2::HSeparator->new,
- gtkadd(Gtk2::HBox->new,
- Gtk2::Label->new(N("Dynamic IP Address Pool:")),
- ),
- gtkadd(Gtk2::HBox->new(0,0),
- gtkadd(Gtk2::VBox->new,
- gtkadd($label_ip_range_start),
- gtkadd($entry_ip_range_start),
- ),
- gtkadd(Gtk2::VBox->new,
- gtkadd($label_ip_range_end),
- gtkadd($entry_ip_range_end),
- ),
- ),
- gtkadd(Gtk2::HBox->new),
- gtksignal_connect(Gtk2::Button->new($button_msg), clicked =>
- sub {
- if ($new_config == 1) {
- write_dhcpd_config("full",
- $entry_subnet->get_text,
- $entry_netmask->get_text,
- $entry_routers->get_text,
- $entry_subnet_mask->get_text,
- $entry_broadcast->get_text,
- $entry_domain->get_text,
- $entry_name_server1->get_text,
- $entry_name_server2->get_text,
- $entry_name_server3->get_text,
- $entry_ip_range_start->get_text,
- $entry_ip_range_end->get_text)
- } else {
- write_dhcpd_config("append", @nothing) if $dhcpd_conf !~ /dhcpd.conf.terminal-server/;
- }
- }
- ),
- Gtk2::HBox->new(0,10),
- ),
- ),
- );
-
- $central_widget = \$dhcpd_box;
- $dhcpd_box->show_all;
-}
-
-sub get_net_interface() {
- my @interfaces = `/sbin/route | grep -v lo | grep -v vmnet | tail +3 | awk '{print \$8}' | uniq`;
- chop @interfaces;
- my $count = @interfaces;
- if ($count == 1) {
- return @interfaces[0];
- } else {
- foreach (@interfaces) {
- my $is_default = `/sbin/route | grep $_ | grep default`;
- return $_ if !$is_default;
- }
- }
-}
-
-sub get_mask_from_sys() {
- my %netconfig;
- if (-e "/etc/sysconfig/network-scripts/ifcfg-$interface") {
- %netconfig = getVarsFromSh("/etc/sysconfig/network-scripts/ifcfg-$interface");
- $netconfig{NETMASK};
- }
-}
-
-sub get_subnet_from_sys {
- my ($sys_broadcast, $sys_netmask) = @_;
- my @subnet;
-
- my @netmask = split(/\./, $sys_netmask);
- my @broadcast = split(/\./, $sys_broadcast);
-
- foreach (0..3) {
- #- wasn't evaluating the & as expected
- my $val1 = $broadcast[$_] + 0;
- my $val2 = $netmask[$_] + 0;
- $subnet[$_] = $val1 & $val2;
- }
-
- join(".", @subnet);
-}
-
-sub get_broadcast_from_sys() {
- my @ifconfig = grep { /inet/ } `/sbin/ifconfig $interface`;
- my @ifvalues = split(/[: \t]+/, $ifconfig[0]);
-
- $ifvalues[5];
-}
-
-sub get_ip_from_sys() {
- my @ifconfig = grep { /inet/ } `/sbin/ifconfig $interface`;
- my @ifvalues = split(/[: \t]+/, $ifconfig[0]);
-
- $ifvalues[3];
-}
-
-sub write_dhcpd_config {
- my ($mode, $subnet, $netmask, $routers, $subnet_mask, $broadcast, $domain, $ns1, $ns2, $ns3, $pool_start, $pool_end) = @_;
- my @dhcpd_config;
-
- if ($mode eq "append") {
-print "got here...";
-print "PXE: $conf{CREATE_PXE}\n";
- append_to_file("/etc/dhcpd.conf", qq(include "/etc/dhcpd.conf.terminal-server";\n));
- push @dhcpd_config, qq(# Include PXE definitions and defaults\ninclude "/etc/dhcpd.conf.pxe.include";\n) if $conf{CREATE_PXE};
- push @dhcpd_config, qq(# Include Etherboot definitions and defaults\ninclude "/etc/dhcpd.conf.etherboot.include";\n);
- push @dhcpd_config, qq(# Include Etherboot default kernel version\ninclude "/etc/dhcpd.conf.etherboot.kernel";\n);
- push @dhcpd_config, qq(# Include client machine configurations\ninclude "$client_cfg";\n);
- output_p("/etc/dhcpd.conf.terminal-server", @dhcpd_config);
- $config_written = 1;
- return;
- }
-
- $nfs_subnet = $subnet;
- $nfs_mask = $subnet_mask;
-
- push @dhcpd_config, "#dhcpd.conf - generated by drakTermServ\n\n";
- push @dhcpd_config, "ddns-update-style none;\n\n";
- push @dhcpd_config, "# Long leases (48 hours)\ndefault-lease-time 172800;\nmax-lease-time 172800;\n\n";
- push @dhcpd_config, qq(# Include Etherboot definitions and defaults\ninclude "/etc/dhcpd.conf.etherboot.include";\n);
- push @dhcpd_config, qq(# Include PXE definitions and defaults\ninclude "/etc/dhcpd.conf.pxe.include";\n) if $conf{CREATE_PXE};
- push @dhcpd_config, qq(# Include Etherboot default kernel version\ninclude "/etc/dhcpd.conf.etherboot.kernel";\n\n);
- push @dhcpd_config, "# Network-specific section\n\n";
-
- push @dhcpd_config, "subnet $subnet netmask $netmask {\n";
- push @dhcpd_config, "\toption routers $routers;\n" if $routers;
- push @dhcpd_config, "\toption subnet-mask $subnet_mask;\n" if $subnet_mask;
- push @dhcpd_config, "\toption broadcast-address $broadcast;\n" if $broadcast;
- push @dhcpd_config, qq(\toption domain-name "$domain";\n) if $domain;
-
- my $pool_string = "\trange dynamic-bootp " . $pool_start . " " . $pool_end . ";\n" if $pool_start && $pool_end;
- push @dhcpd_config, $pool_string if $pool_string;
-
- my $ns_string = "\toption domain-name-servers " . $ns1 if $ns1;
- $ns_string = $ns_string . ", " . $ns2 if $ns2;
- $ns_string = $ns_string . ", " . $ns3 if $ns3;
- $ns_string = $ns_string . ";\n" if $ns_string;
- push @dhcpd_config, $ns_string if $ns_string;
-
- push @dhcpd_config, "}\n\n";
-
- push @dhcpd_config, qq(# Include client machine configurations\ninclude "$client_cfg";\n);
- output_p("/etc/dhcpd.conf", @dhcpd_config);
- $config_written = 1;
-}
-
-sub write_eb_image {
- #- write a bootable etherboot CD image or floppy - pxe images too
- my ($nic, $rom_path, $type) = @_;
- if ($type eq 'floppy') {
- my $in = interactive->vnew;
- if (-e "/dev/fd0") {
- my $result = $in->ask_okcancel('', N("Please insert floppy disk:"));
- return if !($result);
- $result = system("cat $rom_path/floppyload.bin $rom_path/start16.bin $rom_path/zimg/$nic > /dev/fd0") if $result;
- if ($result) {
- $in->ask_warn(N("Error"), N("Couldn't access the floppy!"))
- } else {
- $in->ask_warn(N("Information"), N("Floppy can be removed now"))
- }
- } else {
- $in->ask_warn(N("Error"), N("No floppy drive available!"));
- }
- } elsif ($type eq 'pxe') {
- system("cat $rom_path/pxeprefix.bin $rom_path/start16.bin $rom_path/zimg/$nic > $tftpboot/$nic.pxe");
- if (-e "$tftpboot/$nic.pxe") {
- $in->ask_warn(N("Information"), N("PXE image is %s/%s", $tftpboot, $nic))
- } else {
- $in->ask_warn(N("Error"), N("Error writing %s/%s", $tftpboot, $nic))
- }
- } else {
- mkdir_p("/tmp/eb");
- system("cat $rom_path/floppyload.bin $rom_path/start16.bin $rom_path/zimg/$nic > /tmp/eb/eb.img");
- system("dd if=/dev/zero of=/tmp/eb/eb.img bs=512 seek=72 count=2808");
- system("mkisofs -b eb.img -o /tmp/$nic.iso /tmp/eb");
- rm_rf("/tmp/eb");
- if (-e "/tmp/$nic.iso") {
- $in->ask_warn(N("Information"), N("Etherboot ISO image is %s", "/tmp/$nic.iso"))
- } else {
- $in->ask_warn(N("Error"), N("Something went wrong! - Is mkisofs installed?"))
- }
- }
-}
-
-sub enable_ts() {
- #- setup default config files for terminal server
-
- check_gdm();
-
- @buff = ();
- $buff[0] = "Enabling Terminal Server...\n\n";
- $buff[1] = "\tChecking default /etc/dhcpd.conf...\n";
- my $dhcpd_conf = cat_("/etc/dhcpd.conf");
- if ($dhcpd_conf !~ /drakTermServ/) {
- if (-e "/etc/dhcpd.conf") {
- write_dhcpd_config("append", @nothing) if $dhcpd_conf !~ /dhcpd.conf.terminal-server/;
- } else {
- if ($cmd_line == 1) {
- print("No /etc/dhcpd.conf built yet - use GUI to create!!\n");
- } else {
- $in->ask_warn(N("Error"), N("Need to create /etc/dhcpd.conf first!"));
- dhcpd_config();
- }
- return;
- }
- }
- #- suggestion from jmdault - not always needed
- if (! -e $client_cfg) {
- log::explanations("Touch file $client_cfg");
- `touch $client_cfg`;
- }
- my $buff_index = toggle_chkconfig("on", "dhcpd", 2);
- $buff[$buff_index] = "\tSetting up default /etc/exports...\n";
- cp_af("/etc/exports", "/etc/exports.mdkTS") if -e "/etc/exports";
- my $squash = "root_squash";
- my %msec = getVarsFromSh("/etc/sysconfig/msec");
- $squash = "no_root_squash" if $msec{SECURE_LEVEL} > 2;
- my $exports = "#/etc/exports - generated by drakTermServ\n\n";
- if ($nfs_subnet eq '') {
- $nfs_mask = get_mask_from_sys();
- my $sys_broadcast = get_broadcast_from_sys();
- $nfs_subnet = get_subnet_from_sys($sys_broadcast, $nfs_mask);
- }
- $exports .= "/\t$nfs_subnet/$nfs_mask(ro,$squash)\n";
- $exports .= "/home\t$nfs_subnet/$nfs_mask(rw,root_squash)\n";
- output_p("/etc/exports", $exports);
- $buff_index = toggle_chkconfig("on", "clusternfs", $buff_index+1);
- $buff_index = toggle_chkconfig("on", "tftp", $buff_index);
- $buff_index = service_change("xinetd", "restart", $buff_index);
- $buff[$buff_index] = "\n\tDone!";
-
- if ($cmd_line == 1) {
- print "@buff\n";
- return;
- }
-
- show_status(@buff);
-}
-
-sub disable_ts() {
- #- restore pre-terminal server configs
-
- @buff = ();
- $buff[0] = "Disabling Terminal Server...\n\n";
- $buff[1] = "\tRestoring original /etc/dhcpd.conf...\n";
- cp_af("/etc/dhcpd.conf.mdkTS", "/etc/dhcpd.conf") if -e "/etc/dhcpd.conf.mdkTS";
- substInFile { s|include "/etc/dhcpd.conf.terminal-server";|| } "/etc/dhcpd.conf";
- my $buff_index = toggle_chkconfig("off", "dhcpd", 2);
- $buff[$buff_index] = "\tRestoring default /etc/exports...\n";
- cp_af("/etc/exports.mdkTS", "/etc/exports") if -e "/etc/exports.mdkTS";
- $buff_index = toggle_chkconfig("off", "clusternfs", $buff_index+1);
- $buff_index = toggle_chkconfig("off", "tftp", $buff_index);
- $buff_index = service_change("xinetd", "restart", $buff_index);
- $buff[$buff_index] = "\n\tDone!";
-
- if ($cmd_line == 1) {
- print "@buff\n";
- return;
- }
-
- show_status(@buff);
-}
-
-sub toggle_chkconfig {
- #- change service config
- my ($state, $service, $buff_index) = @_;
- system("/sbin/chkconfig $service $state");
- $buff[$buff_index] = "\tTurning $service $state...\n";
- $buff_index++;
- $buff_index;
-}
-
-sub service_change {
- my ($service, $command, $buff_index) = @_;
- system("BOOTUP=serial /sbin/service $service $command > /tmp/drakTSservice.status 2>&1");
- my @result = cat_("/tmp/drakTSservice.status");
- foreach (@result) {
- $buff[$buff_index] = "\t$_";
- $buff_index++;
- }
- unlink "/tmp/drakTSservice.status";
- $buff_index;
-}
-
-sub start_ts() {
- #- start the terminal server
- my $pcimap = "/etc/dhcpd.conf.etherboot-pcimap.include";
-
- @buff = ();
- if (-f $pcimap) {
- $buff[0] = "Starting Terminal Server...\n\n";
- `touch /etc/dhcpd.conf.etherboot.kernel` if ! -f "/etc/dhcpd.conf.etherboot.kernel";
- my $buff_index = service_change("dhcpd", "start", 2);
- $buff_index = service_change("clusternfs", "start", $buff_index);
- $buff[$buff_index] = "\n\tDone!";
- } else {
- $buff[0] = "Missing $pcimap - please create net boot images for at least one kernel.";
- }
-
- if ($cmd_line == 1) {
- print "@buff\n";
- return;
- }
-
- show_status(@buff);
-}
-
-sub stop_ts() {
- #- stop the terminal server
-
- @buff = ();
- $buff[0] = "Stopping Terminal Server...\n\n";
- my $buff_index = service_change("dhcpd", "stop", 2);
- $buff_index = service_change("clusternfs", "stop", $buff_index);
- $buff[$buff_index] = "\n\tDone!";
-
- return if $in_wizard;
-
- if ($cmd_line == 1) {
- print "@buff\n";
- return;
- }
-
- show_status(@buff);
-
-}
-
-#- for the wizard, stop the server first
-sub restart_ts() {
- stop_ts();
- start_ts();
-}
-
-sub show_status() {
- text_view("@buff", "close");
-}
-
-sub adduser {
- my ($username) = @_;
- my @active_users = cat_("/etc/shadow");
- my @passwd_users = cat_("/etc/passwd");
- my @ts_users = cat_('/etc/shadow$$CLIENT$$');
- my $is_user = any { /$username/ } @active_users;
- my $add_fail = 0;
- my $in_already;
-
- if ($is_user) {
- my @shadow_entry = grep { /$username/ } @active_users;
- my @passwd_entry = grep { /$username/ } @passwd_users;
- my $is_ts_user = any { /$username/ } @ts_users;
- if ($is_ts_user) {
- my @ts_shadow = grep { /$username/ } @ts_users;
- if ($shadow_entry[0] eq $ts_shadow[0]) {
- $in_already = 1;
- } else {
- #in but password changed
- print N("%s passwd bad in Terminal Server - rewriting...\n", $username);
- deluser($username);
- adduser($username);
- }
- } else {
- # new ts user
- append_to_file('/etc/shadow$$CLIENT$$', $shadow_entry[0]) or $add_fail = 1;
- append_to_file('/etc/passwd$$CLIENT$$', $passwd_entry[0]) or $add_fail = 1;
- $in_already = 0;
- }
- }
-
- if ($cmd_line == 1) {
- print N("%s is not a user..\n", $username) if !($is_user);
- print N("%s is already a Terminal Server user\n", $username) if $in_already;
- if ($add_fail == 1 || $in_already || !$is_user) {
- print N("Addition of %s to Terminal Server failed!\n", $username);
- } else {
- print N("%s added to Terminal Server\n", $username);
- }
- return;
- } else {
- $in_already;
- }
-}
-
-sub deluser {
- # del a user from the shadow$$CLIENT$$ file
- my ($username) = @_;
- my $i;
- my $user_deleted;
- my @ts_users = cat_('/etc/shadow$$CLIENT$$');
- my @passwd_users = cat_('/etc/passwd$$CLIENT$$');
- my $is_ts_user = any { /$username/ } @ts_users;
- my $is_passwd_user = any { /$username/ } @passwd_users;
-
- if ($is_ts_user) {
- $i = 0;
- foreach my $user (@ts_users) {
- if ($user =~ /$username/) {
- splice(@ts_users, $i, 1);
- $user_deleted = 1;
- last;
- }
- $i++;
- }
- output_p('/etc/shadow$$CLIENT$$', @ts_users);
- }
-
- if ($is_passwd_user) {
- $i = 0;
- foreach my $user (@passwd_users) {
- if ($user =~ /$username/) {
- splice(@passwd_users, $i, 1);
- $user_deleted = 1;
- last;
- }
- $i++;
- }
- output_p('/etc/passwd$$CLIENT$$', @passwd_users);
- }
-
- if ($cmd_line == 1) {
- if ($user_deleted) {
- print N("Deleted %s...\n", $username);
- } else {
- print N("%s not found...\n", $username);
- }
- return;
- }
-}
-
-sub addclient {
- #- add a new client entry after checking for dups
- my ($hostname, $mac, $ip, $nbi, $is_thin, $local_config) = @_;
-
- my $host_in_use = 0;
- my $mac_in_use = 0;
- my $ip_in_use = 0;
- my %ts_clients = read_dhcpd_conf();
-
- foreach my $client (keys(%ts_clients)) {
- $host_in_use = 1 if $hostname eq $client;
- $mac_in_use = 1 if $mac eq $ts_clients{$client}{hardware};
- $ip_in_use = 1 if $ip eq $ts_clients{$client}{address};
- }
-
- if ($cmd_line == 1) {
- print N("%s already in use\n", $hostname) if $host_in_use;
- print N("%s already in use\n", $mac) if $mac_in_use;
- print N("%s already in use\n", $ip) if $ip_in_use;
- if ($host_in_use || $mac_in_use || $ip_in_use) {
- return;
- }
- }
-
- if (!$host_in_use && !$mac_in_use && !$ip_in_use) {
- $ts_clients{$hostname}{hardware} = $mac;
- $ts_clients{$hostname}{address} = $ip;
- if ($is_thin == 1) {
- $ts_clients{$hostname}{type} = "thin";
- } else {
- $ts_clients{$hostname}{type} = "fat";
- }
- $ts_clients{$hostname}{filename} = $nbi;
- if ($local_config == 1) {
- $ts_clients{$hostname}{hdw_config} = "true";
- client_hdw_config($ip, 1);
- } else {
- $ts_clients{$hostname}{hdw_config} = "false";
- client_hdw_config($ip, 0);
- }
- my $client_entry = format_client_entry($hostname, %ts_clients);
- append_to_file($client_cfg, $client_entry);
- $changes_made = 1;
- create_client_sysnetwork($hostname, $ip);
- 0;
- }
-}
-
-sub delclient {
- #- find a client and delete the entry in dhcpd.conf
- my ($hostname) = @_;
- my $host_found;
-
- my %ts_clients = read_dhcpd_conf();
-
- foreach my $client (keys(%ts_clients)) {
- if ($hostname eq $client) {
- $host_found = 1;
- clean_client_config($ts_clients{$client}{address});
- delete $ts_clients{$client};
- write_dhcpd_conf(%ts_clients);
- $changes_made = 1;
- return 0;
- }
- }
-
- if ($cmd_line == 1) {
- print N("%s not found...\n", $hostname) unless $host_found;
- return;
- }
-}
-
-sub change_gdm_xdmcp {
- my ($enable) = @_;
- my @conf_data = cat_("/etc/X11/gdm/gdm.conf");
- for (my $i = 0; $i < @conf_data; $i++) {
- $conf_data[$i] =~ s/^Enable=false/Enable=true/ if $enable eq "true";
- $conf_data[$i] =~ s/^Enable=true/Enable=false/ if $enable eq "false";
- # bail here so we don't alter the debug setting
- if ($conf_data[$i] eq "[debug]\n") {
- output("/etc/X11/gdm/gdm.conf", @conf_data);
- last;
- }
- }
-}
-
-sub update_hosts_allow {
- my ($mode) = @_;
- my $mask = get_mask_from_sys();
- my $subnet = `/sbin/ip route list dev $interface scope link | cut -f1 -d"/"`;
- chop $subnet;
- my $i;
- if ($mode eq "enable") {
- my $has_all = `grep ALL /etc/hosts.allow`;
- if ($has_all) {
- $in->ask_warn(N("Warning"), N("/etc/hosts.allow and /etc/hosts.deny already configured - not changed"));
- return;
- }
- if (!$has_all) {
- log::explanations("Modified file /etc/hosts.allow");
- append_to_file("/etc/hosts.allow", "ALL:\t$subnet/$mask 127.0.0.1\n");
- }
- $has_all = `grep ALL /etc/hosts.deny`;
- if (!$has_all) {
- log::explanations("Modified file /etc/hosts.deny");
- append_to_file("/etc/hosts.deny", "ALL:\tALL\n");
- }
- }
- if ($mode eq "disable") {
- my @allow = cat_("/etc/hosts.allow");
- for ($i = 0; $i < @allow; $i++) {
- if ($allow[$i] =~ /^ALL:\t$subnet/) {
- splice(@allow, $i, 1);
- log::explanations("Modified file /etc/hosts.allow");
- output("/etc/hosts.allow", @allow);
- last;
- }
- }
- my @deny = cat_("/etc/hosts.deny");
- for ($i = 0; $i < @deny; $i++) {
- if ($deny[$i] =~ /^ALL:\tALL/) {
- splice(@deny, $i, 1);
- log::explanations("Modified file /etc/hosts.deny");
- output("/etc/hosts.deny", @deny);
- last;
- }
- }
- }
-}
-
-sub format_client_entry {
- #- create a client entry, in proper format
- my ($client, %ts_clients) = @_;
- my ($pxe_img) = $ts_clients{$client}{filename} =~ /boot-(.*?)\./;
- $pxe_img .= ".zimg.pxe";
- my $pxe = -f "$tftpboot/$pxe_img";
- my $entry = "host $client {\n";
- $entry .= "\thardware ethernet\t$ts_clients{$client}{hardware};\n";
- $entry .= "\tfixed-address\t\t$ts_clients{$client}{address};\n";
- $entry .= "\t#type\t\t\t$ts_clients{$client}{type};\n" if $ts_clients{$client}{type};
- if ($ts_clients{$client}{filename}) {
- $entry .= join("\n", if_($pxe, qq(\tif substring (option vendor-class-identifier, 0, 9) = "PXEClient"
-\t{
-\t\tfilename\t\t"$pxe_img";
-\t}
-\telse if substring (option vendor-class-identifier, 0, 9) = "Etherboot"
-\t{)),
-qq(\tfilename\t\t"$ts_clients{$client}{filename}";),
- if_($pxe, qq(\t}))) . "\n";
- }
- $entry .= "\t#hdw_config\t\t$ts_clients{$client}{hdw_config};\n" if $ts_clients{$client}{hdw_config};
- $entry .= "}\n";
- if ($ts_clients{$client}{type} eq "thin") {
- write_thin_inittab($ts_clients{$client}{address})
- } else {
- eval { rm_rf("/etc/inittab\$\$IP=$ts_clients{$client}{address}\$\$") };
- }
- $entry
-}
-
-sub write_dhcpd_conf {
- my %ts_clients = @_;
- my @client_data;
- foreach my $key (keys(%ts_clients)) {
- my $client_entry = format_client_entry($key, %ts_clients);
- push @client_data, $client_entry;
- }
- output_p($client_cfg, @client_data);
-}
-
-sub read_dhcpd_conf() {
- my $clients = $client_cfg;
- my %ts_clients;
- my $hostname;
-
- #- read and parse current client entries
- my @client_data = cat_($clients);
- foreach (@client_data) {
- my ($name, $val, $val2) = split ' ';
- $val = $val2 if $name =~ /hardware/;
- $val =~ s/[;"]//g;
- if ($name !~ /}/) {
- if ($name =~ /host/) {
- $hostname = $val;
- } else {
- $name = "address" if $name =~ /fixed-address/;
- $name = "type" if $name =~ /#type/;
- $name = "hdw_config" if $name =~ /#hdw_config/;
- $ts_clients{$hostname}{$name} = $val;
- }
- }
- }
- %ts_clients;
-}
-
-sub client_hdw_config {
- my ($client_ip, $mode) = @_;
- # configure the files for a client to be able to
- # run drak tools locally and modify configs
- # mode 0 disables root logins but retains configs
- # mode 1 creates the new template files
- if ($mode == 1) {
- log::explanations("Allowing root access for $client_ip");
- my $suffix = "\$\$IP=$client_ip\$\$";
- cp_af('/etc/shadow$$CLIENT$$', "/etc/shadow$suffix");
- my @sys_users = cat_("/etc/shadow");
- foreach (@sys_users) {
- if (/^root:/) {
- # need root access to do the hardware config
- append_to_file("/etc/shadow$suffix", $_);
- last;
- }
- }
- # make all the local config files
- cp_af("/etc/sysconfig/mouse", "/etc/sysconfig/mouse$suffix") if -f "/etc/sysconfig/mouse";
- cp_af("/etc/X11/XF86Config", "/etc/X11/XF86Config$suffix") if -f "/etc/X11/XF86Config";
- cp_af('/etc/X11/xorg.conf$$CLIENT$$', "/etc/X11/xorg.conf$suffix") if -f '/etc/X11/xorg.conf$$CLIENT$$';
- cp_af("/dev/null", "/etc/modules.conf$suffix");
- cp_af("/dev/null", "/etc/modules$suffix");
- cp_af("/dev/null", "/etc/modprobe.conf$suffix");
- cp_af("/dev/null", "/etc/modprobe.preload$suffix");
- # create mount points so they can be edited by the client
- my $mnt_access = "$client_ip(rw,no_root_squash)";
- append_to_file("/etc/exports", "/etc/sysconfig/mouse$suffix\t$mnt_access\n");
- append_to_file("/etc/exports", "/etc/modules.conf$suffix\t$mnt_access\n");
- append_to_file("/etc/exports", "/etc/modules$suffix\t$mnt_access\n");
- append_to_file("/etc/exports", "/etc/modprobe.conf$suffix\t$mnt_access\n");
- append_to_file("/etc/exports", "/etc/modprobe.preload$suffix\t$mnt_access\n");
- append_to_file("/etc/exports", "/etc/X11/XF86Config$suffix\t$mnt_access\n");
- append_to_file("/etc/exports", "/etc/X11/xorg.conf$suffix\t$mnt_access\n");
- } else {
- log::explanations("Removing root access for $client_ip");
- eval { rm_rf("/etc/shadow\$\$IP=$client_ip\$\$") };
- remove_client_mounts($client_ip);
- }
-}
-
-sub create_client_sysnetwork {
- #- this lets gnome operate properly since udhcpc doesn't get the hostname from the dhcpd server
- my ($hostname, $ip) = @_;
- log::explanations("Adding /etc/sysconfig/network for $ip");
- my $network_file = "/etc/sysconfig/network\$\$IP=$ip\$\$";
- my @net_data = ("HOSTNAME=$hostname\n", "NETWORKING=yes\n", "FORWARD_IPV4=false\n");
- output_p($network_file, @net_data);
-}
-
-sub restart_server() {
- my $answer = $in->ask_yesorno('', N("Configuration changed - restart clusternfs/dhcpd?"));
- if ($answer == 1) {
- stop_ts();
- start_ts();
- $changes_made = 0;
- }
-}
-
-sub clean_client_config {
- my ($client_ip) = @_;
- # this routine entirely removes local hardware config settings
- log::explanations("Removing all local hardware config for $client_ip");
- my $suffix = "\$\$IP=$client_ip\$\$";
- eval { rm_rf("/etc/shadow$suffix") };
- eval { rm_rf("/etc/sysconfig/mouse$suffix") };
- eval { rm_rf("/etc/modules.conf$suffix") };
- eval { rm_rf("/etc/modules$suffix") };
- eval { rm_rf("/etc/modprobe.conf$suffix") };
- eval { rm_rf("/etc/modprobe.preload$suffix") };
- eval { rm_rf("/etc/X11/XF86Config$suffix") };
- eval { rm_rf("/etc/X11/xorg.conf$suffix") };
- eval { rm_rf("/etc/sysconfig/network$suffix") };
- remove_client_mounts($client_ip);
-}
-
-sub remove_client_mounts {
- my ($client_ip) = @_;
- #remove the mount points also
- log::explanations("Removing read/write mount points for $client_ip");
- substInFile {
- $_ = '' if /$client_ip/;
- } "/etc/exports";
-}
-
-sub destroy_widget() {
- if ($central_widget ne '') {
- $$central_widget->destroy;
- $central_widget = '';
- }
-}
diff --git a/perl-install/standalone/drakauth b/perl-install/standalone/drakauth
deleted file mode 100755
index 1d89e08d7..000000000
--- a/perl-install/standalone/drakauth
+++ /dev/null
@@ -1,42 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use interactive;
-use authentication;
-use network::network;
-
-my $netc = {};
-my $intf = {};
-read_all_conf('', $netc, $intf);
-
-my $in = 'interactive'->vnew('su');
-
-
-my $authentication = {}; # TODO
-
-my $kind = authentication::to_kind($authentication);
-my $meta_class = { getVarsFromSh("/etc/sysconfig/system") }->{META_CLASS};
-
-main:
-$in->ask_from(N("Authentication"), authentication::kind2description(),
- [
- { label => N("Authentication"), val => \$kind, type => 'list' , list => [ authentication::kinds($meta_class) ], format => \&authentication::kind2name },
- ]) or $in->exit;
-
-authentication::ask_parameters($in, $netc, $authentication, $kind) or goto main;
-
-eval {
- authentication::set($in, $netc, $authentication, sub { my ($f) = @_; $f->() });
- network::network::write_conf("$::prefix/etc/sysconfig/network", $netc);
-};
-if (my $err = $@) {
- $in->ask_warn(N("Error"), formatError($err));
- goto main;
-}
-
-
-$in->exit;
diff --git a/perl-install/standalone/drakautoinst b/perl-install/standalone/drakautoinst
deleted file mode 100755
index abc0e7ea1..000000000
--- a/perl-install/standalone/drakautoinst
+++ /dev/null
@@ -1,373 +0,0 @@
-#!/usr/bin/perl
-
-#
-# Guillaume Cottenceau (gc@mandrakesoft.com)
-#
-# Copyright 2001-2004 Mandrakesoft
-#
-# This software may be freely redistributed under the terms of the GNU
-# public license.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-#
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use interactive;
-use devices;
-use detect_devices;
-use steps;
-use commands;
-use fs;
-use Data::Dumper;
-
-
-local $_ = join '', @ARGV;
-
-my $direct = /-direct/;
-
-my $in = 'interactive'->vnew('su', 'default');
-
-my $imagefile = "/root/drakx/replay_install.img";
-my $imagefile2 = "/root/drakx/replay_install_drivers.img";
--f $imagefile or $in->ask_warn(N("Error!"),
- N("I can't find needed image file `%s'.", $imagefile), 1), quit_global($in, 0);
-
-$direct or $in->ask_okcancel(N("Auto Install Configurator"),
-N("You are about to configure an Auto Install floppy. This feature is somewhat dangerous and must be used circumspectly.
-
-With that feature, you will be able to replay the installation you've performed on this computer, being interactively prompted for some steps, in order to change their values.
-
-For maximum safety, the partitioning and formatting will never be performed automatically, whatever you chose during the install of this computer.
-
-Press ok to continue."), 1) or quit_global($in, 0);
-
-
-my @manual_steps = qw(doPartitionDisks formatPartitions);
-my @all_steps;
-my @choices;
-
-my $st = \%steps::installSteps;
-
-for (my $f = $st->{first}; $f; $f = $st->{$f}{next}) {
- next if member($f, @manual_steps);
- my $def_choice = 'replay';
- push @choices, { label => translate($st->{$f}{text}), val => \$def_choice, list => [ N("replay"), N("manual") ] };
- push @all_steps, [ $f, \$def_choice ];
-}
-
-$in->ask_from(N("Automatic Steps Configuration"),
- N("Please choose for each step whether it will replay like your install, or it will be manual"),
- \@choices
- ) or quit_global($in, 0);
-
-${$_->[1]} eq N("manual") and push @manual_steps, $_->[0] foreach @all_steps;
-
-my $mountdir = "/root/tmp/drakautoinst-mountdir"; -d $mountdir or mkdir $mountdir, 0755;
-my $floppy = detect_devices::floppy();
-my $dev = devices::make($floppy);
-my $again;
-do {
- $in->ask_okcancel('', N("Insert a blank floppy in drive %s", $floppy), 1) or quit_global($in, 0);
- log::explanations(N("Creating auto install floppy"));
- my $_w = $in->wait_message('', N("Creating auto install floppy"));
- eval {
- commands::dd("if=$imagefile", "of=$dev", "bs=1440", "count=1024");
- common::sync();
- };
- $again = $@; #- grrr... $@ is localized in code block :-(
-} while $again;
-fs::mount($dev, $mountdir, 'vfat', 0);
-
-if (-f $imagefile2) {
- do {
- eval { fs::umount($mountdir) };
- $in->ask_okcancel('', N("Insert another blank floppy in drive %s (for drivers disk)", $floppy), 1) or quit_global($in, 0);
- log::explanations(N("Creating auto install floppy (drivers disk)"));
- my $_w = $in->wait_message('', N("Creating auto install floppy"));
- eval {
- commands::dd("if=$imagefile2", "of=$dev", "bs=1440", "count=1024");
- common::sync();
- };
- $again = $@; #- grrr... $@ is localized in code block :-(
- } while $again;
- fs::mount($dev, $mountdir, 'ext2', 0);
-}
-
-my $cfgfile = "$mountdir/auto_inst.cfg";
-eval(cat_($cfgfile));
-my $o_old = $o; # BUG (maybe install's $::o ?)
-my %struct_gui;
-
-if (!$::isEmbedded && $in->isa('interactive::gtk')) {
- require ugtk2;
- ugtk2->import(qw(:helpers :wrappers :create));
-
- my %tree;
- $struct_gui{$_} = 'General' foreach qw(lang isUpgrade autoExitInstall timezone default_packages);
- $struct_gui{$_} = 'Security' foreach qw(crypto security);
- $struct_gui{$_} = 'Harddrive' foreach qw(partitions manualFstab useSupermount partitioning);
- $struct_gui{$_} = 'Network' foreach qw(intf netc netcnx);
- $struct_gui{$_} = 'Users' foreach qw(superuser users authentication);
- $struct_gui{$_} = 'Hardware' foreach qw(keyboard mouse X printer wacom nomouseprobe);
-
- my %pixmap = (lang => 'language',
- isUpgrade => '',
- security => 'security',
- autoExitInstall => '',
- timezone => '',
- default_packages => '',
- partitions => 'harddrive',
- manualFstab => 'partition',
- useSupermount => '',
- partitioning => 'partition',
- intf => 'network',
- netc => 'network',
- netcnx => 'network',
- superuser => 'user',
- users => 'user',
- authentication => '',
- keyboard => 'keyboard',
- mouse => 'mouse',
- X => 'X',
- printer => 'printer',
- wacom => '',
- );
-
- exists $struct_gui{$_} and push @{$tree{$struct_gui{$_}}}, [ $_ , $pixmap{$_}, h2widget($o->{$_}, "\$o->\{$_}") ] foreach keys %$o;
-
- my $W = ugtk2->new('$o edition');
- my @box_to_hide;
- my $nb_pages=0;
- my $notebook = Gtk2::Notebook->new;
- $notebook->set_show_border(0);
- $notebook->set_show_tabs(0);
- $notebook->append_page(gtkpack_(gtkset_border_width(Gtk2::VBox->new(0,0), 10),
- 1, Gtk2::VBox->new(0,0),
- 0, gtkpack_(Gtk2::HBox->new(0,0),
- 1, Gtk2::VBox->new(0,0),
- 0, gtkadd(gtkset_shadow_type(Gtk2::Frame->new, 'etched-in'),
- gtkcreate_img('mdk_logo')),
- 1, Gtk2::VBox->new(0,0),
- ),
- 0, N("\nWelcome.\n\nThe parameters of the auto-install are available in the sections on the left"),
- 1, Gtk2::VBox->new(0,0),
- ), undef);
- $notebook->show_all;
- $notebook->set_current_page(0);
-
- gtkadd($W->{window},
- gtkpack_(Gtk2::VBox->new(0,5),
- 1, gtkpack_(Gtk2::HBox->new(0,0),
- 0, gtkadd(gtkset_size_request(gtkset_shadow_type(Gtk2::Frame->new, 'in'), 130, 470),
- gtkpack_(Gtk2::VBox->new(0,0),
- map {
- my $box = Gtk2::VBox->new(0,0);
- push @box_to_hide, $box;
- $box->{vis} = 0;
- my @button_to_hide;
- 0, gtksignal_connect(Gtk2::Button->new($_), clicked => sub {
- if ($box->{vis}) { $box->hide; $box->{vis} = 0; $notebook->set_current_page(0) }
- else {
- $_->hide, $_->{vis}=0 foreach @box_to_hide;
- $box->show; $box->{vis} = 1;
- $box->{active_function} and $box->{active_function}->();
- }
- }), 1, gtkpack__($box,
- map {
- my $button = gtkset_relief(Gtk2::ToggleButton->new, 'none');
- push @button_to_hide, $button;
- my $gru = $_->[0];
- $notebook->append_page(gtkshow($_->[2]), undef);
- $nb_pages++;
- my $local_page = $nb_pages;
- my $function = sub { $notebook->set_current_page($local_page) };
- gtksignal_connect($button, toggled => sub {
- $button->get_active and $function->()
- });
- my $b;
- if ($_->[1] ne "") { $b = gtkcreate_img($_->[1]) } else { undef $b };
- gtksignal_connect(gtkadd($button,
- gtkpack__(Gtk2::VBox->new(0,3),
- $b,
- translate($gru),
- )
- ), released => sub {
- $button->get_active or $button->set_active(1), return;
- $_->set_active(0) foreach @button_to_hide;
- $button->set_active(1);
- $box->{active_function} = $function;
- $function->();
- })
- } @{$tree{$_}}
- )
- } keys(%tree)
- )
- ),
- 1, $notebook,
- ),
- 0, Gtk2::HSeparator->new,
- 0, gtkadd(gtkset_border_width(gtkset_layout(Gtk2::HButtonBox->new, 'end'), 5),
- gtksignal_connect(Gtk2::Button->new(N("Accept")), clicked => sub { Gtk2->main_quit }),
- gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => sub { $o = $o_old; Gtk2->main_quit; quit_global($in, 0) }),
- )
- )
- );
- $_->hide foreach @box_to_hide;
-# $W->{window}->show_all;
-# gtkadd($W->{window},
-# gtkpack_($W->create_box_with_title(N("Edit variables")),
-# 1, my $notebook = create_notebook( map { h2widget($o->{$_}, "\$o->\{$_\}"), $_ } keys %$o ),
-# 0, gtkpack(gtkset_border_width(Gtk2::HBox->new(0,0),5), $W->create_okcancel),
-# ),
-# );
-# $notebook->set_tab_pos('left');
-# $::isEmbedded and gtkflush();
- $W->main;
-# $W->destroy();
-}
-
-$o->{interactiveSteps} = \@manual_steps;
-
-my $str = join('',
-"#!/usr/bin/perl -cw
-#
-# Special file generated by ``drakautoinst''.
-#
-# You should check the syntax of this file before using it in an auto-install.
-# You can do this with 'perl -cw auto_inst.cfg.pl' or by executing this file
-# (note the '#!/usr/bin/perl -cw' on the first line).
-",
- Data::Dumper->Dump([$o], ['$o']), "\0");
-$str =~ s/ {8}/\t/g; #- replace all 8 space char by only one tabulation, this reduces file size so much :-)
-output($cfgfile, $str);
-
-fs::umount($mountdir);
-
-$in->ask_okcancel(N("Congratulations!"),
-N("The floppy has been successfully generated.
-You may now replay your installation."));
-
-quit_global($in, 0);
-
-
-sub quit_global {
- my ($in, $exitcode) = @_;
- $in->exit($exitcode);
-}
-
-
-
-sub h2widget {
- my ($k, $label) = @_;
- my $w;
- if (ref($k) =~ /HASH/) {
- my $vb;
- my @widget_list;
- my $i = -1;
- my @list_keys = keys(%$k);
- if (ref($k->{$list_keys[0]}) =~ /HASH/) {
- $i++;
- $w = gtkpack_(Gtk2::VBox->new(0,0),
- 1, create_scrolled_window(gtkpack__($vb = Gtk2::VBox->new(0,10),
- $widget_list[$i] = create_packtable({ col_spacings => 10, row_spacings => 3 },
- map {
- my $e;
- $e = h2widget($k->{$_}, "$label\{$_}");
- [ "$_ : ", $e ] } @list_keys
- ),
- )
- ),
- control_buttons($k->{$list_keys[0]},
- sub { my ($vb, $widget_list2, $ref_local_k, $i) = @_;
- my @widget_list = @$widget_list2;
- my $field = $in->ask_from_entry(N("Auto Install"), ("Enter the name of the new field you want to add")) or return undef;
- $field eq '' and return undef;
- gtkpack__($vb,
- $widget_list[$i] = create_packtable({ col_spacings => 10, row_spacings => 3 },
- [ "$field : ", h2widget($ref_local_k, "$label\{$field}") ])
- );
- @$widget_list2 = @widget_list;
- },
- $vb, \$i, \@widget_list)
- );
- } else {
- $w = create_packtable({ col_spacings => 10, row_spacings => 3 },
- map { create_entry_element($k->{$_}, "$label\{$_}", $_) } @list_keys
- )
- }
- } elsif (ref($k) =~ /ARRAY/) {
- my $vb;
- my @widget_list;
- my $i = -1;
- $w = gtkpack_(Gtk2::VBox->new(0,0),
- 1, create_scrolled_window(
- gtkpack__($vb = Gtk2::VBox->new(0,5),
- map { $i++; $widget_list[$i] = h2widget($_, "$label\[$i]") } @$k,
- )
- ),
- control_buttons($k->[0],
- sub { my ($vb, $widget_list2, $ref_local_k, $i) = @_;
- my @widget_list = @$widget_list2;
- gtkpack__($vb, $widget_list[$i] = h2widget($ref_local_k, "$label\[$i]"));
- @$widget_list2 = @widget_list;
- },
- $vb, \$i, \@widget_list)
- );
- } else {
- $w = create_packtable({ col_spacings => 10, row_spacings => 3 },
- create_entry_element($k, $label, $1)) if $label =~ /\$o->\{(.+)\}/;
- }
- return $w;
-}
-
-
-sub create_entry_element {
- my ($text, $value, $label) = @_;
- my $e;
- if (ref $text =~ /HASH/) {
- return [ "$label : ", h2widget($text, $label) ];
- } elsif (ref $text =~ /ARRAY/) {
- return [ "$label : ", h2widget($text, $label) ];
- } else {
- $e = Gtk2::Entry->new;
- $e->{value} = $value;
- my $_tag = Glib::Timeout->add(1000, sub { $e->set_text($text); 0 });
- gtksignal_connect($e, changed => sub {
- my $exe = $e->{value} . "='" . $e->get_text . "'";
- print "EXEC : $exe\n ";
- eval $exe;
- });
- }
- [ $label ? "$label : " : "" , $e ]
-}
-
-sub control_buttons {
- my ($ref_local_k, $local_gui, $vb, $j, $widget_list2) = @_;
- my @widget_list = @$widget_list2;
- my $i = $$j;
- ref($ref_local_k) =~ /HASH/ or return();
- my %local_k = %$ref_local_k;
- my ($button_remove);
- 0, gtkadd(gtkset_border_width(gtkset_layout(Gtk2::HButtonBox->new, 'spread'), 5),
- gtksignal_connect(Gtk2::Button->new(N("Add an item")), clicked => sub {
- $local_k{$_} = undef foreach keys %local_k;
- $i++;
- $local_gui->($vb, \@widget_list, \%local_k, $i) or $i--, return;
- $i >= 0 and $button_remove->set_sensitive(1);
- }
- ),
- gtksignal_connect($button_remove = Gtk2::Button->new(N("Remove the last item")), clicked => sub {
- $i >= 0 or return;
- $widget_list[$i]->destroy;
- $i--;
- $i >= 0 or $button_remove->set_sensitive(0);
- }
- )
- )
-}
diff --git a/perl-install/standalone/drakbackup b/perl-install/standalone/drakbackup
deleted file mode 100755
index 66dd80e82..000000000
--- a/perl-install/standalone/drakbackup
+++ /dev/null
@@ -1,4387 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2001-2004 Mandrakesoft by Sebastien DUPONT <dupont_s@epita.fr>
-# Updated 2002-2004 by Stew Benedict <sbenedict@mandrakesoft.com>
-# Redistribution of this file is permitted under the terms of the GNU
-# Public License (GPL)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use strict;
-
-use interactive;
-use common;
-use detect_devices;
-
-# Backend Options.
-# make this global for status screen
-my ($window1, $my_win);
-my $central_widget;
-my $previous_widget;
-my $current_widget;
-my $interactive;
-my $up_box;
-my $advanced_box;
-my $box2;
-my $cfg_file_exist = 0;
-my @user_list_all;
-my $DEBUG = 0;
-my $restore_sys = 1;
-my $restore_user = 1;
-my $restore_other = 1;
-my $restore_step_sys_date = "";
-my $restore_step_other_date = "";
-my @user_backuped;
-my @sys_backuped;
-my @other_backuped;
-my @user_list_to_restore;
-my @sys_list_to_restore;
-my @other_list_to_restore;
-my $button_box;
-my $button_box_tmp;
-my $next_widget;
-my $system_state;
-my $restore_state;
-my $save_path_entry;
-my $restore_find_path_entry;
-my $new_path_entry;
-my $pbar;
-my $pbar1;
-my $pbar2;
-my $pbar3;
-my $plabel;
-my $plabel1;
-my $plabel2;
-my $plabel3;
-my $stext;
-my $list_model;
-my $the_time;
-my @user_list_to_restore2;
-my $restore_path = "/";
-my $restore_other_path = 0;
-my $restore_other_src;
-my $path_to_find_restore;
-my $other_media_hd;
-my $backup_bef_restore = 0;
-my $table;
-my @user_list_backuped;
-my @files_corrupted;
-my %check_user_to_restore;
-my $remove_user_before_restore = 0;
-my @file_list_to_send_by_ftp;
-my $results;
-my @net_methods = ("ftp", "rsync", "ssh", "webdav");
-my @media_types = (translate(N_("hd")), "cd", translate(N_("tape")));
-my %cd_devices;
-my $std_device;
-my @tape_devices;
-my $in;
-
-# config. FILES -> Default PATH & Global variables.
-my @user_list;
-my $cfg_dir = "/etc/drakxtools/drakbackup/";
-my $cfg_file = $cfg_dir . "drakbackup.conf";
-my $log_file = "/var/log/drakbackup";
-my $log_buff;
-my $manual_user = 0;
-my $backup_daemon = 0;
-my $daemon = 0;
-my $use_hd = 1;
-my $custom_cron = 0;
-my $session_offset = '';
-my $scp_port = 22;
-my $user_home = $ENV{HOME};
-my $nonroot_user = 0;
-my $media_problem = 0;
-my $vol_name = 'Drakbackup';
-my $good_restore_path = 1;
-my @no_devices = translate(N_("No device found"));
-my %help;
-my %conf;
-my $time_string = "* * * * *";
-my $exec_string = "export USER=$ENV{USER}; /usr/sbin/drakbackup --daemon > /dev/null 2>&1";
-my $ignore_files_list;
-my @list_of_rpm_to_install;
-my @other_files;
-my @sys_files = "/etc";
-my @files_for_direct_tape;
-my $host_passwd;
-my $untar_prefix = "tar -C $restore_path -x";
-
-# allow not-root user with own config
-if ($ENV{USER} ne 'root' && $ENV{HOME} ne '/root') {
- standalone::explanations("Running as $ENV{USER}...");
- #- doesn't get defined when run from cron
- $user_home = "/home/$ENV{USER}" if $user_home eq '';
- $cfg_dir = "$user_home/.drakbackup/";
- $conf{PATH_TO_SAVE} = $cfg_dir . "backups";
- $log_file = $cfg_dir . "drakbackup.log";
- $nonroot_user = 1;
- $conf{NO_SYS_FILES} = 1;
- @user_list = $ENV{USER};
-} else {
- $user_home = "/root";
- $conf{PATH_TO_SAVE} = "/var/lib/drakbackup";
-}
-$cfg_file = $cfg_dir . "drakbackup.conf";
-my $backup_key = $user_home . "/.ssh/identity-drakbackup";
-
-foreach (@ARGV) {
- /--default/ and backend_mode();
- /--daemon/ and daemon_mode();
- /--show-conf/ and show_conf();
- /--cd-info/ and get_cd_info(), exit(0);
- /--debug/ and $DEBUG = 1, next;
-}
-
-sub setup_tooltips() {
- %help = (
- 'use_expect' => N("Expect is an extension to the TCL scripting language that allows interactive sessions without user intervention."),
- 'remember_pass' => N("Store the password for this system in drakbackup configuration."),
- 'erase_cdrw' => N("For a multisession CD, only the first session will erase the cdrw. Otherwise the cdrw is erased before each backup."),
- 'use_incr_decr' => N("This option will save files that have changed. Exact behavior depends on whether incremental or differential mode is used."),
- 'use_incremental' => N("Incremental backups only save files that have changed or are new since the last backup."),
- 'use_differential' => N("Differential backups only save files that have changed or are new since the original 'base' backup."),
- 'send_mail_to' => N("This should be a local user or email address that you want the backup results sent to. You will need to define a functioning mail server."),
- 'backupignore' => N("Files or wildcards listed in a .backupignore file at the top of a directory tree will not be backed up."),
- 'delete_files' => N("For backups to other media, files are still created on the hard drive, then moved to the other media. Enabling this option will remove the hard drive tar files after the backup."),
- 'dir_or_module' => N("Some protocols, like rsync, may be configured at the server end. Rather than using a directory path, you would use the 'module' name for the service path."),
- 'when_space' => N("Custom allows you to specify your own day and time. The other options use run-parts in /etc/crontab."),
- );
-}
-
-sub show_conf() {
- print "DrakBackup configuration:\n\n";
- read_conf_file();
- system_state();
- print "$system_state\n";
- exit(0);
-}
-
-sub backend_mode() {
- build_backup_files();
- exit(0);
-}
-
-sub daemon_mode() {
- $daemon = 1;
- build_backup_files();
- exit(0);
-}
-
-if (check_for_xserver()) {
- eval { require ugtk2 };
- die "Can't load ugtk2...\n" if $@;
- ugtk2->import(qw(:create :dialogs :helpers :wrappers));
- interactive_mode();
-} else {
- die "Can't run in console mode...";
-}
-
-sub set_help_tip {
- my ($entry, $key) = @_;
- gtkset_tip(Gtk2::Tooltips->new, $entry, formatAlaTeX($help{$key}));
-}
-
-sub all_user_list() {
- if ($nonroot_user) {
- @user_list_all = $ENV{USER};
- return;
- }
- my $user;
- my $uid;
- @user_list_all = ();
-
- my @passwd = cat_("/etc/passwd");
- foreach (@passwd) {
- ($user, $uid) = (split(/:/, $_))[0, 2];
- if ($uid >= 500 && $uid < 65000 || $uid == 0) {
- push @user_list_all, $user;
- }
- }
-}
-
-sub the_time() {
- my ($sec, $min, $hour, $day, $month, $year) = localtime(time());
- sprintf("_%d%02d%02d_%02d%02d%02d", $year + 1900, $month + 1, $day, $hour, $min, $sec);
-}
-
-sub get_tape_info() {
- my @line_data;
- my $info = "$ENV{HOME}/tmp/dmesg";
- @tape_devices = ();
- system("dmesg -s 100000 | grep 'st[0-9] at' > $info");
-
- my @info = cat_($info);
- foreach (@info) {
- @line_data = split(/[ \t,]+/, $_);
- push @tape_devices, "/dev/" . $line_data[3];
- }
- unlink($info);
-}
-
-sub get_free_space {
- my ($dir) = @_;
- my $free = `df -P $dir | tail -1`;
- my @line_data = split(/[ \t,]+/, $free);
- my $free_space = int($line_data[3] / 1024);
- return $free_space;
-}
-
-sub check_storage_quota {
- my ($dir) = @_;
- my $used = `du -b $dir`;
- my $used_space = $used / 1024 / 1024;
- if ($used_space > $conf{MAX_SPACE}) {
- return $used_space;
- } else {
- return 0;
- }
-}
-
-sub get_cd_info() {
- my @line_data;
- my @drive_names;
- my $i;
- require_rpm("cdrecord") if $nonroot_user;
- # just trying load ide-cd, since it doesn't seem to be loaded by default
- $nonroot_user ? `cdrecord -scanbus -dev=ATA > /dev/null 2>&1` : `modprobe ide-cd` unless -f "/proc/sys/dev/cdrom";
- my @cd_info = cat_("/proc/sys/dev/cdrom/info");
- my %data = (
- "drive speed" => 'speed',
- "Can change speed" => 'chg_speed',
- "Can read multisession" => 'multisession',
- "Can write CD-R" => 'cdr',
- "Can write CD-RW" => 'cdrw',
- "Can write DVD-R" => 'dvdr',
- "Can write DVD-RAM" => 'dvdram'
- );
-
- my $cd_drives;
- foreach (@cd_info) {
- @line_data = split(/[:\t]+/, $_);
- if ($line_data[0] =~ /drive name/) {
- $cd_drives = @line_data-1;
- chop($line_data[$cd_drives]);
- @drive_names = @line_data;
- print "drives: $cd_drives\n" unless $interactive;
- }
- chop($line_data[$cd_drives]) if $cd_drives;
- foreach my $key (keys %data) {
- if ($line_data[0] eq $key) {
- for ($i = 1; $i <= $cd_drives; $i++) {
- $cd_devices{$drive_names[$i]}{$data{$key}} = $line_data[$i];
- }
- }
- }
- }
-
- #- now just report the data if we called --cd-info from the command line
- foreach my $key (keys %cd_devices) {
- my $rec_dev = $key;
- my $prefix;
- $rec_dev =~ s/sr/sg/;
- $prefix = "ATAPI:" if $rec_dev =~ /hd/;
- my $can_record = $cd_devices{$key}{cdr} || $cd_devices{$key}{cdrw} || $cd_devices{$key}{dvdr};
- $cd_devices{$key}{rec_dev} = $prefix . "/dev/" . $rec_dev if $can_record;
- if (!$interactive) {
- print "\n{$key}->{rec_dev} = $cd_devices{$key}{rec_dev}\n";
- print "{$key}->{speed} = $cd_devices{$key}{speed}\n";
- print "{$key}->{chg_speed} = $cd_devices{$key}{chg_speed}\n";
- print "{$key}->{multisession} = $cd_devices{$key}{multisession}\n";
- print "{$key}->{cdr} = $cd_devices{$key}{cdr}\n";
- print "{$key}->{cdrw} = $cd_devices{$key}{cdrw}\n";
- print "{$key}->{dvdr} = $cd_devices{$key}{dvdr}\n";
- print "{$key}->{dvdram} = $cd_devices{$key}{dvdram}\n";
- } else {
- delete $cd_devices{$key} if $cd_devices{$key}{rec_dev} eq ''
- }
- }
-}
-
-
-sub save_conf_file() {
- write_sitecopyrc() if $conf{NET_PROTO} eq 'webdav';
- write_password_file() if $conf{NET_PROTO} eq 'rsync' && $conf{PASSWD};
- return 1 if $conf{SEND_MAIL} && verify_mail_setup();
- #- don't save this, but retain it for this session
- if ($conf{REMEMBER_PASS} != 1) {
- $host_passwd = $conf{PASSWD};
- $conf{PASSWD} = undef;
- }
- if ($backup_daemon && $conf{DAEMON_MEDIA} eq '') {
- show_warning("f", N("No media selected for cron operation."));
- return 1;
- }
- if ($backup_daemon && $conf{DAEMON_TIME_SPACE} eq '') {
- show_warning("f", N("No interval selected for cron operation."));
- return 1;
- }
- if (!$backup_daemon) {
- $conf{DAEMON_TIME_SPACE} = "";
- $conf{DAEMON_MEDIA} = "";
- }
- $conf{NO_USER_FILES} = '' if @user_list == ();
- $conf{OTHER_FILES} = list_to_conf(@other_files);
- $conf{HOME_FILES} = list_to_conf(@user_list);
- $conf{SYS_FILES} = list_to_conf(@sys_files);
- mkdir_p($cfg_dir) if !-d $cfg_dir;
- setVarsInSh($cfg_file, \%conf);
- $conf{PASSWD} = $host_passwd if $conf{REMEMBER_PASS} != 1;
- chmod(0600, $cfg_file);
- save_cron_files();
- 0;
-}
-
-sub read_cron_files() {
- my $daemon_found = 0;
- foreach (qw(hourly daily weekly monthly)) {
- if (-f "/etc/cron.$_/drakbackup" && !$nonroot_user) {
- $conf{DAEMON_TIME_SPACE} = $_;
- $daemon_found = 1;
- last;
- }
- }
- if ($conf{DAEMON_TIME_SPACE} ne "custom") {
- !$daemon_found and $backup_daemon = 0;
- } else {
- $custom_cron = 1;
- my $tmpcron = "$ENV{HOME}/tmp/crontab.tmp";
- $tmpcron = `crontab -l | tail +4`;
- my @cronline = grep { /drakbackup/ } $tmpcron;
- if (@cronline) {
- @cronline = split(" ", $cronline[0]);
- my @crondetail = splice(@cronline, 0, 5);
- $time_string = join(" ", @crondetail);
- }
- }
-}
-
-sub save_cron_files() {
- my $tmpcron = "$ENV{HOME}/tmp/crontab.tmp";
-
- if ($nonroot_user && $conf{DAEMON_TIME_SPACE} ne "custom" && $conf{DAEMON_TIME_SPACE} ne '' && $backup_daemon) {
- show_warning("w", N("Interval cron not available as non-root"));
- $conf{DAEMON_TIME_SPACE} = 'custom';
- return 1;
- } else {
- foreach (qw(hourly daily weekly monthly)) {
- -f "/etc/cron.$_/drakbackup" and rm_rf("/etc/cron.$_/drakbackup") if !$nonroot_user;
- }
- }
- my @cron_file = ("#!/bin/sh\n", "export USER=root\n", "/usr/sbin/drakbackup --daemon > /dev/null 2>&1\n");
-
- if ($conf{DAEMON_TIME_SPACE} ne "custom" && $conf{DAEMON_TIME_SPACE} ne '' && $backup_daemon) {
- output_p("/etc/cron.$conf{DAEMON_TIME_SPACE}/drakbackup", @cron_file);
- system("chmod +x /etc/cron.$conf{DAEMON_TIME_SPACE}/drakbackup");
- }
- if ($conf{DAEMON_TIME_SPACE} eq "custom" || !$backup_daemon) {
- my $newdetail = join(" ", $time_string, $exec_string, "\n") if $backup_daemon;
- system("crontab -l | tail +4 > $tmpcron");
- my @cronlines = cat_($tmpcron);
- my $index = 0;
- foreach (@cronlines) {
- if (/$exec_string/) {
- splice(@cronlines, $index, 1);
- }
- $index++
- }
- push(@cronlines, $newdetail) if $backup_daemon;
- output($tmpcron, @cronlines);
- system("crontab $tmpcron");
- unlink($tmpcron);
- }
-}
-
-sub upgrade_conf_file() {
- my @new_conf;
- $DEBUG and print "Old syntax...upgrading...\n";
- my @conf_data = cat_($cfg_file);
- chop @conf_data;
- foreach (@conf_data) {
- push @new_conf, $_ . "=1\n" if !/=/;
- if (/^OTHER_FILES/) {
- my (@new_data) = split /=/;
- my @new_args = split(" ", $new_data[1]);
- push @new_conf, $new_data[0] . "=" . join(",", @new_args) . "\n";
- } elsif (/=/ && !/TAR.GZ/) {
- my $has_arg = split /=/;
- push @new_conf, "$_\n" if $has_arg > 1;
- } elsif (/=/ && /TAR.GZ/) {
- push @new_conf, "OPTION_COMP=tar.gz";
- }
- }
- output_p($cfg_file, @new_conf);
-}
-
-sub read_conf_file() {
- if (-e $cfg_file) {
- my $conf_version = `grep USE_HD $cfg_file`;
- upgrade_conf_file() if $conf_version !~ /^USE_HD=1/;
- %conf = getVarsFromSh($cfg_file);
- @other_files = conf_to_list($conf{OTHER_FILES});
- @user_list = conf_to_list($conf{HOME_FILES});
- @sys_files = conf_to_list($conf{SYS_FILES}) if exists($conf{SYS_FILES});
- $backup_daemon = 1 if exists($conf{DAEMON_TIME_SPACE});
- $conf{PASSWD} = $host_passwd if $conf{REMEMBER_PASS} != 1;
- read_cron_files();
- $cfg_file_exist = 1;
- } else {
- $cfg_file_exist = 0;
- #- these were 1 by default, but that made it so the user could never save the
- #- inverse behavior. this allows incremental as the default if not configured
- $conf{SYS_INCREMENTAL_BACKUPS} = 1;
- $conf{USER_INCREMENTAL_BACKUPS} = 1;
- }
- # some basic defaults
- $conf{SMTP_SERVER} = "localhost" if !exists($conf{SMTP_SERVER});
- $conf{MAX_SPACE} = 1000.0 if !exists($conf{MAX_SPACE});
- $conf{USE_HD} = 1 if !exists($conf{USE_HD});
- $conf{OPTION_COMP} = "tar.gz" if !exists($conf{OPTION_COMP});
- # deal with users that may have been deleted from the system
- check_valid_users() if $cfg_file_exist;
- $use_hd = !($conf{USE_CD} || $conf{USE_TAPE} || $conf{USE_NET});
-}
-
-sub verify_mail_setup() {
- all_user_list() if @user_list_all == ();
- if ($conf{USER_MAIL} ne "root" && $conf{USER_MAIL} !~ /[\w.-]*\@[\w.-]/ && !member($conf{USER_MAIL}, @user_list_all)) {
- show_warning("f", N("\"%s\" neither is a valid email nor is an existing local user!", $conf{USER_MAIL}));
- return 1;
- }
- if (member($conf{USER_MAIL}, @user_list_all) && $conf{SMTP_SERVER} ne "localhost") {
- show_warning("f", N("\"%s\" is a local user, but you did not select a local smtp, so you must use a complete email address!", $conf{USER_MAIL}));
- return 1;
- }
-}
-
-sub check_valid_users() {
- all_user_list();
- my @new_user_list = intersection(\@user_list, \@user_list_all);
- if (@user_list != @new_user_list) {
- log::l(N("Valid user list changed, rewriting config file."));
- if ($DEBUG) {
- print N("Old user list:\n");
- print "@user_list\n";
- print N("New user list:\n");
- print "@new_user_list\n";
- }
- @user_list = @new_user_list;
- save_conf_file();
- }
-}
-
-sub write_sitecopyrc() {
- #- FIXME - how to deal with existing sitecopyrc
- my @cfg_list = ("site drakbackup\n",
- "\tserver $conf{HOST_NAME}\n",
- "\tremote /$conf{HOST_PATH}\n",
- "\tlocal $conf{PATH_TO_SAVE}\n",
- "\tusername $conf{LOGIN}\n",
- "\tpassword $conf{PASSWD}\n",
- "\tprotocol webdav\n"
- );
- output_p("$user_home/.sitecopyrc", @cfg_list);
- chmod(0600, "$user_home/.sitecopyrc");
- -d "$user_home/.sitecopy" or mkdir_p("$user_home/.sitecopy");
- chmod(0700, "$user_home/.sitecopy");
-}
-
-sub write_password_file() {
- output_p("$cfg_dir/rsync.user", "$conf{PASSWD}\n");
- chmod(0600, "$cfg_dir/rsync.user");
-}
-
-sub show_warning {
- my ($mode, $warning) = @_;
- $mode = N("Warning") if $mode eq "w";
- $mode = N("Error") if $mode eq "f";
- $mode = N("Information") if $mode eq "i";
- if ($interactive) {
- $in->ask_warn($mode, translate($warning));
- } else {
- warn "$mode: $warning\n";
- }
- $log_buff .= "\n$mode: $warning\n";
-}
-
-sub complete_results() {
- system_state();
- $results .= "***********************************************************************\n\n";
- $daemon or $results .= N("\n DrakBackup Report \n");
- $daemon and $results .= N("\n DrakBackup Daemon Report\n");
- my $datem = `date`;
- $results .= " $datem\n\n";
- $results .= "***********************************************************************\n\n";
- $results .= $system_state;
- $results .= "\n\n***********************************************************************\n\n";
- $results .= N("\n DrakBackup Report Details\n\n\n");
- $results .= "***********************************************************************\n\n";
-}
-
-sub ftp_client() {
- use Net::FTP;
- my $ftp;
-
- foreach (1..5) {
- $ftp = Net::FTP->new($conf{HOST_NAME}, Debug => 0) or return 1;
- $ftp && $ftp->login($conf{LOGIN}, $conf{PASSWD}) and last;
- log::l("ftp login failed, sleeping before trying again");
- sleep 5 * $_;
- $ftp = 0;
- }
- return 1 if !$ftp;
- $ftp->binary;
- $ftp->cwd($conf{HOST_PATH});
- foreach (@file_list_to_send_by_ftp) {
- $interactive and $pbar->set_fraction(0);
- $interactive and progress($pbar, $plabel, 0.5, $_);
- $interactive and $pbar->set_text($_);
- $ftp->put($_, undef, undef);
- $interactive and progress($pbar, $plabel, 0.5, $_);
- $interactive and $pbar->set_text($_);
- $interactive and progress($pbar3, $plabel3, 1/@file_list_to_send_by_ftp, N("Total progress"));
- }
- $ftp->quit;
- return 0;
-}
-
-sub do_expect {
-
- #- Sort of a general purpose expect routine, we use it to backup files to
- #- a remote server, as well as transfer a key and restore.
- #- Using the key after it is setup is preferred.
-
- my ($mode) = @_;
-
- eval { require Expect };
-
- if ($@) {
- #- should have already been installed during configuration
- $log_buff .= "perl-Expect not installed!" if check_pkg_needs();
- return 1;
- }
-
- #- for debugging set to 1
- $Expect::Exp_Internal = 0;
- #- for debugging set to 1
- $Expect::Debug = 0;
- $Expect::Log_Stdout = 0;
-
- my $spawn_ok;
- my $no_perm;
- my $bad_passwd;
- my $bad_dir;
- my $had_err;
- my $timeout = 20;
-
- my $exp_command;
- my @send_files = "$backup_key.pub";
-
- #- just bypass progress for sendkey for now
- my $no_prog = 1;
- $no_prog = 0 if $mode eq "sendkey";
-
- @send_files = @file_list_to_send_by_ftp if $mode eq "backup";
-
- $interactive && $no_prog and $pbar->set_fraction(0);
- $interactive && $no_prog and $pbar3->set_fraction(0);
- $interactive && $no_prog and progress($pbar, $plabel, 0.5, "File Transfer...");
-
- foreach (@send_files) {
- $exp_command = "scp -P $scp_port $_ $conf{LOGIN}\@$conf{HOST_NAME}:$conf{HOST_PATH}" if $mode eq "backup";
- $exp_command = "ssh-copy-id -i $_ $conf{LOGIN}\@$conf{HOST_NAME}" if $mode eq "sendkey";
-
- if (-e $backup_key && $mode eq "sendkey") {
- if ($in->ask_yesorno(N("Warning"), N("%s exists, delete?\n\nIf you've already done this process you'll probably\n need to purge the entry from authorized_keys on the server.", $backup_key))) {
- unlink($backup_key);
- unlink($backup_key . '.pub');
- } else {
- return 0;
- }
- }
-
- if (!(-e $backup_key) && $mode eq "sendkey") {
- $in->ask_warn(N("Information"), N("This may take a moment to generate the keys."));
- gtkset_mousecursor_wait();
- #- not using a passphrase for the moment
- system("ssh-keygen", "-P", "", "-t", "dsa", "-f", $backup_key);
- gtkset_mousecursor_normal();
- }
-
- my $exp = Expect->spawn($exp_command) or $in->ask_warn(N("Error"), N("Cannot spawn %s.", $exp_command));
-
- $interactive && $no_prog and progress($pbar3, $plabel3, 1/@send_files, N("Total progress"));
- $interactive && $no_prog and $stext->set_text($_);
-
- #- run scp, look for some common errors and try to track successful progress for GUI
- $exp->expect($timeout,
- [ qr 'password: $', sub {
- $spawn_ok = 1;
- my $fh = shift;
- $fh->send("$conf{PASSWD}\n");
- Expect::exp_continue() } ],
- [ '-re', 'please try again', sub { $bad_passwd = 1; Expect::exp_continue() } ],
- [ '-re', 'Permission denied', sub { $no_perm = 1; Expect::exp_continue() } ],
- [ '-re', 'No such file or directory', sub { $bad_dir = 1; Expect::exp_continue() } ],
-# [ '-re', '%', sub { update_scp_progress(); Expect::exp_continue(); } ],
- [ eof => sub {
- if (!$spawn_ok) { show_warning("f", N("No password prompt on %s at port %s", $conf{HOST_NAME}, $scp_port)) }
- if ($bad_passwd) { show_warning("f", N("Bad password on %s", $conf{HOST_NAME})) }
- if ($no_perm) { show_warning("f", N("Permission denied transferring %s to %s", $_, $conf{HOST_NAME})) }
- if ($bad_dir) { show_warning("f", N("Can't find %s on %s", $conf{HOST_PATH}, $conf{HOST_NAME})) }
- $had_err = !$spawn_ok || $bad_passwd || $no_perm || $bad_dir;
- }
- ],
- [ timeout => sub { show_warning("f", N("%s not responding", $conf{HOST_NAME})) } ],
- );
-
- my $exit_stat = $exp->exitstatus;
- $in->ask_warn(N("Information"), N("Transfer successful\nYou may want to verify you can login to the server with:\n\nssh -i %s %s\@%s\n\nwithout being prompted for a password.", $backup_key, $conf{LOGIN}, $conf{HOST_NAME})) if $exit_stat == 0 && !$had_err && $mode eq "sendkey";
- $log_buff .= "$_\n" if $exit_stat == 0 && $mode eq "backup";
- $exp->hard_close;
- }
- $interactive && $no_prog and progress($pbar, $plabel, 0.5, "Done...");
-}
-
-sub ssh_client() {
- $DEBUG and print "file list to send: $_\n " foreach @file_list_to_send_by_ftp;
- my $command;
- my $value;
-
- foreach (@file_list_to_send_by_ftp) {
- if ($conf{USER_KEYS}) {
- $command = "scp -P $scp_port $_ $conf{LOGIN}\@$conf{HOST_NAME}:$conf{HOST_PATH}";
- } else {
- $command = "scp -P $scp_port -i $backup_key $_ $conf{LOGIN}\@$conf{HOST_NAME}:$conf{HOST_PATH}";
- }
- $interactive and $pbar->set_fraction(0);
- $interactive and progress($pbar, $plabel, 0.5, "File Transfer...");
- $interactive and $stext->set_text($_);
- $log_buff .= $command . "\n\n";
- my $TMP;
- open $TMP, "$command 2>&1 |";
- while ($value = <$TMP>) {
- $log_buff .= $value;
- }
- close $TMP;
- $log_buff .= "\n";
- $interactive and progress($pbar, $plabel, 0.5, "Done...");
- $interactive and progress($pbar3, $plabel3, 1/@file_list_to_send_by_ftp, N("Total progress"));
- }
- return 0;
-}
-
-sub webdav_client() {
- $DEBUG and print "file list to send: $_\n " foreach @file_list_to_send_by_ftp;
- if (!(-e "$user_home/.sitecopy/drakbackup")) {
- my $command = "sitecopy -f $conf{HOST_PATH}";
- spawn_progress($command, "Initializing sitecopy");
- }
- my $command = "sitecopy -u drakbackup";
- spawn_progress($command, "Running sitecopy...");
- if ($log_buff =~ /Nothing to do - no changes found/) {
- show_warning("w", N("WebDAV remote site already in sync!"));
- return 1;
- }
- if ($log_buff !~ /Update completed successfully/) {
- show_warning("f", N("WebDAV transfer failed!"));
- return 1;
- }
- return 0;
-}
-
-sub rsync_client() {
- $DEBUG and print "file list to send: $_\n " foreach @file_list_to_send_by_ftp;
- my $rsync_cmd = "rsync -tv $conf{PATH_TO_SAVE}/* ";
- $rsync_cmd = $rsync_cmd . "--password-file=$cfg_dir/rsync.user " if $conf{PASSWD};
- $rsync_cmd = $rsync_cmd . "$conf{LOGIN}\@" if $conf{LOGIN};
- $rsync_cmd = $rsync_cmd . $conf{HOST_NAME} . "::" . $conf{HOST_PATH};
- spawn_progress($rsync_cmd, "Running rsync");
- return 0;
-}
-
-sub check_for_cd() {
- #- check for a cd
- my $command = "cdrecord dev=$conf{CD_DEVICE} -atip";
- spawn_progress($command, "Check for media in drive");
- if ($log_buff =~ /No disk/) {
- show_warning("f", N("No CD-R/DVD-R in drive!"));
- return 1;
- }
- if ($log_buff !~ /ATIP info from disk|ATIP start of lead in|Found DVD media/) {
- show_warning("f", N("Does not appear to be recordable media!"));
- return 1;
- }
- #- non-fatal, just disable erase
- if (($log_buff =~ /Is not erasable/ || $log_buff =~ /Found DVD media/) && $conf{MEDIA_ERASE}) {
- show_warning("w", N("Not erasable media!"));
- $conf{MEDIA_ERASE} = 0;
- save_conf_file();
- }
-
- if ($conf{MULTI_SESSION}) {
- $command = "cdrecord -s dev=$conf{CD_DEVICE} -msinfo";
- spawn_progress($command, "Check for previous session status");
- #- if we don't find a previous session, start fresh
- if ($log_buff =~ /Cannot read session offset/) {
- $conf{MEDIA_ERASE} = 1;
- return 0;
- } else {
- #- extract the session info from $log_buff
- my $code_loc = rindex($log_buff, "msinfo") + 8;
- if ($code_loc != -1) {
- my $bufflen = length($log_buff);
- $session_offset = substr($log_buff, $code_loc, $bufflen-$code_loc-1);
- return 0;
- }
- return 1;
- }
- }
-}
-
-sub write_on_cd() {
- my $command = "cdrecord -v dev=$conf{CD_DEVICE} -data ";
- # DVD+RW use -sao
- $command .= "-sao " if $conf{DVDRW};
- #- only blank if it's the first session
- $command .= "blank=fast " if $conf{MEDIA_ERASE} && $session_offset eq '';
- #- multi-session mode
- $command .= "-multi -pad " if $conf{MULTI_SESSION};
- $command .= "$conf{PATH_TO_SAVE}/drakbackup.iso";
-
- spawn_progress($command, "Running cdrecord");
- unlink("$conf{PATH_TO_SAVE}/drakbackup.iso");
-}
-
-sub erase_cdrw() {
- #- we can only hit this via interactive
- $interactive = 0;
- $in->ask_warn(N("Information"), N("This may take a moment to erase the media."));
- gtkset_mousecursor_wait();
- my $command = "cdrecord dev=$conf{CD_DEVICE} -blank=fast";
- spawn_progress($command, "Erasing CDRW...");
- gtkset_mousecursor_normal();
- $interactive = 1;
-}
-
-sub spawn_progress {
- my ($command, $descr) = @_;
- my $value;
- my $timer;
- $interactive and progress($pbar3, $plabel3, 0, translate($descr));
- $interactive and $pbar3->set_pulse_step(0.1);
- $interactive and $timer = Glib::Timeout->add(20, sub { $pbar3->pulse });
-
- $log_buff .= "\n" . $descr . ":\n";
- $log_buff .= $command . "\n\n";
-
- standalone::explanations("Running $command");
- my $TMP;
- open $TMP, "$command 2>&1 |";
- while ($value = <$TMP>) {
- $log_buff .= $value;
- if ($interactive) {
- $stext->set_text($value);
- gtkflush();
- }
- }
- close $TMP;
- $interactive and Glib::Source->remove($timer);
-}
-
-sub get_cd_volname() {
- my $vol_device = $conf{CD_DEVICE};
- $vol_device =~ s/sg/scd/;
- $vol_name = `volname $vol_device` if $conf{CD_DEVICE};
- $vol_name =~ s/[ \t]+\n$//;
- $vol_name;
-}
-
-sub build_iso() {
- if ($conf{MULTI_SESSION} && $session_offset) {
- $vol_name = get_cd_volname();
- } else {
- $vol_name = "Drakbackup" . $the_time;
- }
- #this is safe to change the volname on rewrites, as is seems to get ignored anyway
- my $command = "mkisofs -r -J -T -v -V '$vol_name' ";
- $command .= "-C $session_offset -M $conf{CD_DEVICE} " if $conf{MULTI_SESSION} && $session_offset;
- $command .= "-o $conf{PATH_TO_SAVE}/drakbackup.iso @file_list_to_send_by_ftp";
- spawn_progress($command, "Running mkisofs...");
-}
-
-sub build_cd() {
- if (!check_for_cd()) {
- build_iso();
- if ($log_buff =~ /Permission denied/) {
- show_warning("f", N("Permission problem accessing CD."));
- $media_problem = 1;
- return 1;
- } else {
- write_on_cd();
- }
- }
-}
-
-sub get_tape_label {
- my ($device) = @_;
- gtkset_mousecursor_wait();
- system("mt -f $device rewind");
- system("tar -C $cfg_dir -xf $device");
- my @volname = cat_("$cfg_dir/drakbackup.label");
- unlink("$cfg_dir/drakbackup.label");
- $vol_name = $volname[0];
- gtkset_mousecursor_normal();
- $vol_name;
-}
-
-sub build_tape() {
- my $command;
- #- do we have a tape?
- $command = "mt -f $conf{TAPE_DEVICE} status";
- spawn_progress($command, "Checking for tape");
- if ($log_buff =~ /DR_OPEN/) {
- show_warning("f", N("No tape in %s!", $conf{TAPE_DEVICE}));
- return 1;
- }
-
- #- try to roll to the end of the data if we're not erasing
- if (!$conf{MEDIA_ERASE}) {
- $command = "mt -f $conf{TAPE_DEVICE} rewind";
- spawn_progress($command, "Rewind to find tape label");
- $command = "tar -tf $conf{TAPE_DEVICE}";
- spawn_progress($command, "Check for label");
- if ($log_buff =~ /drakbackup.label/) {
- if ($conf{TAPE_NOREWIND}) {
- $command = "mt -f $conf{TAPE_DEVICE} rewind";
- spawn_progress($command, "Rewind to get tape label");
- }
- $command = "tar -C $cfg_dir -xf $conf{TAPE_DEVICE}";
- spawn_progress($command, "Reading tape label");
- my @volname = cat_("$cfg_dir/drakbackup.label");
- unlink("$cfg_dir/drakbackup.label");
- $vol_name = $volname[0];
- }
- $command = "mt -f $conf{TAPE_DEVICE} eod";
- spawn_progress($command, "Running mt to find eod");
- } else {
- $command = "mt -f $conf{TAPE_DEVICE} rewind";
- spawn_progress($command, "Running mt to rewind");
- # make a tape label for the catalog
- # if we're using the rewinding device, change modes briefly
- if (!$conf{TAPE_NOREWIND}) {
- $conf{TAPE_DEVICE} =~ s|/st|/nst|;
- }
- $vol_name = "Drakbackup" . $the_time;
- my $f = "$cfg_dir/drakbackup.label";
- output($f, $vol_name);
- $command = "tar -C $cfg_dir -cf $conf{TAPE_DEVICE} drakbackup.label;";
- spawn_progress($command, "Creating tape label");
- unlink $f;
- if (!$conf{TAPE_NOREWIND}) {
- $conf{TAPE_DEVICE} =~ s|/nst|/st|;
- }
- }
-
- #- do the backup
- $command = "tar -cvf $conf{TAPE_DEVICE} ";
- if ($conf{DIRECT_TAPE}) {
- ($command, undef) = handle_ignores($command, undef, @files_for_direct_tape);
- $command .= " @files_for_direct_tape";
- } else {
- $command .= " @file_list_to_send_by_ftp";
- }
- spawn_progress($command, "Running tar to tape");
-
- #- eject the tape?
- if ($conf{MEDIA_EJECT}) {
- $command = "mt -f $conf{TAPE_DEVICE} rewoff";
- spawn_progress($command, "Running mt to eject tape");
- }
-}
-
-sub send_mail {
- my ($result) = @_;
- my $datem = `date`;
- use Mail::Mailer;
- my $mailer = Mail::Mailer->new('smtp', Server => $conf{SMTP_SERVER});
- $mailer->open({ From => 'drakbackup',
- To => $conf{USER_MAIL},
- Subject => "DrakBackup report on $datem",
- })
- or return 1;
- print $mailer $result;
- $mailer->close;
- 0;
-}
-
-sub build_backup_files() {
- my $path_name;
- my $tar_cmd;
- my $more_recent;
- my $tar_cmd_sys;
- my $tar_cmd_user;
- my $tar_cmd_other;
- my @dir_content;
- my $incr;
- my $base;
- my $find_args = "! -type d -print";
-
- local $_;
- $results = "";
- $log_buff = "";
- #- flush these so if the user does 2 runs in a row we don't try to send the same files
- @file_list_to_send_by_ftp = ();
- @files_for_direct_tape = ();
-
- $interactive and gtkset_mousecursor_wait();
- read_conf_file();
- $the_time = the_time();
- $conf{SEND_MAIL} and complete_results();
- -d $conf{PATH_TO_SAVE} or mkdir_p($conf{PATH_TO_SAVE});
-
- $tar_cmd = "tar cp";
- $tar_cmd .= "v" if $DEBUG;
- $tar_cmd .= "j" if $conf{OPTION_COMP} eq "tar.bz2";
- $tar_cmd .= "z" if $conf{OPTION_COMP} eq "tar.gz";
- $tar_cmd .= " ";
-
- my $used_space = check_storage_quota($conf{PATH_TO_SAVE});
- if ($used_space) {
- my $msg = N("Backup quota exceeded!\n%d MB used vs %d MB allocated.", $used_space, $conf{MAX_SPACE});
- show_warning("f", $msg);
- $interactive and gtkset_mousecursor_normal();
- $results .= $msg;
- $interactive and show_status();
- results_to_logfile();
- return 1;
- }
- $tar_cmd_sys = $tar_cmd;
- $tar_cmd_user = $tar_cmd;
- $tar_cmd_other = $tar_cmd;
- $conf{NO_CRITICAL_SYS} and $tar_cmd_sys .= "--exclude passwd --exclude fstab --exclude group --exclude mtab";
- $conf{NO_BROWSER_CACHE} and $tar_cmd_user .= "--exclude NewCache --exclude Cache --exclude cache";
- $nonroot_user and $tar_cmd_user .= " --exclude .drakbackup";
- $conf{BACKUPIGNORE} && -f "/etc/.backupignore" and $tar_cmd_sys .= " -X /etc/.backupignore";
-
- -d $conf{PATH_TO_SAVE} and @dir_content = all($conf{PATH_TO_SAVE});
-
- if ($conf{USE_HD} && !$daemon || $daemon) {
- $interactive and progress($pbar, $plabel, 0.5, N("Backup system files..."));
- unless ($conf{NO_SYS_FILES}) {
- my $find_args_sys = $find_args;
- my $first_done;
- $ignore_files_list = '';
- $find_args_sys = handle_ignores2("/etc", $find_args_sys) if $conf{BACKUPIGNORE};
- if ($conf{SYS_INCREMENTAL_BACKUPS}) {
- $base = $incr = "incr_sys";
- ($base, $incr) = swap_prefix($base, $incr) if $conf{SYS_DIFFERENTIAL_BACKUPS};
- $base =~ s/incr/base/ if !any { /^list_incr_sys/ } @dir_content;
- if (any { /^list_base_sys/ } @dir_content) {
- $more_recent = get_more_recent($base, @dir_content);
- my $list_file = name_list_file($incr);
- do_find($more_recent, $find_args_sys, $list_file, @sys_files);
- if (check_rm_list($list_file)) {
- do_tar($tar_cmd_sys, "backup_$incr", $list_file, undef);
- }
- $first_done = 1;
- } else {
- $incr = "base_sys";
- }
- } else {
- $incr = "sys";
- clean_dest($incr);
- }
- if (!$first_done) {
- my $list_file = name_list_file($incr);
- do_find(undef, $find_args_sys, $list_file, @sys_files);
- do_tar($tar_cmd_sys, "backup_$incr", undef, @sys_files);
- }
- push_list("list_$incr") if $incr =~ /_sys/;
- files_to_results($incr);
- }
- $interactive and progress($pbar, $plabel, 0.5, N("Backup system files..."));
- $interactive and progress($pbar3, $plabel3, 0.3, N("Hard Disk Backup files..."));
-
- unless ($conf{NO_USER_FILES}) {
- foreach (@user_list) {
- my $user = $_;
- my $tar_cmd_cuser = $tar_cmd_user;
- $path_name = return_path($user);
- $conf{BACKUPIGNORE} && -f "$path_name/.backupignore" and $tar_cmd_cuser .= " -X $path_name/.backupignore";
- my $find_args_user = $find_args;
- my $first_done;
- $ignore_files_list = '';
- $find_args_user = handle_ignores2($path_name, $find_args_user) if $conf{BACKUPIGNORE};
- if ($conf{USER_INCREMENTAL_BACKUPS}) {
- $base = $incr = "incr_user_";
- ($base, $incr) = swap_prefix($base, $incr) if $conf{USER_DIFFERENTIAL_BACKUPS};
- $base =~ s/incr/base/ if !any { /^list_incr_user_$user/ } @dir_content;
- if (any { /^list_base_user_$user/ } @dir_content) {
- $more_recent = get_more_recent("$base$user", @dir_content);
- my $list_file = name_list_file($incr . $user);
- do_find($more_recent, $find_args_user, $list_file, $path_name);
- if (check_rm_list($list_file)) {
- do_tar($tar_cmd_cuser, "backup_$incr$user", $list_file, undef);
- }
- $first_done = 1;
- } else {
- $incr = "base_user_";
- }
- } else {
- $incr = "user_";
- clean_dest("$incr$user");
- }
- if (!$first_done) {
- my $list_file = name_list_file($incr . $user);
- do_find(undef, $find_args_user, $list_file, $path_name);
- do_tar($tar_cmd_cuser, "backup_$incr$user", undef, $path_name);
- }
- push_list("list_$incr$user") if $incr =~ /_user/;
- files_to_results("$incr$user");
- }
- }
- $interactive and progress($pbar2, $plabel1, 1, N("Backup User files..."));
- $interactive and progress($pbar3, $plabel3, 0.4, N("Hard Disk Backup files..."));
-
- if ($conf{OTHER_FILES}) {
- my $find_args_other = $find_args;
- my $first_done;
- $ignore_files_list = '';
- ($tar_cmd_other, $find_args_other) = handle_ignores($tar_cmd_other, $find_args_other, @other_files) if $conf{BACKUPIGNORE};
- if ($conf{OTHER_INCREMENTAL_BACKUPS}) {
- $base = $incr = "incr_other";
- ($base, $incr) = swap_prefix($base, $incr) if $conf{OTHER_DIFFERENTIAL_BACKUPS};
- $base =~ s/incr/base/ if !any { /^list_incr_other/ } @dir_content;
- if (any { /^list_base_other/ } @dir_content) {
- $more_recent = get_more_recent($base, @dir_content);
- my $list_file = name_list_file($incr);
- do_find($more_recent, $find_args_other, $list_file, @other_files);
- if (check_rm_list($list_file)) {
- do_tar($tar_cmd_other, "backup_$incr", $list_file, undef);
- }
- $first_done = 1;
- } else {
- $incr = "base_other";
- }
- } else {
- $incr = "other";
- clean_dest($incr);
- }
- if (!$first_done) {
- my $list_file = name_list_file($incr);
- do_find(undef, $find_args_other, $list_file, @other_files);
- do_tar($tar_cmd_other, "backup_$incr", undef, @other_files);
- }
- push_list("list_$incr") if $incr =~ /_other/;
- files_to_results($incr);
- }
- $interactive and progress($pbar1, $plabel2, 1, N("Backup Other files..."));
- $interactive and progress($pbar3, $plabel3, 0.3, N("Hard Disk Backup Progress..."));
- }
-
- my $filecount = @file_list_to_send_by_ftp;
- if (!$filecount && !$conf{DIRECT_TAPE}) {
- my $msg = N("No changes to backup!");
- show_warning("w", $msg);
- $interactive and gtkset_mousecursor_normal();
- $interactive and interactive_mode_box();
- results_to_logfile();
- return 1;
- }
-
- #- should hit this block if running daemon mode only
- if ($daemon && $conf{DAEMON_MEDIA}) {
-# ftp_client() if $ftp_daemon;
- rsync_client() if $conf{DAEMON_MEDIA} eq 'rsync';
- ssh_client() if $conf{DAEMON_MEDIA} eq 'ssh' && !$conf{USE_EXPECT};
- do_expect("backup") if $conf{DAEMON_MEDIA} eq 'ssh' && $conf{USE_EXPECT};
- webdav_client() if $conf{DAEMON_MEDIA} eq 'webdav';
- build_cd() if $conf{DAEMON_MEDIA} eq 'cd';
- build_tape() if $conf{DAEMON_MEDIA} eq 'tape';
-
- $results .= N("\nDrakbackup activities via %s:\n\n", $conf{DAEMON_MEDIA}) if $conf{DAEMON_MEDIA} ne 'hd';
- $results .= $log_buff;
- }
-
- #- leave this one alone for now - works well
- #- integrate with other methods later
- if (($conf{USE_NET} && !$daemon && $conf{NET_PROTO} eq 'ftp') || $daemon && $conf{DAEMON_MEDIA} eq 'ftp') {
- $interactive and build_backup_ftp_status();
- if (ftp_client()) {
- $results .= N("\n FTP connection problem: It was not possible to send your backup files by FTP.\n");
- $interactive and $in->ask_warn(N("Error"), N("Error during sending file via FTP. Please correct your FTP configuration."));
- } else {
- $results .= N("file list sent by FTP: %s\n", $_) foreach @file_list_to_send_by_ftp;
- }
- }
-
- #- consolidate all the other methods under here - interactive and --default should land here
- if (!$daemon) {
-
- if ($conf{USE_NET} && $conf{NET_PROTO} && $conf{NET_PROTO} ne 'ftp') {
- rsync_client() if $conf{NET_PROTO} eq 'rsync';
- ssh_client() if $conf{NET_PROTO} eq 'ssh' && !$conf{USE_EXPECT};
- do_expect("backup") if $conf{NET_PROTO} eq 'ssh' && $conf{USE_EXPECT};
- webdav_client() if $conf{NET_PROTO} eq 'webdav';
- $results .= N("\nDrakbackup activities via %s:\n\n", $conf{NET_PROTO});
- }
-
- if ($conf{USE_CD}) {
- build_cd();
- $results .= N("\nDrakbackup activities via CD:\n\n");
- }
-
- if ($conf{USE_TAPE}) {
- build_tape();
- $results .= N("\nDrakbackup activities via tape:\n\n");
- }
- $results .= $log_buff;
- }
-
- results_to_logfile();
-
- if ($conf{SEND_MAIL}) {
- if (send_mail($results)) {
- $interactive and $in->ask_warn(N("Error"), N("Error sending mail. Your report mail was not sent."));
- $interactive or print N(" Error while sending mail. \n");
- }
- }
-
- #- write our catalog file
- if (!$media_problem) {
- my $catalog = substr($the_time, 1);
- my $direct_tape = "";
- $direct_tape = "Direct" if $conf{DIRECT_TAPE};
- if (!$conf{USE_NET} && !$conf{USE_TAPE} && !$conf{USE_CD}) {
- $catalog .= ":HD:localhost:$conf{PATH_TO_SAVE}";
- $conf{NET_PROTO} = '';
- }
- $catalog .= ":$conf{NET_PROTO}:$conf{LOGIN}\@$conf{HOST_NAME}:$conf{HOST_PATH}" if $conf{NET_PROTO};
- $catalog .= ":CD:$vol_name:$conf{CD_DEVICE}" if $conf{USE_CD};
- $catalog .= ":" . $direct_tape . "Tape:$vol_name:$conf{TAPE_DEVICE}" if $conf{USE_TAPE};
- $catalog .= ":System" unless $conf{NO_SYS_FILES};
- $catalog .= ":I" if $conf{SYS_INCREMENTAL_BACKUPS} && !$conf{NO_SYS_FILES} && !$conf{SYS_DIFFERENTIAL_BACKUPS};
- $catalog .= ":D" if $conf{SYS_INCREMENTAL_BACKUPS} && !$conf{NO_SYS_FILES} && $conf{SYS_DIFFERENTIAL_BACKUPS};
- $catalog .= ":F" if !$conf{SYS_INCREMENTAL_BACKUPS} && !$conf{NO_SYS_FILES};
- $catalog .= ":Users=(@user_list)" unless $conf{NO_USER_FILES};
- $catalog .= ":I" if $conf{USER_INCREMENTAL_BACKUPS} && !$conf{NO_USER_FILES} && !$conf{USER_DIFFERENTIAL_BACKUPS};
- $catalog .= ":D" if $conf{USER_INCREMENTAL_BACKUPS} && !$conf{NO_USER_FILES} && $conf{USER_DIFFERENTIAL_BACKUPS};
- $catalog .= ":F" if !$conf{USER_INCREMENTAL_BACKUPS} && !$conf{NO_USER_FILES};;
- $catalog .= ":Other=(@other_files)" if $conf{OTHER_FILES};
- $catalog .= ":I" if $conf{OTHER_INCREMENTAL_BACKUPS} && $conf{OTHER_FILES} && !$conf{OTHER_DIFFERENTIAL_BACKUPS};
- $catalog .= ":D" if $conf{OTHER_INCREMENTAL_BACKUPS} && $conf{OTHER_FILES} && $conf{OTHER_DIFFERENTIAL_BACKUPS};
- $catalog .= ":F" if !$conf{OTHER_INCREMENTAL_BACKUPS} && $conf{OTHER_FILES};
- $catalog .= "\n";
-
- append_to_file("$cfg_dir/drakbackup_catalog", $catalog) or show_warning("w", N("Can't create catalog!"));
- }
-
- #- clean up HD files if del_hd_files and media isn't hd
- if ($conf{DEL_HD_FILES} && ($conf{USE_CD} || $conf{USE_TAPE} || $conf{USE_NET}) && $conf{DAEMON_MEDIA} ne 'hd') {
- foreach (@file_list_to_send_by_ftp) {
- unlink($_) if /$conf{OPTION_COMP}$/;
- }
- }
-
- #- if we had a media problem then get rid of the text log of the backed up files too
- if ($media_problem) {
- system("rm $conf{PATH_TO_SAVE}/list*$the_time.txt");
- }
-
- $interactive and gtkset_mousecursor_normal();
- $interactive and show_status();
-}
-
-sub swap_prefix {
- my ($base, $incr) = @_;
- $incr =~ s/incr/diff/;
- $base =~ s/incr/base/;
- return $base, $incr;
-}
-
-sub name_list_file {
- my ($suffix) = @_;
- return $conf{PATH_TO_SAVE} . "/list_" . $suffix . $the_time . ".txt";
-}
-
-sub check_rm_list {
- my ($list_file) = @_;
- if (!cat_($list_file)) {
- unlink($list_file);
- return 0;
- } else {
- return 1;
- }
-}
-
-sub get_more_recent {
- my ($match, @directory) = @_;
- $match = "list_" . $match;
- my @more_recent = grep { /^$match/ } sort @directory;
- my $more_recent = pop @more_recent;
- $DEBUG and print "more recent file: $more_recent\n";
- return $more_recent;
-}
-
-sub clean_dest {
- my ($wildcard) = @_;
- system("cd $conf{PATH_TO_SAVE} && rm -f backup*$wildcard*");
-}
-
-sub do_find {
- my ($newer, $more_args, $into, @where) = @_;
- #- $newer may be undef - if it's defined then "-cnewer $newer"
- $newer = $conf{PATH_TO_SAVE} . "/" . $newer if defined($newer);
- defined($newer) ? system("find @where -cnewer $newer $more_args > $into") : system("find @where $more_args > $into");
-}
-
-sub do_tar {
- my ($tar_cmd, $dest_file, $list_file, @files) = @_;
- my $full_dest_file = $conf{PATH_TO_SAVE} . "/" . $dest_file . $the_time . "." . $conf{OPTION_COMP};
- if ($conf{DIRECT_TAPE}) {
- log::explanations("Direct tape backup - tar deferred...");
- defined($list_file) ? push @files_for_direct_tape, $list_file : push @files_for_direct_tape, @files;
- } else {
- #- if $list_file is undefined, then use the @files list
- defined($list_file) ? system("$tar_cmd -f $full_dest_file -T $list_file") : system("$tar_cmd -f $full_dest_file @files");
- }
- push_list($dest_file);
-}
-
-sub push_list {
- my ($prefix) = @_;
- my $filename = $conf{PATH_TO_SAVE} . "/" . $prefix . $the_time . ".";
- $filename .= $conf{OPTION_COMP} if $prefix =~ /^backup/;
- $filename .= "txt" if $prefix =~ /^list/;
- push @file_list_to_send_by_ftp, $filename if -e $filename;
-}
-
-sub files_to_results {
- my ($basename) = @_;
- if ($conf{DIRECT_TAPE}) {
- $results .= "\nDirect to tape:\n\n";
- } else {
- $results .= "\nfile: " . $conf{PATH_TO_SAVE} . "/backup_" . $basename . $the_time . "." . $conf{OPTION_COMP} . "\n\n";
- $results .= cat_("$conf{PATH_TO_SAVE}/list_" . $basename . $the_time . ".txt");
- }
- $results .= "\nignored:\n" . $ignore_files_list . "\n" if $ignore_files_list;
-}
-
-sub handle_ignores {
- my ($tar_cmd, $find_args, @list) = @_;
- foreach my $dir (@list) {
- if (-d $dir) {
- -f "$dir/.backupignore" and $tar_cmd .= " -X $dir/.backupignore";
- $find_args = handle_ignores2($dir, $find_args);
- }
- }
- return $tar_cmd, $find_args;
-}
-
-sub handle_ignores2 {
- my ($dir, $find_args) = @_;
- my @ignore_files = cat_("$dir/.backupignore");
- foreach (@ignore_files) {
- $ignore_files_list .= $_;
- }
- $find_args .= " | grep -v -f $dir/.backupignore" if -f "$dir/.backupignore";
- return $find_args;
-}
-
-sub require_rpm {
- my $all_rpms_found = 1;
- my $res;
- foreach my $pkg (@_) {
- $res = system("rpm -q $pkg > /dev/null");
- if ($res == 256) {
- $all_rpms_found = 0;
- push @list_of_rpm_to_install, $pkg;
- }
- }
- return $all_rpms_found;
-}
-
-sub check_pkg_needs() {
- my @extra_pkg;
- @list_of_rpm_to_install = ();
- if ($conf{USE_NET}) {
- @extra_pkg = "rsync" if $conf{NET_PROTO} eq 'rsync';
- @extra_pkg = ("sitecopy", "wget") if $conf{NET_PROTO} eq 'webdav';
- @extra_pkg = "perl-Expect" if $conf{NET_PROTO} eq 'ssh' && ($conf{USE_EXPECT} || $conf{DRAK_KEYS});
- }
- @extra_pkg = "mt-st" if $conf{USE_TAPE};
- @extra_pkg = ("mkisofs", "cdrecord") if $conf{USE_CD};
- if (@extra_pkg) {
- if (require_rpm(@extra_pkg)) {
- return 0;
- } else {
- return 1;
- }
- }
-}
-
-sub show_status() {
- my $text = Gtk2::TextView->new;
- destroy_widget();
- my $scrolled_window = Gtk2::ScrolledWindow->new;
- $scrolled_window->set_border_width(10);
- $scrolled_window->add_with_viewport($text);
- gtktext_insert(gtkset_editable($text, 0), [ [ $results ] ]);
-
- gtkpack($advanced_box,
- $table = gtkpack_(Gtk2::VBox->new(0,10), 1, $scrolled_window)
- );
- $central_widget = \$table;
- $table->show_all;
-}
-
-sub results_to_logfile() {
- output_p($log_file, $results);
-}
-
-sub conf_to_list {
- my ($config) = @_;
- return split(",", $config);
-}
-
-sub list_to_conf {
- my (@list) = @_;
- return join(",", @list);
-}
-
-sub filedialog_generic {
- #- a more generic file dialog
- #- a title prompt, the widget to get updated
- my ($prompt, $widget) = @_;
- my $file_dialog;
-
- $file_dialog = gtksignal_connect(Gtk2::FileSelection->new($prompt), destroy => sub { $file_dialog->destroy });
- $file_dialog->ok_button->signal_connect(clicked => sub {
- if (defined($widget)) {
- $$widget->set_text($file_dialog->get_filename);
- } else {
- my $file_name = $file_dialog->get_filename;
- if (!member($file_name, @other_files)) {
- push(@other_files, $file_name);
- $list_model->append_set(0, $file_name);
- }
- }
- $file_dialog->destroy;
- });
- $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy });
- $file_dialog->show;
-}
-
-################################################ ADVANCED ################################################
-
-sub check_list {
- foreach (@_) {
- my $ref = $_->[1];
- $_->[2] ? gtkset_active($_->[0], !$$ref) : gtkset_active($_->[0], $$ref);
- gtksignal_connect($_->[0], toggled => sub {
- invbool $ref;
- destroy_widget();
- $current_widget->();
- });
- }
-}
-
-sub fonction_env {
- ($central_widget, $current_widget, $previous_widget, $next_widget) = @_;
-}
-
-sub advanced_what_sys() {
- my $box_what_sys;
-
- gtkpack($advanced_box,
- $box_what_sys = gtkpack_(Gtk2::VBox->new(0, 15),
- 1, N("\nPlease check all options that you need.\n"),
- 1, N("These options can backup and restore all files in your /etc directory.\n"),
- 0, my $check_what_sys = Gtk2::CheckButton->new(N("Backup your System files. (/etc directory)")),
- 0, my $check_what_versions = Gtk2::CheckButton->new(N("Use Incremental/Differential Backups (do not replace old backups)")),
- 0, gtkpack__(Gtk2::HBox->new(0,0),
- my @mode_buttons = gtkradio((N("Use Incremental Backups")) x 2, N("Use Differential Backups")),
- ),
- 0, my $check_what_critical = Gtk2::CheckButton->new(N("Do not include critical files (passwd, group, fstab)")),
- 0, N("With this option you will be able to restore any version\n of your /etc directory."),
- 1, Gtk2::VBox->new(0, 15),
- ),
- );
- check_list([$check_what_sys, \$conf{NO_SYS_FILES}, 1], [$check_what_critical, \$conf{NO_CRITICAL_SYS}]);
- $check_what_versions->set_active($conf{SYS_INCREMENTAL_BACKUPS});
- $check_what_versions->signal_connect('toggled' => sub {
- invbool \$conf{SYS_INCREMENTAL_BACKUPS};
- $mode_buttons[0]->set_sensitive($conf{SYS_INCREMENTAL_BACKUPS});
- $mode_buttons[1]->set_sensitive($conf{SYS_INCREMENTAL_BACKUPS});
-
- });
- $mode_buttons[1]->set_active($conf{SYS_DIFFERENTIAL_BACKUPS});
- $mode_buttons[0]->signal_connect('toggled' => sub { $conf{SYS_DIFFERENTIAL_BACKUPS} = $mode_buttons[1]->get_active });
- $mode_buttons[0]->set_sensitive($conf{SYS_INCREMENTAL_BACKUPS});
- $mode_buttons[1]->set_sensitive($conf{SYS_INCREMENTAL_BACKUPS});
- set_help_tip($check_what_versions, 'use_incr_decr');
- set_help_tip($mode_buttons[0], 'use_incremental');
- set_help_tip($mode_buttons[1], 'use_differential');
- fonction_env(\$box_what_sys, \&advanced_what_sys, \&advanced_what);
- $up_box->show_all;
-}
-
-sub advanced_what_user {
- my ($previous_function) = @_;
- my $box_what_user;
- my %check_what_user;
-
- all_user_list();
- gtkpack($advanced_box,
- $box_what_user = gtkpack_(Gtk2::VBox->new(0, 15),
- 0, N("Please check all users that you want to include in your backup."),
- 0, Gtk2::HSeparator->new,
- 1, create_scrolled_window(
- gtkpack__(Gtk2::VBox->new(0,0),
- map { my $name = $_;
- my @user_list_tmp;
- my $b = Gtk2::CheckButton->new($name);
- if (any { /^$name$/ } @user_list) {
- $check_what_user{$_}[1] = 1;
- gtkset_active($b, 1);
- } else {
- $check_what_user{$_}[1] = 0;
- gtkset_active($b, 0);
- }
- $b->signal_connect(toggled => sub {
- if ($check_what_user{$name}[1]) {
- $check_what_user{$name}[1] = 0;
- @user_list_tmp = grep { !/^$name$/ } @user_list;
- @user_list = @user_list_tmp;
- } else {
- $check_what_user{$name}[1] = 1;
- if (!member($name, @user_list)) { push @user_list, $name }
- }
- });
- $b } (@user_list_all)
- ),
- ),
- 0, my $check_what_browser = Gtk2::CheckButton->new(N("Do not include the browser cache")),
- 0, my $check_what_user_versions = Gtk2::CheckButton->new(N("Use Incremental/Differential Backups (do not replace old backups)")),
- 0, gtkpack__(Gtk2::HBox->new(0,0),
- my @mode_buttons = gtkradio((N("Use Incremental Backups")) x 2, N("Use Differential Backups")),
- ),
- ),
- );
- check_list([$check_what_browser, \$conf{NO_BROWSER_CACHE}]);
- $check_what_user_versions->set_active($conf{USER_INCREMENTAL_BACKUPS});
- $check_what_user_versions->signal_connect('toggled' => sub {
- invbool \$conf{USER_INCREMENTAL_BACKUPS};
- $mode_buttons[0]->set_sensitive($conf{USER_INCREMENTAL_BACKUPS});
- $mode_buttons[1]->set_sensitive($conf{USER_INCREMENTAL_BACKUPS});
- });
- $mode_buttons[1]->set_active($conf{USER_DIFFERENTIAL_BACKUPS});
- $mode_buttons[0]->signal_connect('toggled' => sub { $conf{USER_DIFFERENTIAL_BACKUPS} = $mode_buttons[1]->get_active });
- $mode_buttons[0]->set_sensitive($conf{USER_INCREMENTAL_BACKUPS});
- $mode_buttons[1]->set_sensitive($conf{USER_INCREMENTAL_BACKUPS});
- set_help_tip($check_what_user_versions, 'use_incr_decr');
- set_help_tip($mode_buttons[0], 'use_incremental');
- set_help_tip($mode_buttons[1], 'use_differential');
-
- if ($previous_function) { fonction_env(\$box_what_user, \&advanced_what_user, \&$previous_function, \&$previous_function) }
- else { fonction_env(\$box_what_user, \&advanced_what_user, \&advanced_what) }
- $up_box->show_all;
-}
-
-sub advanced_what_other() {
- my $box_what_other;
- my $file_iter;
- my $other_file;
-
- $list_model = Gtk2::ListStore->new("Glib::String");
- my $list_others = Gtk2::TreeView->new_with_model($list_model);
- $list_others->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $list_others->set_headers_visible(0);
-
- foreach (@other_files) {
- $list_model->append_set(0, $_);
- }
-
- $list_others->get_selection->signal_connect(changed => sub {
- my ($model, $iter) = $_[0]->get_selected;
- $model && $iter or return;
- $other_file = $model->get($iter, 0);
- $file_iter = $iter;
- });
-
- gtkpack($advanced_box,
- $box_what_other = gtkpack_(Gtk2::VBox->new(0, 15),
- 1, gtkpack_(Gtk2::HBox->new(0,4),
- 1, create_scrolled_window($list_others),
- ),
- 0, gtkadd(gtkset_layout(Gtk2::HButtonBox->new, 'spread'),
- gtksignal_connect(Gtk2::Button->new(N("Add")), clicked => sub { filedialog_generic(N("Select the files or directories and click on 'OK'"), undef) }),
- gtksignal_connect(Gtk2::Button->new(N("Remove Selected")), clicked => sub {
- $list_model->remove($file_iter) if $file_iter;
- my $iindex = 0;
- foreach (@other_files) {
- if ($other_files[$iindex] eq $other_file) {
- splice(@other_files, $iindex, 1);
- last;
- }
- $iindex++;
- }
- }),
- ),
- 0, my $check_what_other_versions = Gtk2::CheckButton->new(N("Use Incremental/Differential Backups (do not replace old backups)")),
- 0, gtkpack__(Gtk2::HBox->new(0,0),
- my @mode_buttons = gtkradio((N("Use Incremental Backups")) x 2, N("Use Differential Backups")),
- ),
- ),
-
- );
- $check_what_other_versions->set_active($conf{OTHER_INCREMENTAL_BACKUPS});
- $check_what_other_versions->signal_connect('toggled' => sub {
- invbool \$conf{OTHER_INCREMENTAL_BACKUPS};
- $mode_buttons[0]->set_sensitive($conf{OTHER_INCREMENTAL_BACKUPS});
- $mode_buttons[1]->set_sensitive($conf{OTHER_INCREMENTAL_BACKUPS});
- });
- $mode_buttons[1]->set_active($conf{OTHER_DIFFERENTIAL_BACKUPS});
- $mode_buttons[0]->signal_connect('toggled' => sub { $conf{OTHER_DIFFERENTIAL_BACKUPS} = $mode_buttons[1]->get_active });
- $mode_buttons[0]->set_sensitive($conf{OTHER_INCREMENTAL_BACKUPS});
- $mode_buttons[1]->set_sensitive($conf{OTHER_INCREMENTAL_BACKUPS});
- set_help_tip($check_what_other_versions, 'use_incr_decr');
- set_help_tip($mode_buttons[0], 'use_incremental');
- set_help_tip($mode_buttons[1], 'use_differential');
-
- fonction_env(\$box_what_other, \&advanced_what_other, \&advanced_what);
- $up_box->show_all;
-}
-
-sub advanced_what() {
- my $box_what;
-
- gtkpack($advanced_box,
- $box_what = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtkpack_(Gtk2::VBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtksignal_connect(my $button_what_sys = Gtk2::Button->new,
- clicked => sub { $box_what->destroy; advanced_what_sys() }),
- 1, gtksignal_connect(my $button_what_user = Gtk2::Button->new,
- clicked => sub { destroy_widget(); advanced_what_user(undef) }),
- 1, gtksignal_connect(my $button_what_other = Gtk2::Button->new,
- clicked => sub { destroy_widget(); advanced_what_other() }),
- 1, Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
- $button_what_sys->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-system-40"),
- Gtk2::Label->new(N("System")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_what_user->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-users-40"),
- Gtk2::Label->new(N("Users")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_what_other->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-others-40"),
- Gtk2::Label->new(N("Other")),
- Gtk2::HBox->new(0, 5)
- ));
- gtkset_sensitive($button_what_sys, !$conf{NO_SYS_FILES});
- fonction_env(\$box_what, \&advanced_what, \&advanced_box);
- $up_box->show_all;
-}
-
-sub advanced_where_net_types {
- my ($previous_function) = @_;
- my $box_where_net;
-
- gtkpack($advanced_box,
- $box_where_net = gtkpack_(Gtk2::VBox->new(0, 10),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, my $check_where_use_net = Gtk2::CheckButton->new(N("Use network connection to backup")),
- 1, Gtk2::HBox->new(0,10),
- 0, Gtk2::Label->new(N("Net Method:")),
- 0, gtkset_sensitive(my $entry_net_type = Gtk2::ComboBox->new_text, $conf{USE_NET}),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,5),
- 0, gtkset_sensitive(my $check_use_expect = Gtk2::CheckButton->new(N("Use Expect for SSH")), ($conf{USE_NET} && $conf{NET_PROTO} eq 'ssh')),
- 0, gtkset_sensitive(my $check_xfer_keys = Gtk2::CheckButton->new(N("Create/Transfer backup keys for SSH")), ($conf{USE_NET} && $conf{NET_PROTO} eq 'ssh')),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(my $button_xfer_keys = Gtk2::Button->new(N("Transfer Now")), $conf{DRAK_KEYS}),
- ),
- 0, gtkset_sensitive(my $check_user_keys = Gtk2::CheckButton->new(N("Other (not drakbackup) keys in place already")), ($conf{USE_NET} && $conf{NET_PROTO} eq 'ssh')),
- 0, Gtk2::HSeparator->new,
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Host name or IP.")), $conf{USE_NET}),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(my $host_name_entry = Gtk2::Entry->new, $conf{USE_NET}),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Directory (or module) to put the backup on this host.")), $conf{USE_NET}),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(my $host_path_entry = Gtk2::Entry->new, $conf{USE_NET}),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Login name")), $conf{USE_NET}),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(my $login_user_entry = Gtk2::Entry->new, $conf{USE_NET}),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Password")), $conf{USE_NET}),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(my $check_remember_pass = Gtk2::CheckButton->new(N("Remember this password")), $conf{USE_NET}),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(my $passwd_user_entry = Gtk2::Entry->new, $conf{USE_NET}),
- ),
- ),
- );
- $entry_net_type->set_popdown_strings('', @net_methods);
- $entry_net_type->entry->set_text($conf{NET_PROTO});
- $button_xfer_keys->signal_connect('clicked', sub {
- if ($conf{PASSWD} && $conf{LOGIN} && $conf{HOST_NAME}) {
- if (check_pkg_needs()) {
- install_rpm(\&advanced_where_net_types, $previous_function);
- } else {
- do_expect("sendkey");
- }
- } else {
- $in->ask_warn(N("Error"), N("Need hostname, username and password!"));
- }
- });
- $passwd_user_entry->set_visibility(0);
- $passwd_user_entry->set_text($conf{PASSWD});
- $passwd_user_entry->signal_connect('changed', sub { $conf{PASSWD} = $passwd_user_entry->get_text });
- $host_path_entry->set_text($conf{HOST_PATH});
- $host_name_entry->set_text($conf{HOST_NAME});
- $login_user_entry->set_text($conf{LOGIN});
- $host_name_entry->signal_connect('changed', sub { $conf{HOST_NAME} = $host_name_entry->get_text });
- $host_path_entry->signal_connect('changed', sub { $conf{HOST_PATH} = $host_path_entry->get_text });
- $login_user_entry->signal_connect('changed', sub { $conf{LOGIN} = $login_user_entry->get_text });
- $entry_net_type->entry->signal_connect('changed', sub {
- $conf{NET_PROTO} = $entry_net_type->entry->get_text;
- my $sensitive = 0;
- $sensitive = 1 if $conf{NET_PROTO} eq 'ssh';
- $check_use_expect->set_sensitive($sensitive);
- $check_xfer_keys->set_sensitive($sensitive);
- $button_xfer_keys->set_sensitive($sensitive);
- $check_user_keys->set_sensitive($sensitive);
- });
- check_list([$check_remember_pass, \$conf{REMEMBER_PASS}]);
- gtksignal_connect(gtkset_active($check_where_use_net, $conf{USE_NET}), toggled => sub {
- invbool \$conf{USE_NET};
- #- assure other methods disabled
- if ($conf{USE_NET} == 1) {
- $conf{USE_CD} = 0;
- $conf{USE_TAPE} = 0;
- }
- $conf{NET_PROTO} = '' if $conf{USE_NET} == 0;
- destroy_widget();
- $current_widget->($previous_function);
- });
- gtksignal_connect(gtkset_active($check_use_expect, $conf{USE_EXPECT}), toggled => sub {
- invbool \$conf{USE_EXPECT};
- #- assure other methods disabled
- if ($conf{USE_EXPECT} == 1) {
- $conf{DRAK_KEYS} = 0;
- $conf{USER_KEYS} = 0;
- }
- destroy_widget();
- $current_widget->($previous_function);
- });
- gtksignal_connect(gtkset_active($check_xfer_keys, $conf{DRAK_KEYS}), toggled => sub {
- invbool \$conf{DRAK_KEYS};
- #- assure other methods disabled
- if ($conf{DRAK_KEYS} == 1) {
- $conf{USE_EXPECT} = 0;
- $conf{USER_KEYS} = 0;
- }
- destroy_widget();
- $current_widget->($previous_function);
- });
- gtksignal_connect(gtkset_active($check_user_keys, $conf{USER_KEYS}), toggled => sub {
- invbool \$conf{USER_KEYS};
- #- assure other methods disabled
- if ($conf{USER_KEYS} == 1) {
- $conf{DRAK_KEYS} = 0;
- $conf{USE_EXPECT} = 0;
- }
- destroy_widget();
- $current_widget->($previous_function);
- });
- set_help_tip($check_use_expect, 'use_expect');
- set_help_tip($check_remember_pass, 'remember_pass');
- set_help_tip($host_path_entry, 'dir_or_module');
- if ($previous_function) {
- fonction_env(\$box_where_net, \&advanced_where_net_types, \&$previous_function, \&wizard_step3);
- button_box_wizard();
- } else {
- fonction_env(\$box_where_net, \&advanced_where_net_types, \&advanced_where);
- }
- $up_box->show_all;
-}
-
-sub advanced_where_cd {
- my ($previous_function) = @_;
- my $box_where_cd;
- my %dev_codes;
-
- get_cd_info();
-
- foreach my $key (keys %cd_devices) {
- $dev_codes{$cd_devices{$key}{rec_dev}} = $key;
- }
-
- my $combo_where_cd_device = Gtk2::ComboBox->new_with_strings(%cd_devices ? [ sort keys %dev_codes ] : \@no_devices);
- my $combo_where_cd_time = Gtk2::ComboBox->new_with_strings([ "650 MB", "700 MB", "750 MB", "800 MB", "4.7 GB" ]);
-
- gtkpack($advanced_box,
- $box_where_cd = gtkpack_(Gtk2::VBox->new(0, 6),
- 0, my $check_where_cd = Gtk2::CheckButton->new(N("Use CD-R/DVD-R to backup")),
- 0, Gtk2::HSeparator->new,
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Choose your CD/DVD device")), $conf{USE_CD}),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive($combo_where_cd_device, $conf{USE_CD}),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Choose your CD/DVD media size")), $conf{USE_CD}),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive($combo_where_cd_time, $conf{USE_CD}),
- ),
- 0, Gtk2::VBox->new(0, 5),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Multisession CD")), $conf{USE_CD}),
- 0, gtkset_sensitive(my $check_multisession = Gtk2::CheckButton->new, $conf{USE_CD}),
- 0, gtkset_sensitive(Gtk2::Label->new(N("CDRW media")), $conf{USE_CD}),
- 0, gtkset_sensitive(my $check_cdrw = Gtk2::CheckButton->new, $conf{USE_CD}),
- ),
- 0, Gtk2::VBox->new(0, 5),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Erase your RW media (1st Session)")), $conf{CDRW} && $conf{USE_CD}),
- 0, gtkset_sensitive(my $button_erase_now = Gtk2::Button->new(N(" Erase Now ")), $conf{CDRW}),
- 0, gtkset_sensitive(my $check_cdrw_erase = Gtk2::CheckButton->new, $conf{CDRW} && $conf{USE_CD}),
- ),
- 0, Gtk2::VBox->new(0, 5),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive(Gtk2::Label->new(N("DVD+RW media")), $conf{USE_CD}),
- 0, gtkset_sensitive(my $check_dvdrw = Gtk2::CheckButton->new, $conf{USE_CD}),
- 0, gtkset_sensitive(Gtk2::Label->new(N("DVD-R media")), $conf{USE_CD}),
- 0, gtkset_sensitive(my $check_dvdr = Gtk2::CheckButton->new, $conf{USE_CD}),
- 0, gtkset_sensitive(Gtk2::Label->new(N("DVDRAM device")), $conf{USE_CD}),
- 0, gtkset_sensitive(my $check_dvdram = Gtk2::CheckButton->new, $conf{USE_CD}),
- ),
- ),
- );
-
- foreach ([$check_cdrw_erase, \$conf{MEDIA_ERASE}], [$check_dvdrw, \$conf{DVDRW}], [$check_dvdr, \$conf{DVDR}], [$check_dvdram, \$conf{DVDRAM}], [$check_multisession, \$conf{MULTI_SESSION}]) {
- my $ref = $_->[1];
- gtksignal_connect(gtkset_active($_->[0], $$ref), toggled => sub { $$ref = $$ref ? 0 : 1 })
- }
- gtksignal_connect(gtkset_active($check_where_cd, $conf{USE_CD}), toggled => sub {
- $conf{USE_CD} = $conf{USE_CD} ? 0 : 1;
- #- toggle where_net, where_tape off
- if ($conf{USE_CD} == 1) {
- $conf{USE_NET} = 0;
- $conf{USE_TAPE} = 0;
- }
- destroy_widget();
- $current_widget->($previous_function);
- });
- gtksignal_connect(gtkset_active($check_cdrw, $conf{CDRW}), toggled => sub {
- $conf{CDRW} = $conf{CDRW} ? 0 : 1;
- $conf{MEDIA_ERASE} = $conf{MEDIA_ERASE} ? 0 : 1;
- $check_cdrw_erase->set_sensitive($conf{CDRW});
- destroy_widget();
- $current_widget->($previous_function);
- });
- $button_erase_now->signal_connect('clicked', sub {
- if ($conf{CD_DEVICE}) {
- erase_cdrw();
- } else {
- $in->ask_warn(N("Error"), N("No CD device defined!"));
- }
- });
-
- $combo_where_cd_time->entry->set_text($conf{CD_TIME}) if $conf{CD_TIME};
- $combo_where_cd_time->entry->signal_connect('changed', sub { $conf{CD_TIME} = $combo_where_cd_time->entry->get_text });
-
- $combo_where_cd_device->entry->set_text($conf{CD_DEVICE}) if $conf{CD_DEVICE};
- $combo_where_cd_device->entry->signal_connect('changed', sub {
- $conf{CD_DEVICE} = $combo_where_cd_device->entry->get_text;
- $std_device = $dev_codes{$conf{CD_DEVICE}};
- $check_dvdr->set_active($cd_devices{$std_device}{dvdr});
- $check_dvdrw->set_active($cd_devices{$std_device}{dvdr});
- $check_dvdram->set_active($cd_devices{$std_device}{dvdram});
- $check_cdrw->set_active($cd_devices{$std_device}{cdrw});
- });
-
- set_help_tip($button_erase_now, 'erase_cdrw');
-
- if ($previous_function) {
- fonction_env(\$box_where_cd, \&advanced_where_cd, \&$previous_function, \&wizard_step3);
- button_box_wizard();
- } else {
- fonction_env(\$box_where_cd, \&advanced_where_cd, \&advanced_where);
- }
- $up_box->show_all;
-}
-
-sub advanced_where_tape {
- my ($previous_function) = @_;
-
- #- look for tape devices;
- get_tape_info();
-
- my $combo_where_tape_device = Gtk2::ComboBox->new_with_strings(@tape_devices ? \@tape_devices : \@no_devices);
-
- my $box_where_tape;
- local $_;
-
- gtkpack($advanced_box,
- $box_where_tape = gtkpack_(Gtk2::VBox->new(0, 6),
- 0, Gtk2::HSeparator->new,
- 0, my $check_where_tape = Gtk2::CheckButton->new(N("Use tape to backup")),
- 0, Gtk2::HSeparator->new,
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Device name to use for backup")), $conf{USE_TAPE}),
- 1, Gtk2::VBox->new(0, 6),
- 0, gtkset_sensitive($combo_where_tape_device, $conf{USE_TAPE}),
- ),
- 0, Gtk2::VBox->new(0, 5),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Backup directly to tape")), $conf{USE_TAPE}),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive(my $direct_to_tape = Gtk2::CheckButton->new, $conf{USE_TAPE}),
- ),
- 0, Gtk2::VBox->new(0, 5),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Don't rewind tape after backup")), $conf{USE_TAPE}),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive(my $check_tape_rewind = Gtk2::CheckButton->new, $conf{USE_TAPE}),
- ),
- 0, Gtk2::VBox->new(0, 5),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Erase tape before backup")), $conf{USE_TAPE}),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive(my $check_tape_erase = Gtk2::CheckButton->new, $conf{USE_TAPE}),
- ),
- 0, Gtk2::VBox->new(0, 5),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Eject tape after the backup")), $conf{USE_TAPE}),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkset_sensitive(my $check_tape_eject = Gtk2::CheckButton->new, $conf{USE_TAPE}),
- ),
- 0, Gtk2::VBox->new(0, 6),
- 0, gtkpack_(Gtk2::HBox->new(0,10),),
- ),
- );
- gtksignal_connect(gtkset_active($check_where_tape, $conf{USE_TAPE}), toggled => sub {
- $conf{USE_TAPE} = $conf{USE_TAPE} ? 0 : 1;
- #- assure other methods are off
- if ($conf{USE_TAPE} == 1) {
- $conf{USE_NET} = 0;
- $conf{USE_CD} = 0;
- }
- destroy_widget();
- $current_widget->($previous_function);
- });
- gtksignal_connect(gtkset_active($check_tape_rewind, $conf{TAPE_NOREWIND}), toggled => sub {
- $conf{TAPE_NOREWIND} = $conf{TAPE_NOREWIND} ? 0 : 1;
- $_ = $conf{TAPE_DEVICE};
- if ($conf{TAPE_NOREWIND}) {
- $conf{TAPE_DEVICE} =~ s|/st|/nst|;
- } else {
- $conf{TAPE_DEVICE} =~ s|/nst|/st|;
- }
- $combo_where_tape_device->entry->set_text($conf{TAPE_DEVICE});
- destroy_widget();
- $current_widget->($previous_function);
- });
- gtksignal_connect(gtkset_active($direct_to_tape, $conf{DIRECT_TAPE}), toggled => sub {
- $conf{DIRECT_TAPE} = $conf{DIRECT_TAPE} ? 0 : 1;
- destroy_widget();
- $current_widget->($previous_function);
- });
- gtksignal_connect(gtkset_active($check_tape_erase, $conf{MEDIA_ERASE}), toggled => sub {
- $conf{MEDIA_ERASE} = $conf{MEDIA_ERASE} ? 0 : 1;
- destroy_widget();
- $current_widget->($previous_function);
- });
- gtksignal_connect(gtkset_active($check_tape_eject, $conf{MEDIA_EJECT}), toggled => sub {
- $conf{MEDIA_EJECT} = $conf{MEDIA_EJECT} ? 0 : 1;
- destroy_widget();
- $current_widget->($previous_function);
- });
- $combo_where_tape_device->entry->set_text($conf{TAPE_DEVICE}) if $conf{TAPE_DEVICE};
- $combo_where_tape_device->entry->signal_connect('changed', sub {
- $conf{TAPE_DEVICE} = $combo_where_tape_device->entry->get_text;
- });
- if ($previous_function) {
- fonction_env(\$box_where_tape, \&advanced_where_tape, \&$previous_function, \&wizard_step3);
- button_box_wizard();
- } else {
- fonction_env(\$box_where_tape, \&advanced_where_tape, \&advanced_where);
- }
- $up_box->show_all;
-}
-
-sub advanced_where_hd {
- my ($previous_function) = @_;
- my $box_where_hd;
- my $button;
- if ($conf{MAX_SPACE} == 1000.0) {
- $conf{MAX_SPACE} = int(0.8 * get_free_space($conf{PATH_TO_SAVE})) if -d $conf{PATH_TO_SAVE};
- }
- my $adj = Gtk2::Adjustment->new($conf{MAX_SPACE}, 0.0, $conf{MAX_SPACE}, 10.0, 5.0, 0.0);
- my $spinner;
-
- gtkpack($advanced_box,
- $box_where_hd = gtkpack_(Gtk2::VBox->new(0, 6),
- 0, Gtk2::HSeparator->new,
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Enter the directory to save to:")), $conf{USE_HD}),
- 1, Gtk2::VBox->new(0, 6),
- 0, gtkset_size_request(gtkset_sensitive($save_path_entry = Gtk2::Entry->new, $conf{USE_HD}), 152, 20),
- 0, gtkset_sensitive($button = gtksignal_connect(Gtk2::Button->new, clicked => sub {
- filedialog_generic(N("Directory to save to"), \$save_path_entry)
- }), $conf{USE_HD}),
- ),
- 0, Gtk2::VBox->new(0, 6),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Maximum size\n allowed for Drakbackup (MB)")), $conf{USE_HD}),
- 1, Gtk2::VBox->new(0, 6),
- 0, gtkset_size_request(gtkset_sensitive($spinner = Gtk2::SpinButton->new($adj, 0, 0), $conf{USE_HD}), 200, 20),
- ),
- ),
- );
- $button->add(gtkpack(Gtk2::HBox->new(0,10), gtkcreate_img("ic82-dossier-32")));
- $save_path_entry->set_text($conf{PATH_TO_SAVE});
- $spinner->signal_connect('changed', sub { $conf{MAX_SPACE} = $spinner->get_text });
- $save_path_entry->signal_connect('changed', sub {
- $conf{PATH_TO_SAVE} = $save_path_entry->get_text;
- if (-d $conf{PATH_TO_SAVE}) {
- $conf{MAX_SPACE} = int(0.8 * get_free_space($conf{PATH_TO_SAVE}));
- # seems to be the easiest way to avoid the widgets fighting over values
- # and getting garbage in $max_value
- destroy_widget();
- $current_widget->($previous_function);
- }
- });
- if ($previous_function) {
- fonction_env(\$box_where_hd, \&advanced_where_hd, \&$previous_function, \&wizard_step3);
- button_box_wizard();
- } else {
- fonction_env(\$box_where_hd, \&advanced_where_hd, \&advanced_where);
- }
- $up_box->show_all;
-}
-
-sub advanced_where() {
- my $box_where;
-
- gtkpack($advanced_box,
- $box_where = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtkpack_(Gtk2::VBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtksignal_connect(my $button_where_net = Gtk2::Button->new, clicked => sub {
- destroy_widget();
- advanced_where_net_types(undef);
- }),
- 1, gtksignal_connect(my $button_where_cd = Gtk2::Button->new, clicked => sub {
- destroy_widget();
- advanced_where_cd(undef);
- }),
- 1, gtksignal_connect(my $button_where_hd = Gtk2::Button->new, clicked => sub {
- destroy_widget();
- advanced_where_hd(undef);
- }),
- 1, gtksignal_connect(my $button_where_tape = Gtk2::Button->new, clicked => sub {
- destroy_widget();
- advanced_where_tape(undef)
- }),
- 1, Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
- $button_where_net->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-network-40"),
- Gtk2::Label->new(N("Network")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_where_cd->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-CD-40"),
- Gtk2::Label->new(N("CD-R / DVD-R")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_where_hd->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-discdurwhat-40"),
- Gtk2::Label->new(N("HardDrive / NFS")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_where_tape->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-tape-40"),
- Gtk2::Label->new(N("Tape")),
- Gtk2::HBox->new(0, 5)
- ));
- fonction_env(\$box_where, \&advanced_where, \&advanced_box);
- $up_box->show_all;
-}
-
-sub advanced_when() {
- my $box_when;
- my $allow_custom = $backup_daemon && $custom_cron;
- my $combo_when_space = Gtk2::ComboBox->new_with_strings([ "", N("hourly"), N("daily"), N("weekly"), N("monthly"), N("custom") ]);
- my %trans = (N("hourly") => 'hourly',
- N("daily") => 'daily',
- N("weekly") => 'weekly',
- N("monthly") => 'monthly',
- N("custom") => 'custom');
- my %trans2 = ('hourly' => N("hourly"),
- 'daily' => N("daily"),
- 'weekly' => N("weekly"),
- 'monthly' => N("monthly"),
- 'custom' => N("custom"));
- set_help_tip($combo_when_space, 'when_space');
-
- #- custom setup - let user specify month, day of month, day of week, hour, minute
- my @months = ("*", N("January"), N("February"), N("March"),
- N("April"), N("May"), N("June"), N("July"), N("August"), N("September"),
- N("October"), N("November"), N("December"));
- my $combo_month_when = Gtk2::ComboBox->new_with_strings(\@months);
- my $combo_day_when = Gtk2::ComboBox->new_with_strings([ "*", (1..31) ]);
- my @weekdays = ("*", N("Sunday"), N("Monday"), N("Tuesday"),
- N("Wednesday"), N("Thursday"), N("Friday"), N("Saturday"));
- my $combo_weekday_when = Gtk2::ComboBox->new_with_strings(\@weekdays);
- my $combo_hour_when = Gtk2::ComboBox->new_text;
- $combo_hour_when->set_popdown_strings("*", (0..23));
- my $combo_minute_when = Gtk2::ComboBox->new_with_strings([ "*", (0..59) ]);
-
- my $entry_crontab = Gtk2::Entry->new;
- gtkset_editable($entry_crontab, 0);
-
- my @time_list = split(" ", $time_string);
- $combo_minute_when->entry->set_text($time_list[0]);
- $combo_hour_when->entry->set_text($time_list[1]);
- $combo_day_when->entry->set_text($time_list[2]);
- if ($time_list[3] =~ /\*/) {
- $combo_month_when->entry->set_text($time_list[3]);
- } else {
- $combo_month_when->entry->set_text($months[$time_list[3]]);
- }
- if ($time_list[4] =~ /\*/) {
- $combo_weekday_when->entry->set_text($time_list[4]);
- } else {
- $combo_weekday_when->entry->set_text($weekdays[$time_list[4] + 1]);
- }
-
- #- drop down list of possible media - default to config value
- my $entry_media_type = Gtk2::ComboBox->new_with_strings([ sort(@net_methods, @media_types) ], $conf{DAEMON_MEDIA});
-
- gtkpack($advanced_box,
- $box_when = gtkpack_(Gtk2::VBox->new(0, 10),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 1, Gtk2::HBox->new(0,10),
- 1, gtkcreate_img("ic82-when-40"),
- 0, my $check_when_daemon = Gtk2::CheckButton->new(N("Use daemon")),
- 1, Gtk2::HBox->new(0,10),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Please choose the time interval between each backup")), $backup_daemon),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive($combo_when_space, $backup_daemon),
- ),
- 0, Gtk2::HSeparator->new,
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Custom setup/crontab entry:")), $allow_custom),
- 1, gtkset_sensitive($entry_crontab, $allow_custom),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 1, gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Minute")), $allow_custom),
- 0, gtkset_sensitive($combo_minute_when, $allow_custom),
- ),
- 1, gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Hour")), $allow_custom),
- 0, gtkset_sensitive($combo_hour_when, $allow_custom),
- ),
- 1, gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Day")), $allow_custom),
- 0, gtkset_sensitive($combo_day_when, $allow_custom),
- ),
- 1, gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Month")), $allow_custom),
- 0, gtkset_sensitive($combo_month_when, $allow_custom),
- ),
- 1, gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Weekday")), $allow_custom),
- 0, gtkset_sensitive($combo_weekday_when, $allow_custom),
- ),
- ),
- 0, Gtk2::HSeparator->new,
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Please choose the media for backup.")), $backup_daemon),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkset_sensitive($entry_media_type, $backup_daemon),
- ),
- ),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Please be sure that the cron daemon is included in your services.")), $backup_daemon),
- 0, gtkset_sensitive(Gtk2::Label->new(N("If your machine isn't on all the time, you might want to install anacron.")), $backup_daemon),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Note that currently all 'net' media also use the hard drive.")), $backup_daemon),
- ),
- );
-
- gtksignal_connect(gtkset_active($check_when_daemon, $backup_daemon), toggled => sub {
- $backup_daemon = $backup_daemon ? 0 : 1;
- destroy_widget();
- advanced_when();
- });
- $combo_when_space->entry->set_text($trans2{$conf{DAEMON_TIME_SPACE}});
- $combo_when_space->entry->signal_connect('changed', sub {
- $conf{DAEMON_TIME_SPACE} = $trans{$combo_when_space->entry->get_text};
- $custom_cron = $conf{DAEMON_TIME_SPACE} eq "custom" ? 1 : 0;
- destroy_widget();
- advanced_when();
- });
- if ($custom_cron) {
- $entry_crontab->set_text("$time_string $exec_string")
- }
-
- $combo_minute_when->entry->signal_connect('changed', sub { combo_to_cron_string($combo_minute_when->get_text - 1, 0) });
- $combo_hour_when->entry->signal_connect('changed', sub { combo_to_cron_string($combo_hour_when->get_text - 1, 1) });
- $combo_day_when->entry->signal_connect('changed', sub { combo_to_cron_string($combo_day_when->get_text, 2) });
- $combo_month_when->entry->signal_connect('changed', sub { combo_to_cron_string($combo_month_when->get_text, 3) });
- $combo_weekday_when->entry->signal_connect('changed', sub { combo_to_cron_string($combo_weekday_when->get_text - 1, 4) });
-
- $entry_media_type->entry->signal_connect('changed', sub { $conf{DAEMON_MEDIA} = $entry_media_type->entry->get_text });
- fonction_env(\$box_when, \&advanced_when, \&advanced_box);
- $up_box->show_all;
-}
-
-sub combo_to_cron_string {
- my ($field, $location) = @_;
- $field = "*" if $field == 0 && $location > 1 && $location < 4;
- $field = "*" if $field == -1 && ($location < 2 || $location == 4);
- my @time_list = split(" ", $time_string);
- splice(@time_list, $location, 1, $field);
- $time_string = join(" ", @time_list);
- destroy_widget();
- advanced_when();
-}
-
-sub advanced_options() {
- my $box_options;
- my $entry_comp_mode = Gtk2::ComboBox->new_with_strings([ "tar", "tar.gz", "tar.bz2" ], $conf{OPTION_COMP});
- gtkpack($advanced_box,
- $box_options = gtkpack_(Gtk2::VBox->new(0, 15),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, Gtk2::Label->new(N("Please choose the compression type")),
- 1, Gtk2::HBox->new(0,10),
- 0, $entry_comp_mode,
- ),
- 0, my $check_backupignore = Gtk2::CheckButton->new(N("Use .backupignore files")),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, my $check_mail = Gtk2::CheckButton->new(N("Send mail report after each backup to:")),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(my $mail_entry = Gtk2::Entry->new, $conf{SEND_MAIL}),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 1, Gtk2::HBox->new(0,10),
- 0, N("SMTP server for mail:"),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(my $smtp_entry = Gtk2::Entry->new, $conf{SEND_MAIL}),
- ),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, my $check_del_hd_files = Gtk2::CheckButton->new(N("Delete Hard Drive tar files after backup to other media.")),
- ),
- ),
- );
- check_list([$check_mail, \$conf{SEND_MAIL}], [$check_del_hd_files, \$conf{DEL_HD_FILES}], [$check_backupignore, \$conf{BACKUPIGNORE}]);
- $mail_entry->set_text($conf{USER_MAIL});
- $mail_entry->signal_connect('changed', sub { $conf{USER_MAIL} = $mail_entry->get_text });
- $smtp_entry->set_text($conf{SMTP_SERVER});
- $smtp_entry->signal_connect('changed', sub { $conf{SMTP_SERVER} = $smtp_entry->get_text });
- $entry_comp_mode->entry->signal_connect('changed', sub { $conf{OPTION_COMP} = $entry_comp_mode->entry->get_text });
- set_help_tip($check_backupignore, 'backupignore');
- set_help_tip($check_mail, 'send_mail_to');
- set_help_tip($check_del_hd_files, 'delete_files');
- fonction_env(\$box_options, \&advanced_options, \&advanced_box);
- $up_box->show_all;
-}
-
-sub advanced_box() {
- my $box_adv;
-
- gtkpack($advanced_box,
- $box_adv = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtkpack_(Gtk2::VBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtksignal_connect(my $button_what = Gtk2::Button->new, clicked => sub {
- destroy_widget(); advanced_what() }),
- 1, gtksignal_connect(my $button_where = Gtk2::Button->new, clicked => sub {
- destroy_widget(); advanced_where() }),
- 1, gtksignal_connect(my $button_when = Gtk2::Button->new, clicked => sub {
- destroy_widget(); advanced_when() }),
- 1, gtksignal_connect(my $button_options = Gtk2::Button->new, clicked => sub {
- destroy_widget(); advanced_options() }),
- 1, Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
- $button_what->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-discdurwhat-40"),
- Gtk2::Label->new(N("What")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_where->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-where-40"),
- Gtk2::Label->new(N("Where")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_when->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-when-40"),
- Gtk2::Label->new(N("When")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_options->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-moreoption-40"),
- Gtk2::Label->new(N("More Options")),
- Gtk2::HBox->new(0, 5)
- ));
- fonction_env(\$box_adv, \&advanced_box, \&interactive_mode_box);
- $up_box->show_all;
-}
-
-################################################ WIZARD ################################################
-
-sub wizard_step3() {
- destroy_widget();
- my $no_device = 1 if $conf{USE_CD} && $conf{CD_DEVICE} eq '' || $conf{USE_TAPE} && $conf{TAPE_DEVICE} eq '' || $conf{USE_NET} && $conf{NET_PROTO} eq '';
- if ($no_device) {
- show_warning("f", N("Backup destination not configured..."));
- advanced_where_net_types(\&wizard_step2) if $conf{USE_NET};
- advanced_where_cd(\&wizard_step2) if $conf{USE_CD};
- advanced_where_tape(\&wizard_step2) if $conf{USE_TAPE};
- return;
- }
- if (check_pkg_needs()) {
- install_rpm(\&wizard_step3, undef);
- return;
- }
- my $text = Gtk2::TextView->new;
- save_conf_file();
- read_conf_file();
- system_state();
- gtktext_insert($text, [ [ $system_state ] ]);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, gtkpack_(Gtk2::VBox->new(0,10),
- 0, N("Drakbackup Configuration"),
- 1, create_scrolled_window($text),
- ),
- ),
- );
- fonction_env(\$box2, \&wizard_step3, \&wizard_step2);
- button_box_wizard_end();
- $up_box->show_all;
-}
-
-sub wizard_step2() {
- gtkpack($advanced_box,
- $box2 = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtkpack_(Gtk2::VBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 0, N("Please choose where you want to backup"),
- 0, gtkpack_(Gtk2::HBox->new(0, 15),
- 0, gtkpack__(Gtk2::VBox->new(0, 10),
- my @where_radio = gtkradio('', N("Hard Drive used to prepare backups for all media"), N("Across Network"), N("On CD-R"), N("On Tape Device")),
- ),
- 1, gtkpack_(Gtk2::HBox->new(0,5),),
- 0, gtkpack_(Gtk2::VBox->new(0,5),
- 0, gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("Configure")), clicked => sub {
- destroy_widget();
- advanced_where_hd(\&wizard_step2);
- }), $use_hd),
- 0, gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("Configure")), clicked => sub {
- destroy_widget();
- advanced_where_net_types(\&wizard_step2);
- }), $conf{USE_NET}),
- 0, gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("Configure")), clicked => sub {
- destroy_widget();
- advanced_where_cd(\&wizard_step2);
- }), $conf{USE_CD}),
- 0, gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("Configure")), clicked => sub {
- destroy_widget();
- advanced_where_tape(\&wizard_step2);
- }), $conf{USE_TAPE}),
- ),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
- my @wheres = ($use_hd, $conf{USE_NET}, $conf{USE_CD}, $conf{USE_TAPE});
- foreach my $i (0..3) {
- $where_radio[$i]->set_active($wheres[$i]);
- $where_radio[$i]->signal_connect(toggled => sub {
- if ($where_radio[$i]->get_active) {
- @wheres = (0, 0, 0, 0);
- $wheres[$i] = 1;
- ($use_hd, $conf{USE_NET}, $conf{USE_CD}, $conf{USE_TAPE}) = @wheres;
- destroy_widget();
- wizard_step2();
- }
- });
- }
- fonction_env(\$box2, \&wizard_step2, \&wizard, undef);
- button_box_wizard();
- $up_box->show_all;
-}
-
-sub wizard() {
- my $user_string = N("Backup Users");
- $user_string .= N(" (Default is all users)") if !$nonroot_user;
- if (!$conf{NO_USER_FILES} && !$manual_user) {
- @user_list = @user_list_all;
- } elsif (!$manual_user) {
- @user_list = ();
- }
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtkpack_(Gtk2::VBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 0, N("Please choose what you want to backup"),
- 0, my $check_wizard_sys = Gtk2::CheckButton->new(N("Backup System")),
- 0, my $check_wizard_user = Gtk2::CheckButton->new($user_string),
- 0, gtksignal_connect(Gtk2::Button->new(N("Select user manually")), clicked => sub {
- $manual_user = 1;
- destroy_widget();
- advanced_what_user(\&wizard);
- }),
- 1, Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
- foreach ([$check_wizard_sys, \$conf{NO_SYS_FILES}], [$check_wizard_user, \$conf{NO_USER_FILES}]) {
- my $ref = $_->[1];
- gtksignal_connect(gtkset_active($_->[0], !$$ref), toggled => sub {
- $$ref = $$ref ? 0 : 1;
- if (!$conf{NO_SYS_FILES} || !$conf{NO_USER_FILES} && @user_list) {
- $next_widget = \&wizard_step2;
- } else {
- $next_widget = \&wizard;
- }
- if (!$conf{NO_USER_FILES}) {
- @user_list = @user_list_all;
- } else {
- @user_list = ();
- }
- })
- }
- if (!$conf{NO_SYS_FILES} || !$conf{NO_USER_FILES} && @user_list) {
- fonction_env(\$box2, \&wizard, \&interactive_mode_box, \&wizard_step2);
- } else {
- $in->ask_warn(N("Error"), N("Please select data to backup..."));
- fonction_env(\$box2, \&wizard, \&interactive_mode_box, \&wizard);
- }
- button_box_wizard();
- $up_box->show_all;
-}
-
-################################################ RESTORE ################################################
-
-sub find_backup_to_restore() {
- my @list_backup;
- my @list_backup_tmp2;
- my $to_put;
- my $nom;
- @sys_backuped = ();
- local $_;
-
- @user_backuped = ();
- -d $path_to_find_restore and @list_backup_tmp2 = all($path_to_find_restore);
-
- foreach (@list_backup_tmp2) {
- s/_base//gi;
- s/_incr//gi;
- push @list_backup , $_;
- }
- foreach (grep { /^backup_sys_/ } @list_backup) {
- ($to_put, undef) = file_to_put($_, "sys");
- push @sys_backuped , $to_put;
- }
- $restore_step_sys_date = $to_put;
- foreach (grep { /^backup_other_/ } @list_backup) {
- ($to_put, undef) = file_to_put($_, "other");
- push @other_backuped , $to_put;
- }
- $restore_step_other_date = $to_put;
- foreach (grep { /^backup_user_/ } @list_backup) {
- ($to_put, $nom) = file_to_put($_, "user");
- push @user_backuped , $to_put;
- any { /^$nom$/ } @user_list_backuped or push @user_list_backuped, $nom;
- }
-}
-
-sub file_to_put {
- my ($name, $type) = @_;
- my $to_put;
- my ($nom, $date, $heure);
- local $_ = $name;
- chomp;
- $name = "backup_" . $type . "_";
- s/^$name//gi;
- s/.tar|.gz|.bz2$//gi;
- if ($type eq "user") {
- ($nom, $date, $heure) = /^(.*)_([^_]*)_([^_]*)$/;
- } else {
- ($date, $heure) = /^(.*)_([^_]*)$/;
- }
- my $year = substr($date, 0, 4);
- my $month = substr($date, 4, 2);
- my $day = substr($date, 6, 2);
- my $hour = substr($heure, 0, 2);
- my $min = substr($heure, 2, 2);
- if ($type eq "user") {
- $to_put = "$_ user: $nom, date: $day/$month/$year, hour: $hour:$min";
- return $to_put, $nom;
- } else {
- $to_put = "$day/$month/$year $hour:$min $_";
- return $to_put, undef;
- }
-}
-
-sub system_state() {
- if ($cfg_file_exist) {
- $system_state = N("\nBackup Sources: \n");
- $conf{NO_SYS_FILES} or $system_state .= N("\n- System Files:\n");
- $conf{NO_SYS_FILES} or $system_state .= "\t\t$_\n" foreach @sys_files;
- $conf{NO_USER_FILES} or $system_state .= N("\n- User Files:\n");
- $conf{NO_USER_FILES} or $system_state .= "\t\t$_\n" foreach @user_list;
- $conf{OTHER_FILES} and $system_state .= N("\n- Other Files:\n");
- $conf{OTHER_FILES} and $system_state .= "\t\t$_\n" foreach @other_files;
- $conf{USE_HD} and $system_state .= N("\n- Save on Hard drive on path: %s\n", $conf{PATH_TO_SAVE});
- $conf{USE_HD} and $system_state .= N("\tLimit disk usage to %s MB\n", $conf{MAX_SPACE});
-
- if ($conf{DEL_HD_FILES} && ($conf{USE_CD} || $conf{USE_TAPE} || $conf{USE_NET}) && $conf{DAEMON_MEDIA} ne 'hd') {
- $system_state .= N("\n- Delete hard drive tar files after backup.\n");
- }
-
- #- tape and CDRW share some features
- my $erase_media = $conf{MEDIA_ERASE} && ($conf{USE_CD} || $conf{USE_TAPE}) ? N("Yes") : N("No");
- $conf{USE_CD} and $system_state .= N("\n- Burn to CD");
- $conf{USE_CD} and $conf{CDRW} and $system_state .= N("RW");
- $conf{USE_CD} and $system_state .= N(" on device: %s", $conf{CD_DEVICE});
- $conf{USE_CD} && $conf{MULTI_SESSION} and $system_state .= N(" (multi-session)");
- $conf{USE_TAPE} and $system_state .= N("\n- Save to Tape on device: %s", $conf{TAPE_DEVICE});
- (($conf{USE_CD} || $conf{USE_TAPE}) && $conf{MEDIA_ERASE}) and $system_state .= N("\t\tErase=%s", $erase_media);
- $conf{USE_CD} || $conf{USE_TAPE} and $system_state .= "\n";
- $conf{USE_TAPE} && $conf{DIRECT_TAPE} and $system_state .= N("\tBackup directly to Tape\n");
-
- $conf{USE_NET} and $system_state .= N("\n- Save via %s on host: %s\n", $conf{NET_PROTO}, $conf{HOST_NAME});
- $conf{USE_NET} and $system_state .= N("\t\t user name: %s\n\t\t on path: %s \n", $conf{LOGIN}, $conf{HOST_PATH});
- $system_state .= N("\n- Options:\n");
- $conf{NO_SYS_FILES} and $system_state .= N("\tDo not include System Files\n");
-
- $system_state .= N("\tBackups use tar and bzip2\n") if $conf{OPTION_COMP} eq "tar.bz2";
- $system_state .= N("\tBackups use tar and gzip\n") if $conf{OPTION_COMP} eq "tar.gz";
- $system_state .= N("\tBackups use tar only\n") if $conf{OPTION_COMP} eq "tar";
-
- $system_state .= N("\tUse .backupignore files\n") if $conf{BACKUPIGNORE};
- $system_state .= N("\tSend mail to %s\n", $conf{USER_MAIL}) if $conf{SEND_MAIL};
- $system_state .= N("\tUsing SMTP server %s\n", $conf{SMTP_SERVER}) if $conf{SEND_MAIL};
-
- $conf{DAEMON_MEDIA} and $system_state .= N("\n- Daemon, %s via:\n", $conf{DAEMON_TIME_SPACE});
- $conf{DAEMON_MEDIA} eq 'hd' and $system_state .= N("\t-Hard drive.\n");
- $conf{DAEMON_MEDIA} eq 'cd' and $system_state .= N("\t-CD-R.\n");
- $conf{DAEMON_MEDIA} eq 'tape' and $system_state .= N("\t-Tape \n");
- $conf{DAEMON_MEDIA} eq 'ftp' and $system_state .= N("\t-Network by FTP.\n");
- $conf{DAEMON_MEDIA} eq 'ssh' and $system_state .= N("\t-Network by SSH.\n");
- $conf{DAEMON_MEDIA} eq 'rsync' and $system_state .= N("\t-Network by rsync.\n");
- $conf{DAEMON_MEDIA} eq 'webdav' and $system_state .= N("\t-Network by webdav.\n");
- } else {
- $system_state = N("No configuration, please click Wizard or Advanced.\n");
- }
-}
-
-sub restore_state() {
- $restore_state = N("List of data to restore:\n\n");
- if ($restore_sys) {
- $restore_state .= N("- Restore System Files.\n");
- my @tmp = split(' ', $restore_step_sys_date);
- $restore_state .= N(" - from date: %s %s\n", $tmp[0], $tmp[1]);
- }
- if ($restore_user) {
- $restore_state .= N("- Restore User Files: \n");
- $restore_state .= "\t\t$_\n" foreach @user_list_to_restore2;
- push @user_list_to_restore, (split(',', $_))[0] foreach @user_list_to_restore2;
- }
- if ($restore_other) {
- $restore_state .= N("- Restore Other Files: \n");
- my @tmp = split(' ', $restore_step_other_date);
- $restore_state .= N(" - from date: %s %s\n", $tmp[0], $tmp[1]);
- }
- if ($restore_other_path) {
- $restore_state .= "- Path to Restore: $restore_path \n";
- }
-}
-
-sub select_most_recent_selected_of {
- my ($user_name) = @_;
- my @tmp = sort @user_list_to_restore2;
- my @list_tmp2 = grep { /$user_name/ } sort @tmp;
- return pop @list_tmp2;
-}
-
-sub select_user_data_to_restore() {
- my $var_eq = 1;
- my @list_backup;
- my @list_tmp;
- my @list_tmp2;
- @user_list_to_restore = ();
- local $_;
-
- -d $path_to_find_restore and my @list_backup_tmp2 = grep { /^backup/ } all($path_to_find_restore);
- @list_tmp2 = @list_backup_tmp2;
- foreach (@list_backup_tmp2) {
- s/_base//gi;
- s/_incr//gi;
- push @list_backup , $_;
- }
- foreach my $var_tmp (@user_list_backuped) {
- $var_eq = 1;
- my $more_recent = (split(' ', select_most_recent_selected_of($var_tmp)))[0];
- foreach (grep { /^backup_user_$var_tmp/ } sort @list_backup) {
- s/.$conf{OPTION_COMP}//gi;
- if ($more_recent) {
- if (/$more_recent/) {
- push @list_tmp , $_;
- $var_eq = 0;
- } else {
- #- only if user asked for it - previously this was restoring everything (SB)
- my $tmp_name = $_;
- s/backup_user_//gi;
- foreach my $buff (@user_list_to_restore2) {
- if (index($buff, $_) >= 0) {
- $var_eq and push @list_tmp , $tmp_name;
- }
- }
- }
- }
- }
- }
- foreach my $var_to_restore (@list_tmp) {
- $var_to_restore =~ s/backup_//gi;
- foreach my $var_exist (sort @list_tmp2) {
- if ($var_exist =~ /$var_to_restore/) {
- push @user_list_to_restore, $var_exist;
- }
- }
- }
- $DEBUG and print "real user list to restore: $_ \n" foreach @user_list_to_restore;
-}
-
-sub select_sys_data_to_restore() {
- my $var_eq = 1;
- my @list_tmp;
- local $_;
-
- -d $path_to_find_restore and @list_tmp = grep { /^backup/ } all($path_to_find_restore);
- my @more_recent = split(' ', $restore_step_sys_date);
- my $more_recent = pop @more_recent;
- foreach my $var_exist (grep { /_sys_/ } sort @list_tmp) {
- if ($var_exist =~ /$more_recent/) {
- push @sys_list_to_restore, $var_exist;
- $var_eq = 0;
- } else {
- $var_eq and push @sys_list_to_restore, $var_exist;
- }
- }
- $DEBUG and print "sys list to restore: $_\n " foreach @sys_list_to_restore;
-}
-
-sub select_other_data_to_restore() {
- my $var_eq = 1;
- my @list_tmp;
- local $_;
- @other_list_to_restore = ();
-
- -d $path_to_find_restore and @list_tmp = grep { /^backup/ } all($path_to_find_restore);
- my @more_recent = split(' ', $restore_step_other_date);
- my $more_recent = pop @more_recent;
- foreach my $var_exist (grep { /_other_/ } sort @list_tmp) {
- if ($var_exist =~ /$more_recent/) {
- push @other_list_to_restore, $var_exist;
- $var_eq = 0;
- } else {
- $var_eq and push @other_list_to_restore, $var_exist;
- }
- }
- $DEBUG and print "other list to restore: $_\n " foreach @other_list_to_restore;
-}
-
-sub show_backup_details {
- my ($function, $mode, $name) = @_;
- my $archive_file_detail;
- my $value;
- my $command2;
- my $tarfile;
-
- if ($mode eq "user") {
- #- we've only got a partial filename in this case
- $tarfile = "$path_to_find_restore/backup_*" . $name . ".tar*";
- }
- if ($mode eq "sys") {
- #- funky string here we need to use to reconstruct the filename
- my @flist = split(/[ \t,]+/, $name);
- $tarfile = "$path_to_find_restore/backup_*" . $flist[2] . ".tar*";
- }
- my @tarfiles = glob($tarfile);
- if ($tarfiles[0] eq "") {
- destroy_widget();
- $function->();
- }
- $tarfile = $tarfiles[0];
- my $command1 = "stat " . $tarfile;
-
- $command2 = "tar -tv";
- $command2 = set_tar($command2, $tarfile);
- $command2 .= " $tarfile";
-
- log::explanations("Running $command1");
- $archive_file_detail = `$command1 2>&1` . "\n\n";
- log::explanations("Running $command2");
- my $TMP;
- open $TMP, "$command2 2>&1 |";
- while ($value = <$TMP>) {
- #- drop the permissions display for the sake of readability
- $archive_file_detail .= substr($value, 11);
- }
- close $TMP;
-
- my $text = Gtk2::TextView->new;
- my $advanced_box_archive;
- gtktext_insert(gtkset_editable($text, 0), $archive_file_detail);
- gtkpack($advanced_box,
- $advanced_box_archive = gtkpack_(Gtk2::VBox->new(0,10),
- 1, gtkpack_(Gtk2::HBox->new(0,0),
- 1, create_scrolled_window($text),
- ),
- 0, gtkadd(gtkset_layout(Gtk2::HButtonBox->new, 'spread'),
- gtksignal_connect(Gtk2::Button->new(N("Done")), clicked => sub {
- destroy_widget();
- $function->() }),
- ),
- )
- );
- $central_widget = \$advanced_box_archive;
- $up_box->show_all;
-}
-
-sub valid_backup_test {
- my (@files_list) = @_;
- @files_corrupted = ();
- my $is_corrupted = 0;
- my $comp_test;
- foreach (@files_list) {
- $comp_test = set_tar("tar t", $_);
- if (system("$comp_test $path_to_find_restore/$_ > /dev/null 2>&1") > 1) {
- push @files_corrupted, $_;
- $is_corrupted = -1;
- }
- }
- return $is_corrupted;
-}
-
-sub restore_aff_backup_problems() {
- my $do_restore;
- my $text = Gtk2::TextView->new;
- my $restore_pbs_state = N("List of data corrupted:\n\n");
- $restore_pbs_state .= "\t\t$_\n" foreach @files_corrupted;
- $restore_pbs_state .= N("Please uncheck or remove it on next time.");
- gtktext_insert($text, [ [ $restore_pbs_state ] ]);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $do_restore = gtkpack_(Gtk2::VBox->new(0,10),
- 0, Gtk2::VBox->new(0,10),
- 1, gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtkcreate_img('warning'),
- 0, N("Backup files are corrupted"),
- 1, Gtk2::VBox->new(0, 5),
- ),
- 0, Gtk2::VBox->new(0,10),
- 1, create_scrolled_window($text),
- ),
- );
- button_box_restore_pbs_end();
- fonction_env(\$do_restore, \&restore_aff_backup_problems, "restore_pbs");
- $up_box->show_all;
-}
-
-sub restore_aff_result() {
- my $do_restore;
- my $text = Gtk2::TextView->new;
- gtktext_insert($text, [ [ $restore_state ] ]);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $do_restore = gtkpack_(Gtk2::VBox->new(0,10),
- 1, Gtk2::VBox->new(0,10),
- 0, N(" All of your selected data have been "),
- 0, N(" Successfully Restored on %s ", $restore_path),
- 1, Gtk2::VBox->new(0,10),
- ),
- );
- button_box_ok_only();
- $central_widget = \$do_restore;
- $up_box->show_all;
-}
-
-sub return_path {
- my ($username) = @_;
- my $usr;
- my $home_dir;
- my @passwords = cat_("/etc/passwd");
- foreach my $line (@passwords) {
- chomp($line);
- ($usr, $home_dir) = (split(/:/, $line))[0,5];
- last if $usr eq $username;
- }
- return $home_dir;
-}
-
-sub restore_backend() {
- my $untar_cmd = "tar x";
- my $exist_problem = 0;
- my $user_dir;
- my $username;
- local $_;
- -d $restore_path or mkdir_p $restore_path;
-
- if ($restore_user) {
- select_user_data_to_restore();
- if (valid_backup_test(@user_list_to_restore) == -1) {
- $exist_problem = 1;
- restore_aff_backup_problems();
- } else {
- foreach (@user_list_to_restore) {
- if ($conf{USER_INCREMENTAL_BACKUPS}) {
- (undef, $username, undef) = /^(\w+_\w+_user_)(.*)_(\d+_\d+.*)$/;
- } else {
- (undef, $username, undef) = /^(\w+_user_)(.*)_(\d+_\d+.*)$/;
- }
-
- $user_dir = return_path($username);
- -d $user_dir and rm_rf($user_dir) if $remove_user_before_restore;
-
- my $user_untar = set_tar($untar_cmd, $_);
- $DEBUG and print "user name to restore: $username, user directory: $user_dir\n";
- system("$user_untar $path_to_find_restore/$_ -C $restore_path");
- }
- #- flush this out for another cycle (SB)
- @user_list_to_restore2 = ();
- }
- }
-
- if ($restore_sys) {
- select_sys_data_to_restore();
- if (valid_backup_test(@sys_list_to_restore) == -1) {
- $exist_problem = 1;
- restore_aff_backup_problems();
- } else {
- foreach (@sys_list_to_restore) {
- my $sys_untar = set_tar($untar_cmd, $_);
- system("$sys_untar $path_to_find_restore/$_ -C $restore_path");
- }
- }
- }
- if ($restore_other) {
- if (valid_backup_test(@other_list_to_restore) == -1) {
- $exist_problem = 1;
- restore_aff_backup_problems();
- } else {
- foreach (@other_list_to_restore) {
- my $other_untar = set_tar($untar_cmd, $_);
- system("$other_untar $path_to_find_restore/$_ -C $restore_path");
- }
- }
- }
- $exist_problem or restore_aff_result();
-}
-
-sub set_tar {
- my ($untar_cmd, $filename) = @_;
- $untar_cmd .= "z" if $filename =~ /tar.gz$/;
- $untar_cmd .= "j" if $filename =~ /tar.bz2$/;
- $untar_cmd .= "f";
- return $untar_cmd;
-}
-
-sub restore_do() {
- if ($backup_bef_restore) {
- if ($restore_sys) {
- $conf{NO_SYS_FILES} = 0;
- } else {
- $conf{NO_SYS_FILES} = 1;
- }
- if ($restore_user) {
- $conf{NO_USER_FILES} = 0;
- @user_list = @user_list_to_restore;
- } else {
- $conf{NO_USER_FILES} = 1;
- }
- build_backup_status();
- read_conf_file();
- build_backup_files();
- $table->destroy;
- }
- restore_do2();
-}
-
-sub restore_do2() {
- destroy_widget();
- my $do_restore;
- my $text = Gtk2::TextView->new;
- restore_state();
- gtktext_insert($text, [ [ $restore_state ] ]);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $do_restore = gtkpack_(Gtk2::VBox->new(0,10),
- 0, N(" Restore Configuration "),
- 1, create_scrolled_window($text),
- ),
- );
- button_box_restore_end();
- fonction_env(\$do_restore, \&restore_do2, \&restore_box);
- $up_box->show_all;
-}
-
-sub restore_step_other() {
- my $retore_step_other;
- my $text = Gtk2::TextView->new;
- my $untar_cmd = "tar tzf";
- my $other_rest = "";
- select_other_data_to_restore();
- if ($restore_other) {
- foreach (@other_list_to_restore) {
- if (/tar.bz2$/) {
- $untar_cmd = "tar tjf";
- }
- $other_rest .= "/" . `$untar_cmd $path_to_find_restore/$_ -C $restore_path`;
- }
- }
- gtktext_insert($text, [ [ $other_rest ] ]);
- gtkpack($advanced_box,
- $retore_step_other = gtkpack_(Gtk2::VBox->new(0,10),
- 1, Gtk2::VBox->new(0,10),
- 1, create_scrolled_window($text),
- 0, my $check_restore_other_sure = Gtk2::CheckButton->new(N("OK to restore the other files.")),
- 1, Gtk2::VBox->new(0,10),
- ),
- );
- check_list([$check_restore_other_sure, \$restore_other]);
- fonction_env(\$retore_step_other, \&restore_step_other, \&restore_step2, \&restore_do);
- $up_box->show_all;
-}
-
-sub restore_step_user() {
- my $retore_step_user;
- my @tmp_list = sort @user_backuped;
- @user_backuped = @tmp_list;
- gtkpack($advanced_box,
- $retore_step_user = gtkpack_(Gtk2::VBox->new(0,10),
- 0, Gtk2::VBox->new(0,10),
- 0, N("User list to restore (only the most recent date per user is important)"),
- 1, create_scrolled_window(gtkpack__(Gtk2::VBox->new(0,0),
- map { my $name;
- my $var2;
- my $name_complet = $_;
- $name = (split(' ', $name_complet))[0];
- my @user_list_tmp;
- my $restore_row = Gtk2::HBox->new(0,5);
- my $b = Gtk2::CheckButton->new($name_complet);
- my $details = Gtk2::Button->new(N("Details"));
-
- $restore_row->pack_start($b, 1, 1, 0);
- $restore_row->pack_end(Gtk2::VBox->new(1,5), 0, 0, 0);
- $restore_row->pack_end($details, 0, 0, 0);
-
- foreach (@user_list_to_restore2) {
- if ($name_complet eq $_) {
- gtkset_active($b, 1);
- $check_user_to_restore{$name_complet}[1] = 1;
- } else {
- gtkset_active($b, 0);
- $check_user_to_restore{$name_complet}[1] = 0;
- }
- }
- $b->signal_connect(toggled => sub {
- if (!$check_user_to_restore{$name_complet}[1]) {
- $check_user_to_restore{$name_complet}[1] = 1;
- if (!any { /$name/ } @user_list_to_restore2) {
- push @user_list_to_restore2, $name_complet
- }
- } else {
- $check_user_to_restore{$name_complet}[1] = 0;
- foreach (@user_list_to_restore2) {
- $var2 = (split(' ', $_))[0];
- if ($name ne $var2) {
- push @user_list_tmp, $_;
- }
- }
- @user_list_to_restore2 = @user_list_tmp;
- }
- });
- $details->signal_connect('clicked', sub {
- destroy_widget();
- show_backup_details(\&restore_step_user, "user", $name);
- });
- $restore_row } (@user_backuped)
- ),
- ),
- ),
- );
- if ($restore_other) {
- fonction_env(\$retore_step_user, \&restore_step_user, "", \&restore_step_other);
- } elsif ($restore_sys) {
- fonction_env(\$retore_step_user, \&restore_step_user, \&restore_step_sys, \&restore_step_other);
- } else {
- fonction_env(\$retore_step_user, \&restore_step_user, \&restore_step2, \&restore_do);
- }
- $up_box->show_all;
-}
-
-sub restore_step_sys() {
- my $restore_step_sys;
- my $combo_restore_step_sys = Gtk2::ComboBox->new_with_strings(\@sys_backuped, $restore_step_sys_date);
- gtkpack($advanced_box,
- $restore_step_sys = gtkpack_(Gtk2::VBox->new(0,10),
- 0, N("Please choose the date to restore:"),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 1, Gtk2::HBox->new(0,10),
- 0, $combo_restore_step_sys,
- 0, my $details = Gtk2::Button->new(N("Details")),
- 1, Gtk2::HBox->new(0,10),
- ),
- ),
- );
- $combo_restore_step_sys->entry->signal_connect('changed', sub {
- $restore_step_sys_date = $combo_restore_step_sys->entry->get_text;
- });
- $details->signal_connect('clicked', sub {
- #- we're only passing a portion of the filename to
- #- the subroutine so we need to let it know this
- $restore_step_sys_date = $combo_restore_step_sys->entry->get_text;
- destroy_widget();
- show_backup_details(\&restore_step_sys, "sys", $restore_step_sys_date);
- });
- fonction_env(\$restore_step_sys, \&restore_step_sys, \&restore_step2, "restore");
- if ($restore_user) {
- fonction_env(\$restore_step_sys, \&restore_step_sys, \&restore_step2, \&restore_step_user);
- } elsif ($restore_other) {
- fonction_env(\$restore_step_sys, \&restore_step_sys, \&restore_step2, \&restore_step_other);
- } else {
- fonction_env(\$restore_step_sys, \&restore_step_sys, \&restore_step2, \&restore_do);
- }
- $up_box->show_all;
-}
-
-sub restore_other_media() {
- my $box_find_restore;
- my $button;
-
- gtkpack($advanced_box,
- $box_find_restore = gtkpack_(Gtk2::VBox->new(0, 6),
- 0, Gtk2::HSeparator->new,
- 0, my $check_other_media_hd = Gtk2::CheckButton->new(N("Restore from Hard Disk.")),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(Gtk2::Label->new(N("Enter the directory where backups are stored")), $other_media_hd),
- 1, Gtk2::VBox->new(0, 6),
- 0, gtkset_size_request(gtkset_sensitive($restore_find_path_entry = Gtk2::Entry->new, $other_media_hd), 152, 20),
- 0, gtkset_sensitive($button = gtksignal_connect(Gtk2::Button->new, clicked => sub {
- filedialog_generic(N("Directory with backups"), \$restore_find_path_entry);
- }), $other_media_hd),
- ),
- 1, Gtk2::VBox->new(0, 6),
- 0, Gtk2::VBox->new(0, 6),
- ),
- );
- gtksignal_connect(gtkset_active($check_other_media_hd, $other_media_hd), toggled => sub {
- $other_media_hd = $other_media_hd ? 0 : 1;
- destroy_widget();
- $current_widget->();
- });
- $button->add(gtkpack(Gtk2::HBox->new(0,10), gtkcreate_img("ic82-dossier-32")));
- $restore_find_path_entry->set_text($path_to_find_restore);
- $restore_find_path_entry->signal_connect('changed', sub { $path_to_find_restore = $restore_find_path_entry->get_text });
- fonction_env(\$box_find_restore, \&restore_other_media, \&restore_step2, \&restore_do);
- $up_box->show_all;
-}
-
-sub restore_step2() {
- my $retore_step2;
- my $other_exist;
- my $sys_exist;
- my $user_exist;
- local $_;
- destroy_widget();
-
- my $restore_info_path = $conf{PATH_TO_SAVE};
- $restore_info_path = $path_to_find_restore if $conf{USE_HD} || $conf{USE_CD};
- my $info_prefix = "backup";
- $info_prefix = "list" if $conf{USE_NET} || $conf{USE_TAPE};
-
- if (any { /_other_/ } grep { /^$info_prefix/ } all("$restore_info_path/")) {
- $other_exist = 1;
- } else {
- $other_exist = 0; $restore_other = 0;
- }
- if (any { /_sys_/ } grep { /^$info_prefix/ } all("$restore_info_path/")) {
- $sys_exist = 1;
- } else {
- $sys_exist = 0; $restore_sys = 0;
- }
- if (any { /_user_/ } grep { /^$info_prefix/ } all("$restore_info_path/")) {
- $user_exist = 1
- } else {
- $user_exist = 0; $restore_user = 0;
- }
-
- my $restore_path_entry = Gtk2::Entry->new;
- gtkpack($advanced_box,
- $retore_step2 = gtkpack_(Gtk2::VBox->new(0,10),
- 1, Gtk2::VBox->new(0,10),
- 1, Gtk2::VBox->new(0,10),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, my $check_restore_other_src = Gtk2::CheckButton->new(N("Select another media to restore from")),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("Other Media")), clicked => sub {
- destroy_widget();
- restore_other_media();
- }), $restore_other_src),
- ),
- 0, gtkset_sensitive(my $check_restore_sys = Gtk2::CheckButton->new(N("Restore system")), $sys_exist),
- 0, gtkset_sensitive(my $check_restore_user = Gtk2::CheckButton->new(N("Restore Users")), $user_exist),
- 0, gtkset_sensitive(my $check_restore_other = Gtk2::CheckButton->new(N("Restore Other")), $other_exist),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 0, my $check_restore_other_path = Gtk2::CheckButton->new(N("Select path to restore (instead of /)")),
- 1, Gtk2::HBox->new(0,10),
- 0, gtkset_sensitive($restore_path_entry, $restore_other_path),
- 0, gtksignal_connect(my $button = Gtk2::Button->new->new, clicked => sub {
- filedialog_generic(N("Path To Restore To"), \$restore_path_entry);
- }),
- ),
- 0, gtkset_sensitive(my $check_backup_bef_restore = Gtk2::CheckButton->new(N("Do new backup before restore (only for incremental backups.)")),
- $conf{SYS_INCREMENTAL_BACKUPS} || $conf{USER_INCREMENTAL_BACKUPS}),
- 0, gtkset_sensitive(my $check_remove_user_dir = Gtk2::CheckButton->new(N("Remove user directories before restore.")), $user_exist),
- 1, Gtk2::VBox->new(0,10),
- ),
- );
-
- foreach ([$check_restore_sys, \$restore_sys],
- [$check_backup_bef_restore, \$backup_bef_restore],
- [$check_restore_user, \$restore_user],
- [$check_remove_user_dir, \$remove_user_before_restore],
- [$check_restore_other, \$restore_other]) {
- my $ref = $_->[1];
- gtksignal_connect(gtkset_active($_->[0], $$ref), toggled => sub {
- $$ref = $$ref ? 0 : 1;
- if (!$restore_sys && !$restore_user && !$restore_other) {
- $next_widget = \&message_norestore_box;
- } elsif ($restore_sys && $conf{SYS_INCREMENTAL_BACKUPS}) {
- $next_widget = \&restore_step_sys;
- } elsif ($restore_user) {
- $next_widget = \&restore_step_user;
- } elsif ($restore_other) {
- $next_widget = \&restore_step_other;
- } else {
- $next_widget = \&restore_do;
- }
- })
- }
- gtksignal_connect(gtkset_active($check_restore_other_path, $restore_other_path), toggled => sub {
- $restore_other_path = $restore_other_path ? 0 : 1;
- destroy_widget();
- $current_widget->();
- });
- gtksignal_connect(gtkset_active($check_restore_other_src, $restore_other_src), toggled => sub {
- $restore_other_src = $restore_other_src ? 0 : 1;
- destroy_widget();
- $current_widget->();
- });
- $central_widget = \$retore_step2;
- fonction_env(\$retore_step2, \&restore_step2, \&restore_box);
- if (!$restore_sys && !$restore_user && !$restore_other) {
- $next_widget = \&message_norestore_box;
- } elsif ($restore_sys && $conf{SYS_INCREMENTAL_BACKUPS}) {
- $next_widget = \&restore_step_sys;
- } elsif ($restore_user) {
- $next_widget = \&restore_step_user;
- } elsif ($restore_other) {
- $next_widget = \&restore_step_other;
- } else {
- $next_widget = \&restore_do;
- }
- $button->add(gtkpack(Gtk2::HBox->new(0,10), gtkcreate_img("ic82-dossier-32")));
- $restore_path_entry->set_text($restore_path);
- $restore_path_entry->signal_connect('changed', sub {
- $restore_path = $restore_path_entry->get_text;
- $untar_prefix = "tar -C $restore_path -x";
- });
- $up_box->show_all;
-}
-
-sub find_files_to_restore() {
- local $_;
- my $file_restore;
- my $start_restore;
- my $files_selected = 0;
- my @possible_sources;
- my %catalog_entries;
- my @files_to_restore;
- my $cat_entry;
- my @catalog = cat_("$cfg_dir/drakbackup_catalog");
- destroy_widget();
-
- #- file info in tree view
- my $model = Gtk2::TreeStore->new("Glib::String", "Gtk2::Gdk::Pixbuf", "Glib::Int");
- my $file_list = Gtk2::TreeView->new_with_model($model);
- $file_list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $file_list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererPixbuf->new, 'pixbuf' => 1));
- $file_list->append_column(my $valcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 2));
- $file_list->set_headers_visible(0);
- $file_list->get_selection->set_mode('browse');
- $valcolumn->set_visible(0);
- my $unselected = gtkcreate_pixbuf('unselected');
- my $selected = gtkcreate_pixbuf('selected');
- my $file_wildcard_entry = Gtk2::Entry->new;
-
- gtkpack($advanced_box,
- $file_restore = gtkpack_(Gtk2::VBox->new(0,10),
- 0, Gtk2::Label->new(N("Filename text substring to search for (empty string matches all):")),
- 0, gtkpack_(Gtk2::HBox->new(0,10),
- 1, $file_wildcard_entry,
- 0, gtksignal_connect(Gtk2::Button->new(N("Search Backups")), clicked => sub {
- local $_ = $file_wildcard_entry->get_text;
- s|^\*|\\*|g;
- my $wildcard = $_;
- @possible_sources = glob "$conf{PATH_TO_SAVE}/list*";
- $model->clear;
- my $match = 0;
- foreach my $list (@possible_sources) {
- my @matches = grep { /$wildcard/ } cat_($list);
- if (@matches) {
- my $list_entry = $model->append_set(undef, [ 0 => $list, 2 => '' ]);
- foreach (@matches) {
- chop;
- $model->append_set($list_entry, [ 0 => $_, 1 => $unselected, 2 => 0 ]);
- }
- $match = 1
- }
- }
- show_warning("i", N("No matches found...")) if $match == 0;
- }),
- ),
- 1, create_scrolled_window($file_list),
- 0, gtkset_sensitive(gtksignal_connect($start_restore = Gtk2::Button->new(N("Restore Selected")), clicked => sub {
- @files_to_restore = ();
- my $last_entry = '';
- my $catalog_entry;
- my $restore_file;
- foreach (sort keys %catalog_entries) {
- if ($catalog_entries{$_} == 1) {
- ($catalog_entry, $restore_file) = split("###", $_);
- $last_entry = $catalog_entry if $last_entry eq '';
- if ($catalog_entry ne $last_entry) {
- restore_catalog_entry($cat_entry, @files_to_restore);
- @files_to_restore = ();
- push @files_to_restore, $restore_file;
- } else {
- push @files_to_restore, $restore_file;
- }
- $last_entry = $catalog_entry;
- }
- }
- restore_catalog_entry($cat_entry, @files_to_restore);
- destroy_widget();
- find_files_to_restore();
- }), 0),
- ),
- );
-
- $file_list->get_selection->signal_connect(changed => sub {
- my ($lmodel, $iter) = $_[0]->get_selected;
- $lmodel && $iter or return;
- my ($s, $val) = $lmodel->get($iter, 0, 2);
- if (! any { /$s/ } @possible_sources) {
- my $parent_iter = Gtk2::TreeModel::iter_parent($lmodel, $iter);
- my $parent_name = $lmodel->get($parent_iter, 0);
- $cat_entry = substr($parent_name, -19, 15);
- my @full_cat_entry = grep { /^$cat_entry/ } @catalog;
- chop @full_cat_entry;
- $cat_entry = $full_cat_entry[0];
- $val ? $lmodel->set($iter, 1, $unselected, 2, 0) : $lmodel->set($iter, 1, $selected, 2, 1);
- $val ? $files_selected-- : $files_selected++;
- $catalog_entries{$cat_entry . "###" . $s} = 1 - $val;
- $files_selected ? gtkset_sensitive($start_restore, 1) : gtkset_sensitive($start_restore, 0);
- }
- });
- $central_widget = \$file_restore;
-}
-
-sub catalog_restore {
- my ($call_method) = @_;
- my $catalog_box;
- my $cat_entry;
- my @restore_files;
- my $restore_path_entry;
- destroy_widget();
-
- #- catalog info in tree view
- my $model = Gtk2::TreeStore->new("Glib::String");
- my $tree_catalog = Gtk2::TreeView->new_with_model($model);
- $tree_catalog->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
-
- $tree_catalog->set_headers_visible(0);
- $tree_catalog->get_selection->set_mode('single');
-
- # file details in list widget
- my $lmodel = Gtk2::ListStore->new("Glib::String");
- my $tree_files = Gtk2::TreeView->new_with_model($lmodel);
- $tree_files->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
-
- $tree_files->set_headers_visible(0);
- $tree_files->get_selection->set_mode('multiple');
-
- #- read the catalog
- my @catalog = cat_("$cfg_dir/drakbackup_catalog");
-
- foreach (@catalog) {
- chop;
- my @line_data = split(':', $_);
- my $t = $line_data[0];
-
- my $t_catalog = $model->append_set(undef, [ 0 => $t ]);
-
- my $indexer = 0;
- foreach (@line_data) {
- if ($indexer != 0) {
- my $m;
- $m = "Media: " if $indexer == 1;
- $m = "Label or Host: " if $indexer == 2;
- $m = "Device or Path: " if $indexer == 3;
- $m = "Type: Incremental" if $_ eq "I";
- $m = "Type: Differential" if $_ eq "D";
- $m = "Type: Full" if $_ eq "F";
- $m .= $_ if $_ ne "I" && $_ ne "F" && $_ ne "D";
- $model->append_set($t_catalog, [ 0 => $m ]);
- }
- $indexer++;
- }
- }
-
- $tree_catalog->get_selection->signal_connect(changed => sub {
- my ($model, $iter) = $_[0]->get_selected;
- $model && $iter or return;
- $cat_entry = $model->get($iter, 0);
- my $parent_iter = Gtk2::TreeModel::iter_parent($model, $iter);
- if ($parent_iter) {
- $cat_entry = '';
- return;
- }
- gtkset_mousecursor_wait();
- @restore_files = ();
- $lmodel->clear;
- foreach my $filename (glob("$conf{PATH_TO_SAVE}/list*$cat_entry.txt")) {
- my @contents = cat_($filename);
- foreach (@contents) {
- chop;
- my $s = $_;
- $lmodel->append_set(0, $s);
- }
- }
- gtkset_mousecursor_normal();
- my @full_cat_entry = grep { /^$cat_entry/ } @catalog;
- $cat_entry = $full_cat_entry[0];
- });
-
- $tree_files->get_selection->signal_connect(changed => sub {
- my (@what) = $_[0]->get_selected_rows;
- @restore_files = ();
- foreach (@what) {
- my $iter = $lmodel->get_iter($_);
- my $s = $lmodel->get($iter, 0);
- push @restore_files, $s;
- }
- });
-
- gtkpack($advanced_box,
- $catalog_box = gtkpack_(Gtk2::HBox->new(0,10),
- 1, gtkpack_(Gtk2::VBox->new(0,5),
- 0, N("Click date/time to see backup files.\nCtrl-Click files to select multiple files."),
- 1, gtkpack_(Gtk2::VBox->new(0, 10),
- 1, create_scrolled_window($tree_catalog),
- 1, create_scrolled_window($tree_files),
- ),
- 0, gtkpack_(Gtk2::HBox->new(1, 10),
- 1, gtksignal_connect(Gtk2::Button->new(N("Restore Selected\nCatalog Entry")), clicked => sub {
- if ($cat_entry) {
- my $media_check = restore_catalog_entry($cat_entry, ());
- if (! $media_check) {
- destroy_widget();
- interactive_mode_box();
- }
- }
- }),
- 1, gtksignal_connect(Gtk2::Button->new(N("Restore Selected\nFiles")), clicked => sub {
- my $files = @restore_files;
- #- grab the array before the widget clears it
- my @passed_files = @restore_files;
- if ($cat_entry && $files) {
- my $media_check = restore_catalog_entry($cat_entry, @passed_files);
- if (! $media_check) {
- destroy_widget();
- interactive_mode_box();
- }
- }
- }),
- 1, gtkpack_(Gtk2::VBox->new(0, 5),
- 0, Gtk2::Label->new("Restore To Path"),
- 0, $restore_path_entry = Gtk2::Entry->new,
- ),
- 0, gtksignal_connect(my $button = Gtk2::Button->new, clicked => sub {
- filedialog_generic(N("Path To Restore To"), \$restore_path_entry);
- }),
- ),
- 0, Gtk2::VBox->new(0,10),
- ),
- 0, Gtk2::VBox->new(0,10),
- ),
- );
-
- $restore_path_entry->set_text($restore_path);
- gtksignal_connect($restore_path_entry, changed => sub {
- $restore_path = $restore_path_entry->get_text;
- $untar_prefix = "tar -C $restore_path -x";
- });
- $button->add(gtkpack(Gtk2::HBox->new(0,10), gtkcreate_img("ic82-dossier-32")));
- button_box_restore();
- fonction_env(\$catalog_box, \&catalog_restore, \&restore_find_media_box, \&catalog_restore) if $call_method eq "need media";;
- fonction_env(\$catalog_box, \&catalog_restore, \&restore_box, \&catalog_restore) if $call_method eq "button";
- $central_widget = \$catalog_box;
- $up_box->show_all;
-}
-
-sub restore_catalog_entry {
- restore_status();
-
- my ($cat_entry, @restore_files) = @_;
- my $username;
- my $userpass = $conf{PASSWD};
- my $restore_result = 1;
-
- my @line_data = split(':', $cat_entry);
- my $backup_time = $line_data[0];
-
- #- use our own variables here so we don't trash a saved config accidentally
- my $media = $line_data[1];
-
- #- can be a volume name or a host name
- my $vol_host = $line_data[2];
-
- #- see if we have a username embedded in the host
- if (index($vol_host, "@") != -1) {
- my @user_host = split("@", $vol_host);
- $username = $user_host[0];
- $vol_host = $user_host[1];
- } else {
- $username = $conf{LOGIN};
- }
-
- #- create a restore work directory if we don't have one
- -d "$cfg_dir/restores" or mkdir_p "$cfg_dir/restores";
-
- #- can be a device name or a path
- my $dev_path = $line_data[3];
-
- if ($media eq 'HD') {
- #- shouldn't really happen, should have just browsed
- #- to the $conf{PATH_TO_SAVE} in the previous step - deal with it anyway
- my @restore_tar_files = glob("$dev_path/*$backup_time*$conf{OPTION_COMP}");
- my $matches = @restore_tar_files;
- if ($matches == 0) {
- show_warning("f", N("Backup files not found at %s.", $dev_path));
- return 0;
- } else {
- my $save_path_org = $conf{PATH_TO_SAVE};
- $conf{PATH_TO_SAVE} = $dev_path;
- $restore_result = restore_hd_or_cd($cat_entry, $dev_path, @restore_files);
- $conf{PATH_TO_SAVE} = $save_path_org;
- }
- }
-
- if ($media eq 'CD') {
- #- we know the cdrecord device, and the label
- #- prompt the user for the right CD
- $in->ask_okcancel(N("Restore From CD"), N("Insert the CD with volume label %s\n in the CD drive under mount point /mnt/cdrom", $vol_host) ,1) ? ($vol_name = get_cd_volname()) : return 0;
- if ($vol_name ne $vol_host) {
- show_warning("f", N("Not the correct CD label. Disk is labelled %s.", $vol_name));
- return 0;
- } else {
- $restore_result = restore_hd_or_cd($cat_entry, '/mnt/cdrom', @restore_files);
- }
- }
-
- if ($media =~ /^DirectTape|^Tape/) {
- #- a little more complicated, we need to check if other backups
- #- were done on this tape, and try to find the offset to this one
- $in->ask_okcancel(N("Restore From Tape"), N("Insert the tape with volume label %s\n in the tape drive device %s", $vol_host, $dev_path) ,1) ? ($vol_name = get_tape_label($dev_path)) : return 0;
- if ($vol_name ne $vol_host) {
- show_warning("f", N("Not the correct tape label. Tape is labelled %s.", $vol_name));
- return 0;
- } else {
- $restore_result = restore_tape($media, $cat_entry, $dev_path, @restore_files);
- }
- }
-
- if ($media eq 'ftp' || $media eq 'webdav' || $media eq 'ssh' || $media eq 'rsync') {
- #- show the user what we know of the connection from the catalog
- #- and the config file, let them override if necessary
-
- $in->ask_from(N("Restore Via Network"), N("Restore Via Network Protocol: %s", $media),
- [ { label => N("Host Name"), val => \$vol_host },
- { label => N("Host Path or Module"), val => \$dev_path },
- { label => N("Username"), val => \$username },
- { label => N("Password"), val => \$userpass, hidden => 1 },
- ]) or goto return 0;
-
- if ($media eq 'ftp' || $media eq 'rsync') {
- if ($userpass eq '') {
- show_warning("f", N("Password required"));
- return 0;
- }
- }
- if ($media eq 'ftp' || $media eq 'rsync' || $media eq 'ssh') {
- if ($username eq '') {
- show_warning("f", N("Username required"));
- return 0;
- } elsif ($vol_host eq '') {
- show_warning("f", N("Hostname required"));
- return 0;
- }
- }
- if ($dev_path eq '') {
- show_warning("f", N("Path or Module required"));
- return 0;
- }
-
- $restore_result = restore_ftp($cat_entry, $vol_host, $dev_path, $username, $userpass, @restore_files) if $media eq 'ftp';
- $restore_result = restore_rsync_ssh_webdav($cat_entry, $vol_host, $dev_path, $username, $media, @restore_files)
- if $media eq 'rsync' || $media eq 'ssh' || $media eq 'webdav';
- }
-
- # cleanup our restore dir - unlink fails here?
- system("rm -fr $cfg_dir/restores/*");
-
- if (!$restore_result) {
- show_warning("i", N("Files Restored..."));
- return 0;
- } else {
- show_warning("f", N("Restore Failed..."));
- return 1;
- }
-
-}
-
-sub untar {
- my ($cmd, $msg, $tarfile, $restorefile) = @_;
- my $message = "Untarring from \n$tarfile \nto $restore_path.";
- $message = "Untarring \n$restorefile from \n$tarfile \nto $restore_path." if $msg eq "files";
- my $untar_cmd = set_tar($untar_prefix, $tarfile);
- my $command = "$untar_cmd $cmd";
- spawn_progress($command, $message);
-}
-
-sub no_tarfile {
- my ($tarfile) = @_;
- if (!-e "$cfg_dir/restores/$tarfile") {
- show_warning("f", N("%s not retrieved...", $tarfile));
- return 1;
- }
-}
-
-sub restore_hd_or_cd {
- my ($cat_entry, $tarfile_dir, @restore_files) = @_;
- my $indv_files = @restore_files;
- my $wild_card = catalog_to_wildcard($cat_entry);
-
- if ($indv_files == 0) {
- #- full catalog specified
- foreach (wildcard_to_tarfile($wild_card)) {
- untar("$tarfile_dir/$_", "all", $_, undef);
- }
- } else {
- #- individual files - pull from appropriate catalog
- foreach (@restore_files) {
- my ($restorefile, $tarfile) = file_to_tarfile($_, $wild_card);
- untar("$tarfile_dir/$tarfile $restorefile", "files", $tarfile, $restorefile);
- }
- }
- return 0;
-}
-
-sub restore_tape {
- my ($media, $cat_entry, $dev_path, @restore_files) = @_;
- my $indv_files = @restore_files;
- my $wild_card = catalog_to_wildcard($cat_entry);
- $dev_path =~ s|/st|/nst|;
- my $command = "tar -C $restore_path -xf $dev_path";
-
- if ($media eq "DirectTape") {
- position_tape($cat_entry, $dev_path);
- if ($indv_files != 0) {
- foreach (@restore_files) {
- $command .= " " . substr($_, 1);
- }
- }
- spawn_progress($command, "Restoring files from $dev_path to $restore_path.");
- return 0;
- }
-
- if ($indv_files == 0) {
- #- full catalog specified
- foreach (wildcard_to_tarfile($wild_card)) {
- position_tape($cat_entry, $dev_path);
- get_tarfile_from_tape($dev_path);
- return 1 if no_tarfile("$conf{PATH_TO_SAVE}/$_");
- untar("$cfg_dir/restores/$conf{PATH_TO_SAVE}/$_", "all", $_, undef);
- }
- } else {
- #- individual files - pull from appropriate catalog
- foreach (@restore_files) {
- my ($restorefile, $tarfile) = file_to_tarfile($_, $wild_card);
- if (!-e "$cfg_dir/restores/$tarfile") {
- position_tape($cat_entry, $dev_path);
- get_tarfile_from_tape($dev_path);
- }
- return 1 if no_tarfile($tarfile);
- untar("$cfg_dir/restores/$tarfile $restorefile", "files", $tarfile, $restorefile);
- }
- }
- return 0;
-}
-
-sub restore_ftp {
- use Net::FTP;
- my $ftp;
- my ($cat_entry, $hostname, $hostpath, $username, $userpass, @restore_files) = @_;
- my $indv_files = @restore_files;
-
- $DEBUG and print "file list to retrieve: $cat_entry\n ";
- if ($DEBUG && $interactive) { $ftp = Net::FTP->new($hostname, Debug => 1) or return 1 }
- elsif ($interactive) { $ftp = Net::FTP->new($hostname, Debug => 0) or return 1 }
- else { $ftp = Net::FTP->new($hostname, Debug => 0) or return 1 }
- $ftp->login($username, $userpass);
- $ftp->cwd($hostpath);
- $ftp->binary;
-
- my $wild_card = catalog_to_wildcard($cat_entry);
-
- if ($indv_files == 0) {
- #- full catalog specified
- foreach (wildcard_to_tarfile($wild_card)) {
- $ftp->get($_, "$cfg_dir/restores/$_");
- return 1 if no_tarfile($_);
- untar("$cfg_dir/restores/$_", "all", $_, undef);
- }
- } else {
- #- individual files - pull from appropriate catalog
- foreach (@restore_files) {
- my ($restorefile, $tarfile) = file_to_tarfile($_, $wild_card);
- if (!-e "$cfg_dir/restores/$tarfile") {
- $ftp->get($tarfile, "$cfg_dir/restores/$tarfile");
- }
- return 1 if no_tarfile($tarfile);
- untar("$cfg_dir/restores/$tarfile $restorefile", "files", $tarfile, $restorefile);
- }
- }
- $ftp->quit;
- return 0;
-}
-
-sub restore_rsync_ssh_webdav {
- my ($cat_entry, $hostname, $hostpath, $username, $mode, @restore_files) = @_;
- my $indv_files = @restore_files;
- my $wild_card = catalog_to_wildcard($cat_entry);
- if ($indv_files == 0) {
- #- full catalog specified
- foreach (wildcard_to_tarfile($wild_card)) {
- get_file_from_net($mode, $_, $hostname, $hostpath, $username);
- return 1 if no_tarfile($_);
- untar("$cfg_dir/restores/$_", "all", $_, undef);
- }
- } else {
- #- individual files - pull from appropriate catalog
- foreach (@restore_files) {
- my ($restorefile, $tarfile) = file_to_tarfile($_, $wild_card);
- get_file_from_net($mode, $tarfile, $hostname, $hostpath, $username) if !-e "$cfg_dir/restores/$tarfile";
- return 1 if no_tarfile($tarfile);
- untar("$cfg_dir/restores/$tarfile $restorefile", "files", $tarfile, $restorefile);
- }
- }
- return 0;
-}
-
-sub get_file_from_net {
- my ($mode, $tarfile, $hostname, $hostpath, $username) = @_;
- my $command;
- if ($mode eq 'ssh') {
- $command = "scp $username\@$hostname:$hostpath/$tarfile $cfg_dir/restores/";
- } elsif ($mode eq 'rsync') {
- $command = "rsync --password-file=$cfg_dir/rsync.user $username\@$hostname" . "::" . "$hostpath/$tarfile $cfg_dir/restores/";
- } else {
- $command = "wget http://$hostname/$hostpath/$tarfile -P $cfg_dir/restores/";
- }
- spawn_progress($command, "Retrieving backup file \n$tarfile \nvia $mode.");
-}
-
-sub catalog_to_wildcard {
- my ($cat_entry) = @_;
- my @line_data = split(':', $cat_entry);
- my $wildcard = $line_data[0];
- $wildcard;
-}
-
-sub wildcard_to_tarfile {
- my ($wildcard) = @_;
- my (@tarfile) = glob("$conf{PATH_TO_SAVE}/*$wildcard.txt");
- foreach (@tarfile) {
- $_ = basename($_);
- s/txt/$conf{OPTION_COMP}/;
- s/list/backup/;
- }
- @tarfile;
-}
-
-sub file_to_tarfile {
- my ($restore_file, $wildcard) = @_;
- #- remove leading "/"
- $restore_file = substr($restore_file, 1);
- #- filename with spaces
- $restore_file = "'" . $restore_file . "'" if $restore_file =~ / /;
- my $tarfile = `grep -l $restore_file $conf{PATH_TO_SAVE}/*$wildcard.txt`;
- chop $tarfile;
- $tarfile = basename($tarfile);
- $tarfile =~ s/txt/$conf{OPTION_COMP}/;
- $tarfile =~ s/list/backup/;
- $restore_file, $tarfile;
-}
-
-sub find_tape_offset {
- my ($cat_entry) = @_;
- my @line_data = split(':', $cat_entry);
- my $label = $line_data[2];
- my @catalog = cat_("$cfg_dir/drakbackup_catalog");
- # always off by 1 for tape label.
- my $offset = 1;
- foreach (@catalog) {
- if (index($_, $label)) {
- if (!index($_, $cat_entry)) {
- # tar seems to need 2 of these to get located
- $offset++;
- $offset++;
- } else {
- return $offset;
- }
- }
- }
-}
-
-sub position_tape {
- my ($cat_entry, $dev_path) = @_;
- my $offset = find_tape_offset($cat_entry);
- spawn_progress("mt -f $dev_path rewind", "Rewinding tape on $dev_path.");
- spawn_progress("mt -f $dev_path fsf $offset", "Moving forward $offset file records.");
-}
-
-sub get_tarfile_from_tape {
- my ($dev_path) = @_;
- spawn_progress("tar -C $cfg_dir/restores -xf $dev_path", "Untarring from $dev_path to work directory.");
-}
-
-sub restore_box() {
- destroy_widget();
-
- if ($good_restore_path) {
- $path_to_find_restore = $conf{PATH_TO_SAVE} if $conf{USE_HD};
- $path_to_find_restore = "/mnt/cdrom" if $conf{USE_CD};
- }
-
- find_backup_to_restore();
- button_box_restore_main();
-
- if (@other_backuped || @sys_backuped || @user_backuped) {
- gtkpack($advanced_box,
- $box2 = gtkpack_(Gtk2::HBox->new(0,1),
- 1, Gtk2::VBox->new(0,10),
- 1, gtkpack_(Gtk2::VBox->new(0,10),
- 1, Gtk2::VBox->new(0,10),
- 1, Gtk2::VBox->new(0,10),
- 1, gtksignal_connect(Gtk2::Button->new(N("Search for files to restore")), clicked => sub {
- button_box_file_restore();
- find_files_to_restore()
- }),
- 1, gtksignal_connect(Gtk2::Button->new(N("Restore all backups")), clicked => sub {
- button_box_restore();
- @user_list_to_restore2 = sort @user_backuped;
- $restore_sys = 1;
- $restore_other = 1;
- $restore_user = 1;
- restore_do()
- }),
- 1, gtksignal_connect(Gtk2::Button->new(N("Custom Restore")), clicked => sub {
- button_box_restore();
- restore_step2();
- }),
- 1, gtksignal_connect(Gtk2::Button->new(N("Restore From Catalog")), clicked => sub {
- catalog_restore("button");
- }),
- 1, Gtk2::VBox->new(0,10),
- 1, Gtk2::VBox->new(0,10),
- ),
- 1, Gtk2::HBox->new(0,10),
- ),
- );
- } else {
- destroy_widget();
- restore_find_media_box(),
- }
- fonction_env(\$box2, \&restore_box, \&interactive_mode_box);
- $central_widget = \$box2;
- $up_box->show_all;
-}
-
-sub restore_find_media_box() {
- my $mount_media = 1;
- $good_restore_path = 0;
- my $message = N("Unable to find backups to restore...\n");
- $message .= N("Verify that %s is the correct path", $path_to_find_restore) if $conf{USE_HD} && $conf{USE_CD};
- $message .= N(" and the CD is in the drive") if $conf{USE_CD};
- if ($conf{USE_TAPE} || $conf{NET_PROTO}) {
- $message .= N("Backups on unmountable media - Use Catalog to restore");
- $mount_media = 0;
- }
- $message .= ".";
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(Gtk2::VBox->new(0, 5),
- 1, gtkpack(Gtk2::HBox->new(0, 15),
- Gtk2::VBox->new(0, 5),
- gtkcreate_img('warning'),
- translate($message),
- Gtk2::VBox->new(0, 5),
- ),
- 1, gtkpack(Gtk2::HBox->new(0, 15),
- Gtk2::VBox->new(0, 5),
- gtkpack(Gtk2::VBox->new(0, 10),
- gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("CD in place - continue.")), clicked => sub {
- $good_restore_path = 1;
- interactive_mode_box("restore");
- }), $mount_media),
- $new_path_entry = gtkset_sensitive(Gtk2::Entry->new, $mount_media),
- gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("Browse to new restore repository.")), clicked => sub {
- filedialog_generic(N("Directory To Restore From"), \$new_path_entry);
- }), $mount_media),
- gtksignal_connect(Gtk2::Button->new(N("Restore From Catalog")), clicked => sub {
- $box2->destroy;
- catalog_restore("need media");
- }),
- gtksignal_connect(Gtk2::Button->new(N("Search for files to restore")), clicked => sub {
- $box2->destroy;
- button_box_file_restore();
- find_files_to_restore()
- }),
- ),
- Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
- $new_path_entry->set_text($path_to_find_restore);
- $new_path_entry->signal_connect('changed', sub { $path_to_find_restore = $new_path_entry->get_text });
- $central_widget = \$box2;
- button_box_find_media($mount_media);
- $up_box->show_all;
-}
-
-sub restore_status() {
- destroy_widget();
- $pbar3 = Gtk2::ProgressBar->new;
- $stext = Gtk2::Label->new("");
- gtkpack($advanced_box,
- $table = gtkpack(Gtk2::VBox->new(0, 5),
- Gtk2::HBox->new(0,5),
- create_packtable({ col_spacings => 10, row_spacings => 5 },
- [""],
- [""],
- [""],
- [""],
- [N("Restore Progress")],
- [""],
- [""],
- [$pbar3],
- [""],
- [""],
- [$plabel3 = Gtk2::Label->new(' ')],
- [""],
- ),
- $stext,
- ),
- );
- $central_widget = \$table;
- $up_box->show_all;
- gtkflush();
-}
-
-################################################ BUTTON_BOX ################################################
-
-sub hbutton() {
- 0, gtksignal_connect(Gtk2::Button->new(N("Help")), clicked => \&adv_help);
-}
-
-sub cbutton() {
- 0, gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => \&interactive_mode_box);
-}
-
-sub cbuttonr() {
- 0, gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => \&restore_box);
-}
-
-sub ibutton {
- my ($msg) = @_;
- 0, gtksignal_connect(Gtk2::Button->new($msg), clicked => \&interactive_mode_box);
-}
-
-sub pbutton() {
- 0, gtksignal_connect(Gtk2::Button->new(N("Previous")), clicked => sub {
- destroy_widget();
- $previous_widget->();
- });
-}
-
-sub hspace() {
- 1, Gtk2::HBox->new(0, 1);
-}
-
-sub button_box_adv() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- cbutton(),
- hbutton(),
- hspace(),
- pbutton(),
- 0, gtksignal_connect(Gtk2::Button->new(N("Save")), clicked => sub {
- if (check_pkg_needs()) {
- install_rpm(\&$current_widget, undef);
- } else {
- if (!save_conf_file()) {
- destroy_widget();
- $previous_widget->();
- }
- }
- }),
- ),
- );
-}
-
-sub button_box_restore_main() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- cbutton(),
- hbutton(),
- hspace(),
- ibutton(N("Previous")),
- ibutton(N("Next")),
- ),
- );
-}
-
-sub button_box_file_restore() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- 0, gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => \&restore_box),
- hbutton(),
- hspace(),
- ),
- );
-}
-
-sub button_box_ok_only() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- hspace(),
- ibutton(N("Ok")),
- ),
- );
-}
-
-sub button_box_backup_end() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- cbutton(),
- hbutton(),
- hspace(),
- pbutton(),
- 0, gtksignal_connect(Gtk2::Button->new(N("Build Backup")), clicked => sub {
- destroy_widget();
- build_backup_status();
- build_backup_files();
- }),
- ),
- );
-}
-
-sub button_box_wizard_end() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- cbutton(),
- hbutton(),
- hspace(),
- pbutton(),
- 0, gtksignal_connect(Gtk2::Button->new(N("Save")), clicked => sub {
- save_conf_file();
- interactive_mode_box();
- }),
- ),
- );
-}
-
-sub button_box_restore_end() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- cbuttonr(),
- hbutton(),
- hspace(),
- pbutton(),
- 0, gtksignal_connect(Gtk2::Button->new(N("Restore")), clicked => sub {
- destroy_widget();
- restore_backend();
- }),
- ),
- );
-}
-
-sub button_box_restore_pbs_end() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- hspace(),
- hbutton(),
- ibutton(N("Ok")),
- ),
- );
-}
-
-sub button_box_restore() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- cbuttonr(),
- hbutton(),
- hspace(),
- pbutton(),
- 0, gtksignal_connect(Gtk2::Button->new(N("Next")), clicked => sub {
- destroy_widget();
- $next_widget->();
- }),
- ),
- );
-}
-
-sub button_box_find_media {
- my ($mount_media) = @_;
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- cbutton(),
- hbutton(),
- hspace(),
- ibutton(N("Previous")),
- 0, gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("Next")), clicked => sub {
- interactive_mode_box("restore");
- }), $mount_media),
- ),
- );
-}
-
-sub button_box_wizard() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- cbutton(),
- hbutton(),
- hspace(),
- 0, gtksignal_connect(Gtk2::Button->new($previous_widget ? N("Previous") : N("Ok")), clicked => sub {
- destroy_widget();
- $previous_widget ? $previous_widget->() : $next_widget->();
- }),
- if_($next_widget, 0, gtksignal_connect(Gtk2::Button->new(N("Next")), clicked => sub {
- destroy_widget();
- $next_widget ? $next_widget->() : $previous_widget->();
- })),
- ),
- );
-}
-
-sub button_box_main() {
- $button_box_tmp->destroy;
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(Gtk2::HButtonBox->new,
- hbutton(),
- hspace(),
- 0, gtksignal_connect(Gtk2::Button->new(N("Close")), clicked => sub { ugtk2->exit(0) }),
- ),
- );
-}
-
-################################################ MESSAGES ################################################
-
-sub install_rpm {
- my ($calling_widget, $previous) = @_;
- destroy_widget();
- gtkpack($advanced_box,
- my $rpm_box = gtkpack_(Gtk2::VBox->new(0, 15),
- 0, N("The following packages need to be installed:\n") . join(' ', @list_of_rpm_to_install),
- 0, Gtk2::HSeparator->new,
- 0, gtksignal_connect(Gtk2::Button->new(N("Install")), clicked => sub {
- my $installed = system("/usr/sbin/urpmi --X @list_of_rpm_to_install");
- if ($installed == 0) {
- destroy_widget();
- $calling_widget->($previous);
- } else {
- #- no string for the moment - too late for translators
- $in->ask_warn(N("Error"), @list_of_rpm_to_install);
- }
- }),
- ),
- );
- $central_widget = \$rpm_box;
- $up_box->show_all;
-}
-
-sub message_norestore_box() {
- $box2->destroy;
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtkpack(Gtk2::HBox->new(0, 15),
- Gtk2::VBox->new(0, 5),
- gtkcreate_img('warning'),
- N("Please select data to restore..."),
- Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
- button_box_restore_main();
- $central_widget = \$box2;
- $up_box->show_all;
-}
-
-################################################ BUILD_BACKUP ################################################
-
-sub progress {
- my ($progressbar, $plabel, $incr, $label_text) = @_;
- my ($new_val) = $progressbar->get_fraction;
- $new_val += $incr;
- if ($new_val > 1) { $new_val = 1 }
- $progressbar->set_fraction($new_val);
- $plabel->set_text($label_text);
- gtkflush();
-}
-
-sub build_backup_status() {
- $pbar = Gtk2::ProgressBar->new;
- $pbar1 = Gtk2::ProgressBar->new;
- $pbar2 = Gtk2::ProgressBar->new;
- $pbar3 = Gtk2::ProgressBar->new;
- $plabel = Gtk2::Label->new(" ");
- $plabel1 = Gtk2::Label->new(" ");
- $plabel2 = Gtk2::Label->new(" ");
- $plabel3 = Gtk2::Label->new(" ");
-
- $stext = Gtk2::Label->new("");
- button_box_ok_only();
-
- my $table = Gtk2::Table->new(10, 2, 1);
- $table->set_row_spacings(5);
- $table->set_col_spacings(10);
-
- $table->attach_defaults(Gtk2::Label->new(N("Backup system files")), 0, 1, 0, 1);
- $table->attach_defaults($pbar, 0, 1, 1, 2);
- $table->attach_defaults($plabel, 1, 2, 1, 2);
- $table->attach_defaults(Gtk2::Label->new(N("Backup user files")), 0, 1, 2, 3);
- $table->attach_defaults($pbar1, 0, 1, 3, 4);
- $table->attach_defaults($plabel1, 1, 2, 3, 4);
- $table->attach_defaults(Gtk2::Label->new(N("Backup other files")), 0, 1, 4, 5);
- $table->attach_defaults($pbar2, 0, 1, 5, 6);
- $table->attach_defaults($plabel2, 1, 2, 5, 6);
- $table->attach_defaults(Gtk2::Label->new(N("Total Progress")), 0, 1, 6, 7);
- $table->attach_defaults($pbar3, 0, 1, 7, 8);
- $table->attach_defaults($plabel3, 1, 2, 7, 8);
-
- gtkpack($advanced_box,
- my $tbox = gtkpack(Gtk2::VBox->new(0, 5),
- $table,
- $stext,
- ),
- );
-
- $central_widget = \$tbox;
- $up_box->show_all;
- gtkflush();
-}
-
-sub build_backup_ftp_status() {
- $pbar = Gtk2::ProgressBar->new;
- $pbar3 = Gtk2::ProgressBar->new;
- destroy_widget();
- button_box_ok_only();
- $pbar->set_fraction(0);
- $pbar3->set_fraction(0);
-
- gtkpack($advanced_box,
- $table = gtkpack_(Gtk2::VBox->new(0, 15),
- 1, N("Sending files by FTP"),
- 1, Gtk2::VBox->new(0, 15),
- 1, create_packtable ({ col_spacings => 10, row_spacings => 5 },
- [N("Sending files...")],
- [""],
- [ $plabel = Gtk2::Label->new(' ') ],
- [ $pbar ],
- [""],
- [N("Total Progress")],
- [ $plabel3 = Gtk2::Label->new(' ') ],
- [$pbar3],
- ),
- 1, Gtk2::VBox->new(0, 15),
- ),
- );
- $central_widget = \$table;
- $up_box->show_all;
- gtkflush();
-}
-
-sub build_backup_box_see_conf {
- my ($caller) = @_;
- my $text = Gtk2::TextView->new;
- read_conf_file();
- system_state();
- gtktext_insert($text, [ [ $system_state ] ]);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, gtkpack_(Gtk2::VBox->new(0,10),
- 0, N("Drakbackup Configuration"),
- 1, create_scrolled_window($text),
- ),
- ),
- );
- button_box_backup_end();
- $central_widget = \$box2;
- $current_widget = \&build_backup_box_see_conf;
- if ($caller eq "interactive") {
- $previous_widget = \&interactive_mode_box;
- } else {
- $previous_widget = \&build_backup_box;
- }
- $up_box->show_all;
-}
-
-sub build_backup_box() {
- destroy_widget();
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtkpack_(Gtk2::VBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtksignal_connect(my $button_from_conf_file = Gtk2::Button->new, clicked => sub {
- destroy_widget();
- build_backup_status();
- build_backup_files();
- }),
- 0, Gtk2::VBox->new(0, 5),
- 1, gtksignal_connect(my $button_see_conf = Gtk2::Button->new, clicked => sub {
- destroy_widget();
- build_backup_box_see_conf(undef);
- }),
- 1, Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
-
- $button_from_conf_file->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-discdurwhat-40"),
- Gtk2::Label->new(N("Backup Now from configuration file")),
- Gtk2::HBox->new(0, 5)
- ));
- $button_see_conf->add(gtkpack(Gtk2::HBox->new(0,10),
- gtkcreate_img("ic82-moreoption-40"),
- Gtk2::Label->new(N("View Backup Configuration.")),
- Gtk2::HBox->new(0, 5)
- ));
-
- button_box_restore_main();
- fonction_env(\$box2, \&build_backup_box, \&interactive_mode_box);
- $up_box->show_all;
-}
-
-################################################ INTERACTIVE ################################################
-
-sub interactive_mode_box {
-
- my ($o_mode) = @_;
- if ($o_mode eq "restore") {
- $central_widget = \$box2;
- restore_box();
- return 0;
- }
-
- destroy_widget();
- gtkadd($advanced_box,
- $box2 = gtkpack_(Gtk2::HBox->new(0, 15),
- 1, Gtk2::VBox->new(0, 5),
- 1, gtkpack_(Gtk2::VBox->new(0, 5),
- 1, Gtk2::VBox->new(0, 5),
- 0, gtksignal_connect(Gtk2::Button->new(N("Wizard Configuration")), clicked => sub {
- destroy_widget();
- read_conf_file();
- wizard();
- }),
- 0, gtksignal_connect(Gtk2::Button->new(N("Advanced Configuration")), clicked => sub {
- button_box_adv();
- destroy_widget();
- advanced_box();
- }),
- 0, gtksignal_connect(Gtk2::Button->new(N("View Configuration")), clicked => sub {
- destroy_widget();
- build_backup_box_see_conf("interactive");
- }),
- 0, gtksignal_connect(Gtk2::Button->new(N("View Last Log")), clicked => sub {
- $results = cat_($log_file);
- button_box_ok_only();
- show_status();
- }),
- 0, gtksignal_connect(Gtk2::Button->new(N("Backup Now")), clicked => sub {
- if ($cfg_file_exist) {
- build_backup_box();
- } else {
- $in->ask_warn(N("Error"), N("No configuration file found \nplease click Wizard or Advanced."));
- }
- }),
- 0, gtksignal_connect(Gtk2::Button->new(N("Restore")), clicked => sub {
- restore_box();
- }),
- 1, Gtk2::VBox->new(0, 5),
- ),
- 1, Gtk2::VBox->new(0, 5),
- ),
- );
- $central_widget = \$box2;
- button_box_main();
- $up_box->show_all;
-}
-
-sub interactive_mode() {
- $interactive = 1;
-
- $in = 'interactive'->vnew;
- $::Wizard_title = N("Drakbackup");
- $::Wizard_pix_up = "ic82-back-up-48.png";
- $in->isa('interactive::gtk') and $::isWizard = 1;
- $my_win = ugtk2->new(N("Drakbackup"));
- $window1 = $my_win->{window};
-
- $my_win->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) });
- read_conf_file();
-
- gtkadd($window1,
- gtkpack(Gtk2::VBox->new(0,0),
- gtkpack($up_box = Gtk2::VBox->new(0, 5),
- gtkpack_(Gtk2::VBox->new(0, 3),
- 1, gtkpack_(Gtk2::HBox->new(0, 3),
- 1, $advanced_box = Gtk2::HBox->new(0, 15),
- ),
- 0, Gtk2::HSeparator->new,
- 0, $button_box = gtkpack(Gtk2::VBox->new(0, 15),
- $button_box_tmp = gtkpack(Gtk2::VBox->new(0, 0),),
- ),
- ),
- ),
- ),
- );
- setup_tooltips();
- interactive_mode_box();
- button_box_main();
- $central_widget = \$box2;
- $window1->realize;
- $window1->show_all;
- $my_win->main;
- $my_win->exit(0);
-}
-
-sub adv_help() {
- exec("drakhelp --id drakbackup") unless fork();
-}
-
-sub destroy_widget() {
- if ($central_widget ne '') {
- $$central_widget->destroy;
- $central_widget = '';
- }
-}
diff --git a/perl-install/standalone/drakboot b/perl-install/standalone/drakboot
deleted file mode 100755
index 5babbda57..000000000
--- a/perl-install/standalone/drakboot
+++ /dev/null
@@ -1,334 +0,0 @@
-#!/usr/bin/perl
-
-# DrakBoot
-# $Id$
-# Copyright (C) 2001-2004 Mandrakesoft
-# Yves Duret, Thierry Vignaud
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use strict;
-use diagnostics;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use c;
-use common;
-use interactive;
-use any;
-use bootloader;
-use detect_devices;
-use fsedit;
-use fs;
-use Config;
-use POSIX;
-use Xconfig::various;
-use log;
-
-my $splash_working = any { /^--splash$/ } @ARGV;
-
-my $in = 'interactive'->vnew('su');
-
-my $all_hds = fsedit::get_hds();
-fs::get_raw_hds('', $all_hds);
-fs::get_info_from_fstab($all_hds);
-my $fstab = [ fs::get::fstab($all_hds) ];
-my $bootloader = bootloader::read($all_hds);
-
-if (!$in->isa('interactive::gtk') || any { /^--boot$/ } @ARGV) {
- $::isWizard = 1;
- lilo_choice();
- $in->exit(0);
-}
-require ugtk2;
-ugtk2->import(qw(:helpers :wrappers :create));
-
-my $no_bootsplash;
-my $x_mode = Xconfig::various::runlevel() == 5;
-my $auto_mode = any::get_autologin();
-my $switch_theme = '/usr/share/bootsplash/scripts/switch-themes';
-my $remove_theme = '/usr/share/bootsplash/scripts/remove-theme';
-
-my $w = ugtk2->new($splash_working ? N("Graphical boot theme selection") : N("System mode"));
-my $window = $w->{window};
-$::main_window = $w->{rwindow} if !$::isEmbedded;
-
-$window->signal_connect(delete_event => sub { ugtk2->exit(0) });
-unless ($::isEmbedded) {
- $window->set_border_width(2);
-
- ### menus definition
- # the menus are not shown but they provides shiny shortcut like C-q
- my @menu_items = ([ N("/_File"), undef, undef, undef, '<Branch>' ],
- [ N("/File/_Quit"), N("<control>Q"), sub { ugtk2->exit(0) }, undef, '<Item>' ],
- );
- create_factory_menu($w->{rwindow}, @menu_items);
- ######### menus end
-}
-
-my @users = sort(list_users());
-my @sessions = sort(split(' ', `/usr/sbin/chksession -l`));
-
-my $user = member($auto_mode->{autologin}, @users) ? $auto_mode->{autologin} : $users[0];
-if (!$user) {
- # no user, bad but add root anyway:
- $user = "root";
- push @users, $user;
-}
-my $user_combo = Gtk2::ComboBox->new_with_strings(\@users, $user);
-my $desktop_combo = Gtk2::ComboBox->new_with_strings(\@sessions, if_(member($auto_mode->{desktop}, @sessions), $auto_mode->{desktop}));
-
-my %themes = ('path' => '/usr/share/bootsplash/themes/',
- 'sysconfig' => '/etc/sysconfig/bootsplash',
- 'default' => 'Mandrakelinux',
- 'def_thmb' => '/usr/share/libDrakX/pixmaps/nosplash_thumb.png',
- 'lilo' => {'file' => '/lilo/message',
- 'thumb' => '/lilo/thumb.png' },
- 'boot' => {'path' => '/images/',
- #'thumb'=>'/images/thumb.png',
- },
- );
-my $kernel_release = `uname -r`;
-chomp $kernel_release;
-
-require Xconfig::resolution_and_depth;
-my $cur_res;
-if (my $x_res = Xconfig::resolution_and_depth::from_bios($bootloader->{default_vga})) {
- $cur_res = $x_res->{X} . 'x' . $x_res->{Y};
-} else {
- $no_bootsplash = 1; #- we can't select any theme we're not in Framebuffer mode :-/
- $cur_res = '800x600'
-}
-
-$no_bootsplash = 0 if $::testing;
-
-my $splash_mode = !$no_bootsplash;
-my $keep_logo = 1;
-
-if (-r $themes{sysconfig}) {
- local $_;
- foreach (cat_($themes{sysconfig})) {
- /^SPLASH=no/ and $splash_mode = 0;
- /^THEME=(.*)/ and -f "$themes{path}$1$themes{boot}{path}bootsplash-$cur_res.jpg" and $themes{default} = $1;
- /^LOGO_CONSOLE=(.*)/ and $keep_logo = $1 ne 'no';
- }
-}
-
-my @boot_thms;
-chdir($themes{path}); #- we must change directory for correct @boot_thms assignement
-foreach (sort(all('.'))) {
- if (-d "$themes{path}$_" && m/^[^.]/) {
- -f "$themes{path}$_$themes{boot}{path}bootsplash-$cur_res.jpg" and push @boot_thms, $_;
- }
-}
-push @boot_thms, $themes{default} unless member($themes{default}, @boot_thms);
-
-my %combo = ('thms' => '', 'lilo' => '');
-foreach (keys(%combo)) {
- $combo{$_} = gtkset_size_request(Gtk2::ComboBox->new_text, 10, -1);
-}
-
-$combo{boot} = gtkset_size_request(Gtk2::ComboBox->new_with_strings(\@boot_thms, $themes{default}), 10, -1);;
-
-my $boot_pic = gtkcreate_img($themes{def_thmb});
-change_image($boot_pic, $themes{default});
-
-my $_thm_button = Gtk2::Button->new(N("Install themes"));
-my $_B_create = gtksignal_connect(Gtk2::Button->new(N("Create new theme")), clicked => sub { system('/usr/sbin/draksplash ') });
-
-#- ******** action to take on changing combos values
-
-$combo{boot}->entry->signal_connect(changed => sub { change_image($boot_pic, $combo{boot}->entry->get_text) });
-
-my ($x_box, $splash_box);
-my $boot_warn = 1;
-gtkadd($window,
- gtkpack_(Gtk2::VBox->new(0,0),
- ($splash_working ?
- (1, gtkpack_(gtkset_border_width(Gtk2::VBox->new(0, 5), 5),
- 0, gtksignal_connect(gtkset_active(Gtk2::CheckButton->new(N("Use graphical boot")), $splash_mode),
- clicked => sub {
- $splash_mode = !$splash_mode;
- if ($boot_warn && $no_bootsplash && $splash_mode) {
- if ($in->ask_yesorno(N("Warning"),
- [ N("Your system bootloader is not in framebuffer mode. To activate graphical boot, select a graphic video mode from the bootloader configuration tool.") . "\n" .
- N("Do you want to configure it now?") ])) {
- enable_framebuffer();
- #- it would be nice to get available themes for new cur_res here
- };
- $boot_warn = 0
- }
- $splash_box->set_sensitive($splash_mode);
- }),
- 1, gtkpack(gtkset_sensitive($splash_box = Gtk2::HBox->new(0, 0), $splash_mode),
- gtkpack__(Gtk2::VBox->new(0, 5),
- N("Theme"),
- $combo{boot},
- #gtksignal_connect(Gtk2::CheckButton->new(N("Display theme\nunder console")), clicked => sub { invbool(\$keep_logo) }),
- gtksignal_connect(gtkset_active(Gtk2::CheckButton->new(N("Display theme\nunder console")), $keep_logo), clicked => sub { invbool(\$keep_logo) })
- ),
- Gtk2::VSeparator->new,
- gtkpack__(Gtk2::VBox->new(0, 5),
- $boot_pic))
- ),
- )
- :
- (1, gtkpack__(Gtk2::VBox->new(0, 5),
- gtksignal_connect(gtkset_active(Gtk2::CheckButton->new(N("Launch the graphical environment when your system starts")),
- $x_mode),
- clicked => sub {
- $x_box->set_sensitive(!$x_mode);
- $x_mode = !$x_mode;
- }),
- gtkpack__(gtkset_sensitive($x_box = Gtk2::VBox->new(0, 0), $x_mode),
- gtkpack__(Gtk2::VBox->new(0, 0),
- my @auto_buttons = gtkradio((N("No, I don't want autologin")) x 2,
- N("Yes, I want autologin with this (user, desktop)")),
- ),
- my $auto_box = create_packtable({ col_spacings => 5, row_spacings => 5, homogenous => 1 },
- [ Gtk2::Label->new(N("Default user")), $user_combo ],
- [ Gtk2::Label->new(N("Default desktop")), $desktop_combo ],
- ),
- )
- )
- ),
- 0, create_okcancel({
- cancel_clicked => sub { ugtk2->exit(0) },
- ok_clicked => sub {
- Xconfig::various::runlevel($x_mode ? 5 : 3);
- if ($splash_working) {
- update_bootsplash($combo{boot}->entry->get_text, $splash_mode, $keep_logo);
- } else {
- updateAutologin();
- }
- ugtk2->exit(0);
- }
- },
- ),
-
- )
- )
- );
-
-if (!$splash_working) {
- $auto_buttons[1]->signal_connect('toggled' => sub { $auto_box->set_sensitive($auto_buttons[1]->get_active) });
- $auto_buttons[0]->signal_connect('toggled' => sub { $auto_box->set_sensitive(!$auto_buttons[0]->get_active) });
- $auto_buttons[1]->set_active(1) if $auto_mode->{autologin};
- $auto_buttons[0]->set_active(1) if !$auto_mode->{autologin};
- $x_box->set_sensitive($x_mode);
- $auto_box->set_sensitive($auto_mode->{autologin} ? 1 : 0);
-}
-
-$window->show_all;
-gtkflush();
-$w->main;
-$in->exit(0);
-
-
-sub lilo_choice() {
- ask:
- my $before = fs::fstab_to_string($all_hds);
- any::setupBootloader($in, $bootloader, $all_hds, $fstab, $ENV{SECURE_LEVEL}) or $in->exit;
- if ($before ne fs::fstab_to_string($all_hds)) {
- #- for /tmp using tmpfs when "clean /tmp" is chosen
- fs::write_fstab($all_hds);
- }
- any::installBootloader($in, $bootloader, $all_hds) or goto ask;
-}
-
-
-
-#-------------------------------------------------------------
-# launch autologin functions
-#-------------------------------------------------------------
-
-sub updateAutologin() {
- my ($usern, $deskt) = ($user_combo->entry->get_text, $desktop_combo->entry->get_text);
- $::testing and return;
- if ($auto_buttons[1]->get_active) {
- any::set_autologin($usern, $deskt);
- } else {
- any::set_autologin();
- }
-}
-
-sub update_bootsplash {
- my ($theme, $splash_mode, $keep_logo) = @_;
- #- theme scripts will update SPLASH value in sysconfig file
- if (-x $switch_theme) {
- my $logo_console = $keep_logo ? 'theme' : 'no';
- if ($::testing) {
- if ($splash_mode) {
- print "substInFile { s/^LOGO_CONSOLE=.*/LOGO_CONSOLE=$logo_console/ } $themes{sysconfig}\n";
- print "system($switch_theme, $theme)\n";
- } else {
- print "system($remove_theme)\n";
- }
- } else {
- if ($splash_mode) {
- substInFile { s/^LOGO_CONSOLE=.*/LOGO_CONSOLE=$logo_console/ } $themes{sysconfig};
- system($switch_theme, $theme);
- } else {
- system($remove_theme);
- }
- }
- }
-}
-
-sub change_image {
- my ($boot_pic, $val) = @_;
- my $img_file = $themes{path} . $val . $themes{boot}{path} . "bootsplash-$cur_res.jpg";
- -f $img_file or return;
- my $boot_pixbuf = gtkcreate_pixbuf($img_file);
- $boot_pixbuf = $boot_pixbuf->scale_simple(300, 200, 'nearest');
- $boot_pic->set_from_pixbuf($boot_pixbuf);
-}
-sub enable_framebuffer() {
- my $vga = Xconfig::resolution_and_depth::from_bios($bootloader->{default_vga});
- my ($current_entry) = cat_('/proc/cmdline') =~ /^BOOT_IMAGE=(\S+)/;
- my %entries = (
- $current_entry => 1
- );
- local $::isWizard = 1;
- local $::Wizard_no_previous = 1;
- local $::Wizard_finished = 1;
- $::Wizard_title = N("Boot Style Configuration");
- eval {
- $in->ask_from(N("Video mode"),
- N("Please choose a video mode, it will be applied to each of the boot entries selected below.
-Be sure your video card supports the mode you choose."),
- [
- { label => N("Video mode"), val => \$vga,
- list => [ '', Xconfig::resolution_and_depth::bios_vga_modes() ],
- format => \&Xconfig::resolution_and_depth::to_string
- },
- map {
- { text => $_->{label}, val => \$entries{$_->{label}}, type => 'bool' }
- } grep { $_->{label} !~ /failsafe|floppy|memtest/ } @{$bootloader->{entries}}
- ]);
- if ($vga) {
- $vga = $vga->{bios} if ref($vga);
- while (my ($label, $e) = each %entries) {
- $e or next;
- my $entry = find { $_->{label} eq $label } @{$bootloader->{entries}};
- $entry->{vga} = $vga;
- }
- bootloader::install($bootloader, $all_hds);
- }
- };
- die if $@ && $@ !~ /^wizcancel/;
- $::WizardWindow->destroy unless $::isEmbedded;
- $vga;
-}
diff --git a/perl-install/standalone/drakbug b/perl-install/standalone/drakbug
deleted file mode 100755
index 8641e6e38..000000000
--- a/perl-install/standalone/drakbug
+++ /dev/null
@@ -1,296 +0,0 @@
-#!/usr/bin/perl
-
-# Drak Bug Report
-# Copyright (C) 2002-2004 Mandrakesoft (daouda at mandrakesoft dot com)
-# Stew Benedict (sbenedict at mandrakesoft dot com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use strict;
-use diagnostics;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone;
-use common;
-use ugtk2 qw(:all);
-use Config;
-
-my ($bugzilla, $wizard_name);
-my $prog;
-my ($incident, $stable_release) = (0, 0);
-my ($bugdesc, $bugwrite, $table, $comb_app, $button_pkg, $package, $extra_data, $summary, $textview, $kversion, $cpuinfo, $lspci);
-
-foreach (@ARGV) {
- next unless defined $_;
- /^--report$/ && shift @ARGV and $prog = shift @ARGV;
- /^--incident$/ && shift @ARGV and do { $incident = 1; $prog = shift @ARGV };
-}
-
-my $window = ugtk2->new(N("Mandrakelinux Bug Report Tool"), center => 1);
-$window->{rwindow}->set_border_width(5);
-$window->{window}->signal_connect("delete_event", sub { ugtk2->exit(0) });
-
-my $mdk_app = {
- N("Mandrakelinux Control Center") => 'drakconf',
- N("First Time Wizard") => 'drakfw',
- N("Synchronization tool") => 'draksync',
- N("Standalone Tools") => ['adduserdrake', 'diskdrake', 'drakautoinst', 'drakbackup', 'drakboot', 'DrakBug', 'DrakClock', 'DrakConnect', 'drakfloppy', 'drakfirewall', 'drakfont', 'drakgw', 'DrakSec', 'draksplash', 'drakvpn', 'drakxservices', 'drakxtools', 'drakxtv', 'keyboardrake', 'logdrake', 'mousedrake', 'net_monitor', 'printerdrake', 'scannerdrake', 'XFdrake'],
- N("HardDrake") => 'harddrake2',
- N("Mandrakeonline") => 'mdkonline',
- N("Menudrake") => 'menudrake',
- N("Msec") => 'msec',
- N("Remote Control") => 'rfbdrake',
- N("Software Manager") => 'rpmdrake',
- N("Urpmi") => 'urpmi',
- N("Windows Migration tool") => 'transfugdrake',
- N("Userdrake") => 'userdrake',
- N("Configuration Wizards") => 'wizdrake',
- };
-
-my @generic_tool = keys %$mdk_app;
-my @all_drakxtools = @{ $mdk_app->{N("Standalone Tools")} };
-push(@generic_tool,@all_drakxtools);
-
-my $kernel_release = chomp_(`uname -r`);
-my $mandrake_release = chomp_(cat_('/etc/mandrakelinux-release'));
-#- unused for now
-#- (my $mandrake_version) = $mandrake_release =~ /(\d+\.\d+)/;
-
-if ($mandrake_release =~ /(official|community)/i) {
- my $anthill = 'http://bugs.mandrakelinux.com';
- $bugzilla = $anthill . '/drakbug.php?request=1';
- $stable_release = 1;
- $wizard_name = "Anthill";
-} else {
- $bugzilla = 'http://qa.mandrakesoft.com/enter_bug.cgi';
- $wizard_name = "Bugzilla wizard";
-}
-
-if ($stable_release == 0) {
- $table = create_packtable({ col_spacings => 5, row_spacings => 10 },
- [ Gtk2::Label->new(N("Application:")), $comb_app = Gtk2::ComboBox->new_text ],
- [ Gtk2::Label->new(N("Package: ")), $package = Gtk2::Entry->new_with_text("...") ], # complain on gtk-perl@ml
- [ Gtk2::Label->new(N("Kernel:")), gtkset_editable(Gtk2::Entry->new_with_text($kernel_release), 0) ],
- [ Gtk2::Label->new(N("Release: ")), gtkset_editable(Gtk2::Entry->new_with_text($mandrake_release), 0) ]
- );
- $comb_app->set_popdown_strings("", sort(@generic_tool));
-} else {
- $table = create_packtable({ col_spacings => 5, row_spacings => 5 },
- [Gtk2::Label->new(N("Application Name\nor Full Path:")),
- gtkpack_(Gtk2::HBox->new(0,5),
- 1, $comb_app = gtkset_editable(Gtk2::Entry->new, 1),
- 0, $button_pkg = Gtk2::Button->new(N("Find Package")),
- )],
- [ Gtk2::Label->new(N("Package: ")), $package = gtkset_editable(Gtk2::Entry->new_with_text("..."), 0) ],
- [ Gtk2::Label->new(N("Release: ")), gtkset_editable(Gtk2::Entry->new_with_text($mandrake_release), 0) ],
- [ Gtk2::Label->new(N("Summary: ")), $summary = gtkset_editable(Gtk2::Entry->new_with_text(""), 1) ]
- );
-
- $textview = Gtk2::TextView->new;
-
- $extra_data = gtkpack_(Gtk2::VBox->new(0,1),
- 0, Gtk2::Label->new(N("Bug Description/System Information")),
- 1, create_scrolled_window(gtktext_insert($textview, N("YOUR TEXT HERE"), editable => 1, visible => 1)),
- 0, gtkpack_(Gtk2::HBox->new(0,20),
- 0, Gtk2::HBox->new(0,0),
- 1, $kversion = Gtk2::CheckButton->new(N("Submit kernel version")),
- 1, $cpuinfo = Gtk2::CheckButton->new(N("Submit cpuinfo")),
- 1, $lspci = Gtk2::CheckButton->new(N("Submit lspci")),
- ),
- 0, Gtk2::HSeparator->new,
- );
- $kversion->set_active(1);
- $cpuinfo->set_active(1);
- $lspci->set_active(1);
-}
-
-gtkadd($window->{window},
- gtkpack_(Gtk2::VBox->new(0,5),
- 0, gtkadd($table),
- 1, gtkadd($extra_data),
- 0, gtkpack(Gtk2::HBox->new(0,0),
- gtkpack(gtkset_justify(Gtk2::WrappedLabel->new(formatAlaTeX(N("To submit a bug report, click on the report button.\nThis will open a web browser window on %s\n where you'll find a form to fill in. The information displayed above will be \ntransferred to that server.", $wizard_name))), "left")),
- ),
- 0, gtkpack(Gtk2::HSeparator->new),
- 0, gtkpack_(Gtk2::HBox->new(0,0),
- 0, gtksignal_connect(Gtk2::Button->new(N("Help")), clicked => sub { system("drakhelp --id drakbug &") }),
- 1, Gtk2::Label->new(""),
- 0, gtksignal_connect(Gtk2::Button->new(N("Report")), clicked => sub {
- if ($stable_release == 0) {
- my $options = "mdkbugreport=1";
- $options .= "&incident=1" if $incident;
- my $p = $package->get_text;
- my ($product, $version) = $p =~ /^(.*)-([^-]+-[^-]+mdk)$/;
- my $app = $comb_app->entry->get_text;
- my $component = if_(member($app, @all_drakxtools), $app) || $mdk_app->{$app};
- $options .= "&product=$product" if $product;
- $options .= "&component=$component" if $component;
- $options .= "&version=$version" if $version;
- $options .= "&kernel=$kernel_release";
- print($bugzilla . "?" . $options . "\n");
- connect_bugzilla($bugzilla . "?" . $options);
- } else {
- # anthill variant - we'll create a text file, then connect to upload
- my $check = write_anthill_file();
- connect_bugzilla($bugzilla) if !$check;
- }
- }
- ),
- 0, gtksignal_connect(Gtk2::Button->new(N("Close")), clicked => sub { ugtk2->exit(0) }),
- )));
-
-if ($stable_release == 0) {
- if (defined $prog) {
- update_app($prog);
- $comb_app->set_text($prog);
- };
- $comb_app->entry->signal_connect('changed', sub { update_app($comb_app->entry->get_text) });
-} else {
- $window->{window}->set_size_request(600, 460);
- $button_pkg->signal_connect('clicked', sub {
- my $pkg_name = get_pkg_name($comb_app->get_text);
- $package->set_text($pkg_name);
- });
-}
-
-$window->{window}->show_all;
-$window->main;
-ugtk2->exit(0);
-
-sub update_app {
- my ($text) = @_;
- my $app_choice;
- $ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";
- if (member($text,@all_drakxtools) || $text eq N("Standalone Tools")) {
- $app_choice = chomp_(`rpm -q drakxtools`);
- } elsif (exists($mdk_app->{$text}) && $text ne N("Standalone Tools")) {
- $app_choice = get_package($mdk_app->{$text});
- } else {
- LOOP: while (my ($key, $value) = each %$mdk_app) {
- next if $key eq N("Standalone Tools");
- if ($value eq $text) {
- $app_choice = get_package($text);
- $prog = $key;
- last LOOP;
- }
- }
-
- }
- $app_choice ? $package->set_text($app_choice) : $package->set_text(N("Not installed"));
-}
-
-my %packages;
-
-sub get_package {
- my ($executable) = @_;
- my ($rpm_package, $which_app);
- $rpm_package = $packages{$executable};
- if (!defined $rpm_package) {
- $which_app = chomp_(`which '$executable' 2> /dev/null`);
- # deush, rpm can takes some time aka it'll sleeps if something has opened rpm db !
- $rpm_package = $which_app eq "" ? N("Package not installed") : chomp_(`rpm -qf '$which_app' 2>&1`);
- $packages{$executable} = $rpm_package;
- }
- $rpm_package;
-}
-
-sub get_pkg_name {
- my ($executable) = @_;
- my $which_app = chomp_(`which '$executable' 2> /dev/null`);
- my $rpm_package;
- if ($which_app eq "") {
- $rpm_package = chomp_(`rpm -q '$executable' --qf '%{NAME}' 2>&1`);
- } else {
- $rpm_package = chomp_(`rpm -qf '$which_app' --qf '%{NAME}' 2>&1`);
- }
- $rpm_package = chomp_(`rpm -qf '$executable' --qf '%{NAME}' 2>&1`) if $rpm_package =~ /not installed$/;
- $rpm_package = (split(/-2/, $rpm_package))[0] if $rpm_package =~ /^kernel/;
- $rpm_package ||= N("NOT FOUND");
- $rpm_package;
-}
-
-sub connect_bugzilla {
- my ($url) = @_;
- if (!$stable_release) {
- my $_w = create_dialog(N("Please wait"), N("connecting to %s...", $wizard_name));
- sleep(3);
- }
- exec $ENV{BROWSER},$url if exists $ENV{BROWSER};
- my @browser = qw(mozilla konqueror galeon);
- foreach (@browser) {
- if (-e "/usr/bin/$_") { log::explanations("Contacting $url with $_\n "); exec $_,$url }
- }
- create_dialog(N("Error"), N("No browser available! Please install one"));
-}
-
-sub write_anthill_file() {
- my $buffer = $textview->get_buffer;
- my $siter = $buffer->get_start_iter;
- my $eiter = $buffer->get_end_iter;
- $bugdesc = $buffer->get_text($siter, $eiter, 0);
-
- #- create anthill upload file in specified format
- my $file;
- open($file, "> /tmp/drakbug.report") or return 1;
- print $file "--- BEGIN DRAKBUG REPORT ---\n";
- print $file "%product: $mandrake_release\n";
- my $version = arch();
- $version = "x86" if $version =~ /^i.86/;
- print $file "%version: $version\n";
- my $pkg_name = $package->get_text;
- if ($pkg_name eq "..." || $pkg_name eq "") {
- my $_w = create_dialog(N("Error"), N("Please enter a package name."));
- return 1;
- }
- print $file "%component: $pkg_name\n";
- my $summary_text = $summary->get_text;
- if ($summary_text eq "") {
- my $_w = create_dialog(N("Error"), N("Please enter summary text."));
- return 1;
- }
-
- print $file "%summary: $summary_text\n";
- print $file "%description:\n";
-
- #- gave me fits wanted to wrap what was wrapped in the GUI
- #- plus include user's \n
- my @buglist = split("\n", $bugdesc);
- foreach my $bugdesc (@buglist) {
- if (length($bugdesc) > 77) {
- $bugwrite = $bugdesc;
- select($file);
- local $~ = "PFORMAT";
- write $file;
- select(STDOUT);
- $bugwrite = '';
- } else {
- print $file " $bugdesc\n";
- }
- }
-
- print $file "-" x 80 . "\n";
- print $file "Kernel: $kernel_release\n" . "Uname: " . `uname -a` . "\n" if $kversion->get_active;
- print $file "Cpuinfo: \n" . cat_("/proc/cpuinfo") if $cpuinfo->get_active;
- print $file "Lspci Output:\n" . `lspci` if $lspci->get_active;
- print $file "--- END DRAKBUG REPORT ---\n";
- close $file or return 1;
- return 0
-}
-
-format PFORMAT =
-~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$bugwrite
-.
-
diff --git a/perl-install/standalone/drakbug_report b/perl-install/standalone/drakbug_report
deleted file mode 100755
index 632dafcf7..000000000
--- a/perl-install/standalone/drakbug_report
+++ /dev/null
@@ -1,15 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone;
-use common;
-use any;
-
-my %other = (
- 'rpm -qa' => join('', sort `rpm -qa`),
- 'mandrake version' => mandrake_release(),
- 'df' => join('', `df`),
-);
-
-print any::report_bug('', %other);
diff --git a/perl-install/standalone/drakclock b/perl-install/standalone/drakclock
deleted file mode 100755
index a71e695ae..000000000
--- a/perl-install/standalone/drakclock
+++ /dev/null
@@ -1,397 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use POSIX;
-use common;
-# i18n : IMPORTANT to get correct namespace (drakconf instead of libDrakX)
-BEGIN { unshift @::textdomains, 'drakconf' }
-use ugtk2 qw(:all);
-use interactive;
-use standalone;
-use timezone;
-
-my $in = interactive->vnew('su');
-my $pixmap;
-my $radius;
-my ($dRadians_hour, $dRadians_min, $dRadians_sec);
-my $Radian;
-my $timer;
-my $first = 1;
-my $its_reset = 0;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/time-mdk.png";
-
-#my $conffile = '/etc/sysconfig/ntpclock';
-my $ntpfile = '/etc/ntp.conf';
-my $ntpdlock = '/var/lock/subsys/ntpd';
-
-my $my_win = ugtk2->new('print_launcher');
-$my_win->{rwindow}->set_title(N("DrakClock")) unless $::isEmbedded;
-
-$my_win->{window}->signal_connect(delete_event => sub { ugtk2->exit(0) });
-
-my $calendar = Gtk2::Calendar->new;
-$calendar->signal_connect($_ => \&cal_changed) foreach 'month-changed', 'day-selected', 'day-selected-double-click', 'prev-month', 'next-month', 'prev-year', 'next-year';
-
-$in->{timezone} = {};
-add2hash($in->{timezone}, timezone::read());
-
-my $label_timezone = Gtk2::Label->new(defined($in->{timezone}{timezone}) ? $in->{timezone}{timezone} : N("not defined"));
-
-my $button_time = Gtk2::Button->new(N("Change Time Zone"));
-$button_time->signal_connect(clicked => sub {
- local $::isEmbedded = 0; # to prevent sub window embedding
- my $timezone = $in->{timezone}{timezone};
- $in->{timezone}{timezone} = $in->ask_from_treelist(N("Timezone - DrakClock"), N("Which is your timezone?"), '/', [ timezone::getTimeZones() ], $timezone);
- if (defined($in->{timezone}{timezone})) {
- $in->{timezone}{UTC} = $in->ask_yesorno(N("GMT - DrakClock"), N("Is your hardware clock set to GMT?"), $in->{timezone}{UTC});
- timezone::write($in->{timezone});
- $label_timezone->set_text($in->{timezone}{timezone});
- } else {
- $in->{timezone}{timezone} = $timezone;
- $label_timezone->set_text($timezone);
- }
- });
-#my $button_ntp = Gtk2::Button->new(N("Use NTP"));
-#$button_time->signal_connect(clicked => sub { ask_ntp($in, $) });
-
-my $drawing_area;
-
-my $adjh = Gtk2::Adjustment->new(0.0, 0.0, 23.0, 1.0, 5.0, 0.0);
-my $adjm = Gtk2::Adjustment->new(0.0, 0.0, 59.0, 1.0, 5.0, 0.0);
-my $adjs = Gtk2::Adjustment->new(0.0, 0.0, 59.0, 1.0, 5.0, 0.0);
-
-my ($button_reset, $check_ntp, $hb_ntp, $combo_ntpserver, $fullntp, $ntp);
-my $mode = 0;
-
-my (undef, undef, $h_old, $old_day, $old_month, $old_year) = localtime(time());
-
-my @image_size = (200, 200);
-
-$my_win->{window}->add(gtkpack_(gtkset_border_width(Gtk2::VBox->new, $::isEmbedded ? 0 : 5),
- 1, gtkpack_(Gtk2::HBox->new,
- 1, gtkpack_(Gtk2::VBox->new,
- 0, $calendar,
- 1, gtkadd(gtkset_shadow_type(Gtk2::Frame->new(N("Network Time Protocol")), 'etched_in'),
- gtkpack_(gtkset_border_width(Gtk2::VBox->new, 5),
- 0, Gtk2::Label->new(N("Your computer can synchronize its clock\n with a remote time server using NTP")),
- 0, gtksignal_connect(gtkset_active($check_ntp = Gtk2::CheckButton->new(N("Enable Network Time Protocol")), $mode), clicked => sub {
- $mode = !$mode;
- $hb_ntp->set_sensitive($mode);
- if ($mode == 1 && !$in->do_pkgs->is_installed('ntp')) {
- install_ntp();
- }
- }),
- 0, gtkpack_(gtkset_border_width($hb_ntp = Gtk2::HBox->new, 5),
- 0, Gtk2::Label->new(N("Server:")),
- 1, $combo_ntpserver = Gtk2::Combo->new
- )
- ))
- ),
- 0, gtkpack_(Gtk2::VBox->new,
- 0, gtkpack_(Gtk2::HBox->new,
- 0, $drawing_area = gtkset_size_request(Gtk2::DrawingArea->new, @image_size),
- ),
- 0, gtkpack_(my $time_box = Gtk2::HBox->new(1,0),
- 0, my $spinner_h = Gtk2::SpinButton->new($adjh, 0, 0),
- 0, my $spinner_m = Gtk2::SpinButton->new($adjm, 0, 0),
- 0, my $spinner_s = Gtk2::SpinButton->new($adjs, 0, 0),
- ),
- 1, gtkadd(gtkset_shadow_type(Gtk2::Frame->new(N("Timezone")), 'etched_in'),
- gtkpack__(gtkset_border_width(Gtk2::VBox->new, 5),
- $label_timezone,
- $button_time)),
- ),
- ),
- 0, create_okcancel(my $w =
- {
- cancel_clicked => sub { ugtk2->exit(0) },
- ok_clicked => sub {
- my $need_date = 1;
- if ($check_ntp->get_active) {
- my $choosed_serv = $combo_ntpserver->entry->get_text;
- $choosed_serv =~ s/(\S+)\s*(.*)$/$1/;
- timezone::ntp_server($1);
- system("/sbin/chkconfig --level 35 ntpd on");
- system("service ntpd stop");
- #verify that we have a valid hostname (thx sam)
- $choosed_serv =~ s/[^-a-zA-Z0-9.]//g;
- if (!system("/usr/sbin/ntpdate", $choosed_serv)) {
- update_time(); #- get the new time before updating the hwclock
- system("service ntpd start");
- $need_date = 0
- } else {
- warn_dialog(N("Error"), N("Could not synchronize with %s.", $choosed_serv));
- return
- }
- } else {
- if (-e $ntpdlock) {
- system("service ntpd stop");
- system("/sbin/chkconfig --level 35 ntpd off");
- }
- }
- if ($need_date) {
- my ($year, $month, $day) = $calendar->get_date;
- $month++;
- my ($hour, $min, $sec) = ($adjh->get_value, $adjm->get_value, $adjs->get_value);
- system("date " .
- join('', map { print_it0($_) } ($month, $day, $hour, $min, $year)) . '.' . print_it0($sec));
- }
- -e '/sbin/hwclock' and system('/sbin/hwclock --systohc');
- system("dcop kicker Panel restart") if $ENV{DESKTOP} eq 'kde';
- ugtk2->exit(0);
- },
- },
- undef, undef, '',
- [ N("Reset"), sub {
- $its_reset = 1;
- $timer = Glib::Timeout->add(120, \&update_time);
- Repaint($drawing_area, 1);
- $button_reset->set_sensitive(0);
- $its_reset = 0;
- } ]
- ),
- )
- );
-$button_reset = $w->{buttons}{N("Reset")};
-
-$time_box->set_direction('ltr');
-
-my $servers = get_server();
-$combo_ntpserver->set_popdown_strings(@$servers);
-if (-e $ntpfile && -e $ntpdlock) {
- $ntp = timezone::ntp_server();
- $ntp and ntp_widget_state(1);
- foreach my $s (@$servers) {
- $s =~ /^\Q$ntp / and $fullntp = $s;
- $fullntp and last
- }
- $fullntp |= $ntp;
- $combo_ntpserver->entry->set_text($fullntp);
-} else { ntp_widget_state(0) }
-
-my $pressed;
-$drawing_area->set_events([ 'button_press_mask', 'button_release_mask', "pointer_motion_mask" ]);
-$drawing_area->signal_connect(expose_event => \&expose_event);
-$drawing_area->signal_connect(realize => sub {
- my $window = $drawing_area->window;
- $pixmap = Gtk2::Gdk::Pixmap->new($window, @image_size, $window->get_depth);
- });
-
-$drawing_area->signal_connect(button_press_event => sub { $pressed = 1 });
-$drawing_area->signal_connect(button_release_event => sub { $first = 1; $pressed = 0 });
-$drawing_area->signal_connect(motion_notify_event => \&motion_event);
-
-$spinner_h->set_wrap(1);
-$spinner_h->signal_connect(activate => \&spinned);
-$spinner_h->signal_connect(button_release_event => \&spinned);
-$spinner_h->signal_connect(scroll_event => \&spinned);
-$spinner_h->signal_connect(changed => \&changed);
-
-$spinner_m->set_wrap(1);
-$spinner_m->signal_connect(activate => \&spinned);
-$spinner_m->signal_connect(scroll_event => \&spinned);
-$spinner_m->signal_connect(button_release_event => \&spinned);
-
-$spinner_s->set_wrap(1);
-$spinner_s->signal_connect(activate => \&spinned);
-$spinner_s->signal_connect(scroll_event => \&spinned);
-$spinner_s->signal_connect(button_release_event => \&spinned);
-
-gtkflush();
-
-my $is24 = $h_old > 12;
-$old_year += 1900;
-$calendar->select_month($old_month, $old_year);
-$calendar->select_day($old_day);
-$button_reset->set_sensitive(0);
-$timer = Glib::Timeout->add(120, \&update_time);
-
-$drawing_area->show;
-$my_win->{window}->show_all;
-my ($midx, $midy) = ($drawing_area->allocation->width/2, $drawing_area->allocation->height/2);
-$my_win->main;
-ugtk2->exit(0);
-
-sub ntp_widget_state {
- my ($state) = @_;
- $check_ntp->set_active($state);
- $hb_ntp->set_sensitive($state);
- $mode = $state;
-}
-sub install_ntp() {
- $my_win->{window}->set_sensitive(0);
- if (warn_dialog(N("Warning"), N("We need to install ntp package\n to enable Network Time Protocol
-
-Do you want to install ntp?"))) {
- $in->do_pkgs->install('ntp');
- } else {
- ntp_widget_state(0);
- }
- $my_win->{window}->set_sensitive(1);
-}
-sub get_server() {
- my $servs = timezone::ntp_servers();
- [ map { "$_ ($servs->{$_})" } sort keys %$servs ]
-}
-sub update_time() {
- my (undef, undef, undef, $mday, $mon, $year) = localtime(time());
- $year += 1900;
- my $old_its_reset = $its_reset;
- $its_reset = 1;
- $calendar->select_day($mday);
- $calendar->select_month($mon, $year);
- $its_reset = $old_its_reset;
- Repaint($drawing_area, 1);
-};
-
-sub cal_changed() {
- !$its_reset and $timer and Glib::Source->remove($timer);
- $button_reset->set_sensitive(1);
-}
-
-sub changed() {
- my $val = $adjh->get_value;
- my $limit = ($is24 ? 18 : 6);
- if (($limit > $val && $h_old > $limit && $h_old < ($is24 ? 24 : 12)) ||
- ($limit < $val && $h_old < $limit && $val-$h_old != 12)) {
- $is24 = !$is24;
- }
- $h_old = $val;
-}
-
-sub spinned() {
- Glib::Source->remove($timer);
- $button_reset->set_sensitive(1);
- time_to_rad($adjs->get_value, $adjm->get_value, $adjh->get_value);
- Repaint($drawing_area);
- 0;
-}
-
-sub motion_event {
- my ($widget, $event) = @_;
- $pressed or return;
- if ($first) {
- Glib::Source->remove($timer);
- $Radian = determine_radian($event->x, $event->y);
- $button_reset->set_sensitive(1);
- }
-
- $$Radian = -atan2($event->x - $midx, $event->y - $midy) + $PI;
-
- Repaint($widget);
- rad_to_time();
- $first = 0;
-}
-
-sub determine_radian {
- my ($x, $y) = @_;
-
- my $res;
- my $r;
- foreach (\$dRadians_hour, \$dRadians_min, \$dRadians_sec) {
- my $d = sqrt(($x - ($midx + 7/10 * $radius * sin($$_)))**2 + ($y - ($midy - 7/10 * $radius * cos($$_)))**2);
- $res or $res = $d, $r = $_;
- $d < $res and $res = $d, $r = $_;
- }
- $r;
-}
-
-sub expose_event {
- my ($widget, $event) = @_;
- my ($x, $y, $width, $height) = $event->area->values;
- $widget->window->draw_drawable($widget->style->fg_gc('normal'), $pixmap, $x, $y, $x, $y, $width, $height);
- 0;
-}
-
-sub rad_to_time() {
- $adjh->set_value(POSIX::floor($dRadians_hour * 6 / $PI) + ($is24 ? 12 : 0));
- $adjm->set_value(POSIX::floor($dRadians_min*30/$PI));
- $adjs->set_value(POSIX::floor($dRadians_sec*30/$PI));
-}
-
-sub time_to_rad {
- my ($sec, $min, $hour) = @_;
- $dRadians_hour = $hour % 12 * $PI / 6;
- $dRadians_min = $min * $PI / 30;
- $dRadians_sec = $sec * $PI / 30;
- $adjh->set_value($hour);
- $adjm->set_value($min);
- $adjs->set_value($sec);
-}
-
-sub Repaint {
- my ($drawing_area, $o_update_time) = @_;
- my ($sec,$min,$hour) = localtime(time());
- time_to_rad($sec, $min, $hour) if $o_update_time;
- my ($width, $height) = ($drawing_area->allocation->width, $drawing_area->allocation->height);
- my $dRadians_hour_real = $dRadians_hour + $dRadians_min / 12;
- my $dRadians_min_real = POSIX::floor($dRadians_min / $PI * 30) * $PI / 30;
- my $dRadians_sec_real = $dRadians_sec;
- $pixmap->draw_rectangle($drawing_area->style->white_gc, 1, 0, 0, $width, $height);
- my ($midx, $midy) = ($width / 2, $height / 2);
- $radius = ($midx < $midy ? $midx : $midy) - 10;
-
- my $gray_gc = $drawing_area->style->bg_gc('normal');
- my $black_gc = $drawing_area->style->black_gc;
- foreach ([ $gray_gc, 5 ], [ $black_gc, 0 ]) {
- &DrawTickAt($pixmap, $_->[0], $midx, $midy, $_->[1]);
- &DrawHour($pixmap, $_->[0], $midx, $midy, $dRadians_hour_real, $_->[1]);
- &DrawMin($pixmap, $_->[0], $midx, $midy, $dRadians_min_real, $_->[1]);
- &DrawSec($pixmap, $_->[0], $midx, $midy, $dRadians_sec_real, $_->[1]);
- }
- &DrawPointAt($pixmap, $black_gc, $_, $midx, $midy) foreach (1..60);
- $drawing_area->queue_draw;
- 1;
-}
-
-sub DrawSec {
- my ($pixmap, $gc, $midx, $midy, $dRadians, $dec) = @_;
- $pixmap->draw_line($gc,
- $midx+$dec, $midy+$dec,
- $midx+$dec + (8/10 * $radius * sin($dRadians)),
- $midy+$dec - (8/10 * $radius * cos($dRadians)))
-}
-
-sub DrawMin {
- my ($pixmap, $gc, $midx, $midy, $dRadians, $dec) = @_;
- $pixmap->draw_polygon($gc, 1, $midx+$dec - 3/100 * $radius * sin($dRadians), $midy+$dec + 3/100 * $radius * cos($dRadians),
- $midx+$dec - 3/100 * $radius * sin($dRadians+$PI/2), $midy+$dec + 3/100 * $radius * cos($dRadians+$PI/2),
- $midx+$dec + 8/10 * $radius * sin($dRadians), $midy+$dec - 8/10 * $radius * cos($dRadians),
- $midx+$dec + 3/100 * $radius * sin($dRadians+$PI/2), $midy+$dec - 3/100 * $radius * cos($dRadians+$PI/2)
- );
-}
-
-sub DrawHour {
- my ($pixmap, $gc, $midx, $midy, $dRadians, $dec) = @_;
- $pixmap->draw_polygon($gc, 1, $midx+$dec - 5/100 * $radius * sin($dRadians), $midy+$dec + 5/100 * $radius * cos($dRadians),
- $midx+$dec - 5/100 * $radius * sin($dRadians+$PI/2), $midy+$dec + 5/100 * $radius * cos($dRadians+$PI/2),
- $midx+$dec + 6/10 * $radius * sin($dRadians), $midy+$dec - 6/10 * $radius * cos($dRadians),
- $midx+$dec + 5/100 * $radius * sin($dRadians+$PI/2), $midy+$dec - 5/100 * $radius * cos($dRadians+$PI/2)
- );
-}
-
-sub DrawTickAt {
- my ($pixmap, $gc, $cx, $cy, $dec) = @_;
- foreach my $nHour (1..12) {
- my $dRadians = $nHour * $PI / 6.0;
- $pixmap->draw_line($gc,
- $cx + $dec + 9/10 * $radius * sin($dRadians),
- $cy + $dec - 9/10 * $radius * cos($dRadians),
- $cx + $dec + 1 * $radius * sin($dRadians),
- $cy + $dec - 1 * $radius * cos($dRadians));
- }
-}
-
-sub DrawPointAt {
- my ($pixmap, $black_gc, $nHour, $cx, $cy) = @_;
- my $dRadians = $nHour * $PI / 30;
-
- $pixmap->draw_points($black_gc,
- $cx + 95/100 * $radius * sin($dRadians),
- $cy - 95/100 * $radius * cos($dRadians))
-}
-
-
-sub print_it0 { sprintf("%02d", $_[0]) }
diff --git a/perl-install/standalone/drakconnect b/perl-install/standalone/drakconnect
deleted file mode 100755
index 90ef8419d..000000000
--- a/perl-install/standalone/drakconnect
+++ /dev/null
@@ -1,1061 +0,0 @@
-#!/usr/bin/perl
-
-# DrakConnect $Id$
-
-# Copyright (C) 1999-2004 Mandrakesoft
-# Damien "Dam's" Krotkine
-# Damien "poulpy" Chaumette
-# Thierry Vignaud <tvignaud@mandrakesoft.com>
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use strict;
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use common;
-use network::netconnect;
-use network::ethernet;
-use network::tools;
-use network::modem;
-use network::network;
-use c;
-use modules;
-use network::isdn;
-use network::adsl;
-use network::tools;
-use network::test;
-use MDK::Common::Globals "network", qw($in);
-use POSIX ":sys_wait_h";
-
-$ugtk2::wm_icon = "drakconnect";
-my $in = 'interactive'->vnew('su');
-if ($in->isa('interactive::gtk')) {
- require ugtk2;
- ugtk2->import(qw(:create :dialogs :helpers :wrappers));
-}
-
-my ($netcnx, $netc, $intf) = ({}, {}, {});
-network::netconnect::read_net_conf($netcnx, $netc, $intf);
-
-my $modules_conf = modules::any_conf->read;
-modules::load_category($modules_conf, 'net');
-
-$::Wizard_title = N("Network & Internet Configuration");
-$::Wizard_pix_up = "drakconnect.png";
-
-MDK::Common::Globals::init(in => $in);
-
-local $_ = join '', @ARGV;
-/--skip-wizard/ and manage($netc, $intf);
-/--add/ and add_intf();
-/--del/ and del_intf();
-/--old/ and goto old;
-if (/--install/) {
- $::isInstall = 1;
- add_intf()
-}
-/--internet/ and configure_net($netcnx, $netc, $intf);
-
-# default is to run wizard
-add_intf();
-
-old:
-my @all_cards;
-
-my $window1 = ugtk2->new('drakconnect');
-$window1->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) });
-unless ($::isEmbedded) {
- $window1->{rwindow}->set_position('center');
- $window1->{rwindow}->set_title(N("Network configuration (%d adapters)", scalar @all_cards));
- $window1->{rwindow}->set_size_request(-1, -1);
-}
-$window1->{rwindow}->set_border_width(10);
-
-my $warning_label1;
-
-my $button_apply;
-
-
-my $hostname = chomp_(`hostname`);
-my $int_label = Gtk2::Label->new($netcnx->{type} eq 'lan' ? N("Gateway:") : N("Interface:"));
-my $int_name = Gtk2::Label->new($netcnx->{type} eq 'lan' ? $netc->{GATEWAY} : $netcnx->{NET_INTERFACE});
-my $isconnected = -1;
-
-my $int_connect = Gtk2::Button->new(N("Wait please"));
-$int_connect->set_sensitive(0);
-$int_connect->signal_connect(clicked => sub {
- if (!$isconnected) {
- connect_backend($netc);
- } else {
- disconnect_backend($netc);
- }
-});
-
-my $tree_model = Gtk2::TreeStore->new("Gtk2::Gdk::Pixbuf", map { "Glib::String" } 2..6);
-my $list = Gtk2::TreeView->new_with_model($tree_model);
-$list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererPixbuf->new, 'pixbuf' => 0));
-each_index {
- $list->append_column(my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i + 1));
- $col->set_sort_column_id($::i);
-} (N("Interface"), N("IP address"), N("Protocol"), N("Driver"), N("State"));
-
-$list->signal_connect(button_press_event => sub {
- my (undef, $event) = @_;
- my (undef, $iter) = $list->get_selection->get_selected;
- return unless $iter;
- configure_lan() if $event->type eq '2button-press';
- });
-
-update_list($modules_conf);
-
-my ($label_host, $int_state);
-
-
-$window1->{window}->add(
- gtkpack_(Gtk2::VBox->new(0,10),
- 0, gtkpack(Gtk2::HBox->new,
- Gtk2::Label->new(N("Hostname: ")),
- $label_host = Gtk2::Label->new($hostname),
- gtksignal_connect(Gtk2::Button->new(N("Configure hostname...")),
- clicked => sub {
- local ($::isWizard, $::Wizard_finished) = (1, 1);
- eval { # For wizcancel
- network::netconnect::main('', $netcnx, $in, $modules_conf, $netc, undef, $intf);
- $button_apply->set_sensitive(1);
- update();
- };
- if ($@ =~ /wizcancel/) {}
- $::WizardWindow->destroy;
- undef $::WizardWindow;
- }
- ),
- ),
- 1, gtkadd(gtkcreate_frame(N("LAN configuration")),
- gtkpack_(gtkset_border_width(Gtk2::VBox->new(0,0), 5),
- 0, $list,
- 0, Gtk2::HBox->new(0,0),
- 0, gtkpack_(Gtk2::HBox->new(0, 0),
- 0, gtksignal_connect(Gtk2::Button->new(N("Configure Local Area Network...")),
- clicked => \&configure_lan),
- ),
- )
- ),
- 0, gtkpack(Gtk2::HButtonBox->new,
- gtksignal_connect(Gtk2::Button->new(N("Help")), clicked => sub {
- exec("drakhelp --id internet-connection") unless fork() }),
- $button_apply = gtksignal_connect(gtkset_sensitive(Gtk2::Button->new(N("Apply")), 0),
- clicked => \&apply),
- gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => \&quit_global),
- gtksignal_connect(Gtk2::Button->new(N("Ok")), clicked => sub {
- if ($button_apply->get('sensitive')) {
- my $dialog = _create_dialog(N("Please wait"));
- gtkpack($dialog->vbox,
- Gtk2::Label->new(N("Please Wait... Applying the configuration")));
- $dialog->show_all;
- gtkflush();
- apply($netc, $intf);
- $dialog->destroy;
- }
- update();
- quit_global();
- }),
- ),
- ),
- );
-
-
-
-$window1->{rwindow}->show_all;
-gtkflush();
-$window1->main;
-ugtk2->exit(0);
-
-sub manage {
- my ($netc, $intf) = @_;
-
- my $p = {};
- my ($interface_menu, $selected, $apply_button);
- my $window = ugtk2->new('Manage Connection');
- unless ($::isEmbedded) {
- $window->{rwindow}->set_position('center');
- $window->{rwindow}->set_title(N("Manage connections")); # translation availlable in mcc domain => we need merging
- }
-
- my $notebook = Gtk2::Notebook->new;
- $notebook->set_property('show-tabs', 0);
- $notebook->set_property('show-border', 0);
-
- @all_cards = network::ethernet::get_eth_cards($modules_conf);
- my %name = network::ethernet::get_eth_cards_names(@all_cards);
- foreach (keys %name) {
- my $dev = /eth|ath|wlan/ ? $name{$_} : $_;
- $p->{$dev} = {
- name => $_ ,
- intf => $intf->{$_}
- };
- }
- while (my ($device, $interface) = each %$intf) {
- exists $name{$device} and next;
- my $type = network::tools::get_interface_type($interface);
- $p->{"$type ($device)"} = {
- name => $device,
- intf => $interface
- };
- }
-
- $window->{rwindow}->add(gtkpack_(Gtk2::VBox->new,
- 0, gtkpack__(Gtk2::HBox->new,
- Gtk2::Label->new(N("Device selected")),
- $interface_menu = gtksignal_connect(Gtk2::ComboBox->new_text,
- changed => sub {
- $selected = $interface_menu->get_text;
- $notebook->set_current_page($p->{$selected}{gui}{index});
- },
- ),
- ),
- 1, $notebook,
- 0, create_okcancel(my $oc =
- {
- cancel_clicked => sub { $window->destroy; Gtk2->main_quit },
- ok_clicked => sub {
- if ($apply_button->get_property('sensitive')) {
- save($netc, $p, $apply_button);
- }
- $window->destroy;
- Gtk2->main_quit;
- },
- },
- undef, undef, '',
- [ N("Help"), sub { exec("drakhelp --id internet-connection") unless fork() } ],
- [ N("Apply"), sub { save($netc, $p, $apply_button) }, 0, 1 ],
- ),
- ),
- );
- $apply_button = $oc->{buttons}{N("Apply")};
-
- each_index {
- my ($name, $interface, $protocol) = ($_, $p->{$_}{name}, $p->{$_}{protocol});
- $p->{$name}{gui}{index} = $::i;
- build_tree($netc, $p->{$name}{intf}, $name, $interface, $protocol);
- build_notebook($netc, $p->{$name}{intf}, $p->{$name}{gui}, $apply_button, $name, $interface);
- $notebook->append_page(gtkpack(Gtk2::VBox->new(0,0), $p->{$name}{gui}{notebook}));
- } (sort keys %$p);
-
- $interface_menu->set_popdown_strings(sort keys %$p);
- $interface_menu->set_active(0);
- $apply_button->set_sensitive(0);
-
- $window->{rwindow}->show_all;
- $window->main;
- ugtk2->exit(0);
-}
-
-sub build_tree {
- my ($netc, $intf, $interface, $interface_name, $protocol) = @_;
-
- if ($interface eq 'adsl') {
- $intf->{pages} = { 'TCP/IP' => 1, 'Account' => 1, 'Options' => 1, 'Information' => 1 };
- network::adsl::adsl_probe_info($intf, $netc, $protocol, $interface_name);
- $intf->{save} = sub {
- $netc->{internet_cnx_choice} = 'adsl';
- $netc->{at_boot} = $intf->{ONBOOT} eq 'yes' ? 1 : 0;
- network::adsl::adsl_conf_backend($in, $modules_conf, $netcnx, $netc, $intf, $interface_name, $protocol)
- };
- }
- elsif ($interface eq 'modem') {
- $intf->{pages} = { 'TCP/IP' => 1, 'Account' => 1, 'Modem' => 1, 'Options' => 1 };
- put_in_hash($intf, network::modem::ppp_read_conf({}, $netc));
- $intf->{save} = sub { network::modem::ppp_configure($in, $intf) };
- }
- elsif ($interface eq 'isdn') {
- $intf->{pages} = { 'TCP/IP' => 1, 'Account' => 1, 'Modem' => 1, 'Options' => 1 };
- network::isdn::read_config($intf);
- $intf->{save} = sub { network::isdn::write_config($intf) };
- }
- else {
- #- ethernet is default
- $intf->{pages} = { 'TCP/IP' => 1, if_($intf->{WIRELESS_MODE}, 'Wireless' => 1), 'Options' => 1, 'Information' => 1 };
- }
-}
-
-sub build_notebook {
- my ($netc, $intf, $gui, $apply_button, $interface, $interface_name) = @_;
-
- my $apply = sub { $apply_button->set_sensitive(1) };
- my $is_ethernet = $interface =~ /eth|ath|wlan/;
-
- if ($intf->{pages}{'TCP/IP'}) {
- gtkpack($gui->{sheet}{'TCP/IP'} = Gtk2::HBox->new,
- gtkadd(gtkcreate_frame(N("IP configuration")),
- gtkpack_(gtkset_border_width(Gtk2::VBox->new(0,10), 5),
- if_($is_ethernet,
- 0, gtkpack__(Gtk2::HBox->new,
- Gtk2::Label->new(N("Protocol")),
- $gui->{intf}{BOOTPROTO} = gtksignal_connect(Gtk2::ComboBox->new_text,
- changed => sub {
- return if !$_[0]->realized;
- my $proto = $gui->{intf}{BOOTPROTO};
- my $protocol = $intf->{BOOTPROTO} = { reverse %{$proto->{protocols}} }->{$proto->get_text};
-
- foreach ($gui->{intf}{IPADDR}, $gui->{intf}{NETMASK}, $gui->{netc}{GATEWAY}) {
- $_->set_sensitive($protocol eq "static" ? 1 : 0)
- }; $apply->() },
- ),
- ),
- ),
- 0, gtkpack(Gtk2::VBox->new(1,0),
- gtkpack__(Gtk2::HBox->new, Gtk2::Label->new(N("IP address"))),
- gtkpack__(Gtk2::HBox->new, gtksignal_connect($gui->{intf}{IPADDR} = Gtk2::Entry->new,
- key_press_event => $apply)),
- ),
- 0, gtkpack(Gtk2::VBox->new(1,0),
- gtkpack__(Gtk2::HBox->new, Gtk2::Label->new(N("Netmask"))),
- gtkpack__(Gtk2::HBox->new, gtksignal_connect($gui->{intf}{NETMASK} = Gtk2::Entry->new,
- key_press_event => $apply)),
- ),
- if_($is_ethernet,
- 0, gtkpack(Gtk2::VBox->new(1,0),
- gtkpack__(Gtk2::HBox->new, Gtk2::Label->new(N("Gateway"))),
- gtkpack__(Gtk2::HBox->new, gtksignal_connect($gui->{netc}{GATEWAY} = Gtk2::Entry->new,
- key_press_event => $apply)),
- ),
- ),
- ),
- ),
- gtkpack_(Gtk2::VBox->new,
- 1, gtkadd(gtkcreate_frame(N("DNS servers")),
- gtkpack(Gtk2::VBox->new(0,0),
- Gtk2::Label->new($intf->{dns1} || $netc->{dnsServer}),
- if_($intf->{dns2} || $netc->{dnsServer2},
- Gtk2::Label->new($intf->{dns2} || $netc->{dnsServer2})),
- if_($intf->{dns3} || $netc->{dnsServer3},
- Gtk2::Label->new($intf->{dns3} || $netc->{dnsServer3}))),
- ),
- 1, gtkadd(gtkcreate_frame(N("Search Domain")),
- Gtk2::Label->new($intf->{domain} || $netc->{DOMAINNAME} || 'none'),
- ),
- ),
- );
-
- if ($is_ethernet) {
- my $proto = $gui->{intf}{BOOTPROTO};
- $proto->{protocols} = { none => N("none"), static => N("static"), dhcp => N("DHCP") };
- $proto->set_popdown_strings(values %{$proto->{protocols}});
- $proto->set_text($proto->{protocols}{$intf->{BOOTPROTO} || 'none'});
- foreach ($gui->{intf}{IPADDR}, $gui->{intf}{NETMASK}, $gui->{netc}{GATEWAY}) {
- $_->set_sensitive($intf->{BOOTPROTO} eq 'static' ? 1 : 0)
- };
- } else {
- $_->set_sensitive(0) foreach $gui->{intf}{IPADDR}, $gui->{intf}{NETMASK};
- delete $gui->{intf}{BOOTPROTO};
- }
- !$intf->{IPADDR} and ($intf->{IPADDR}, $gui->{active}, $intf->{NETMASK}) = get_intf_ip($interface_name);
- $gui->{netc}{$_}->set_text($netc->{$_}) foreach keys %{$gui->{netc}};
- }
-
- if ($intf->{pages}{Wireless}) {
- gtkpack(gtkset_border_width($gui->{sheet}{Wireless} = Gtk2::HBox->new(0,10), 5),
- gtkpack_(Gtk2::VBox->new(0,0),
- map { (0, gtkpack_(Gtk2::VBox->new(0,0),
- 1, Gtk2::Label->new($_->[0]),
- 0, gtksignal_connect($gui->{intf}{$_->[1]} = Gtk2::Entry->new,
- key_press_event => $apply),
- ));
- } ([ N("Operating Mode"), "WIRELESS_MODE" ],
- [ N("Network name (ESSID)"), "WIRELESS_ESSID" ],
- [ N("Network ID"), "WIRELESS_NWID" ],
- [ N("Operating frequency"), "WIRELESS_FREQ" ],
- [ N("Sensitivity threshold"), "WIRELESS_SENS" ],
- [ N("Bitrate (in b/s)"), "WIRELESS_RATE" ]
- ),
- ),
- Gtk2::VSeparator->new,
- gtkpack_(Gtk2::VBox->new(0,0),
- map { (0, gtkpack_(Gtk2::VBox->new(0,0),
- 1, Gtk2::Label->new($_->[0]),
- 0, gtksignal_connect($gui->{intf}{$_->[1]} = Gtk2::Entry->new,
- key_press_event => $apply),
- ));
- } ([ N("Encryption key"), 'WIRELESS_ENC_KEY' ],
- [ N("RTS/CTS"), 'WIRELESS_RTS' ],
- [ N("Fragmentation"), 'WIRELESS_FRAG' ],
- [ N("Iwconfig command extra arguments"), 'WIRELESS_IWCONFIG' ],
- [ N("Iwspy command extra arguments"), 'WIRELESS_IWSPY' ],
- [ N("Iwpriv command extra arguments"), 'WIRELESS_IWPRIV' ],
- ),
- ),
- );
- }
-
- if ($intf->{pages}{Options}) {
- gtkpack__(gtkset_border_width($gui->{sheet}{Options} = Gtk2::VBox->new(0,10), 5),
- $gui->{intf_bool}{ONBOOT} = gtksignal_connect(Gtk2::CheckButton->new(N("Start at boot")),
- toggled => $apply),
- if_($is_ethernet,
- map { ($gui->{intf_bool}{$_->[0]} = gtksignal_connect(Gtk2::CheckButton->new($_->[1]),
- toggled => $apply))
- } ([ "HWADDR", N("Track network card id (useful for laptops)") ],
- [ "MII_NOT_SUPPORTED", N("Network Hotplugging") ],
- ),
- ),
- if_($interface eq 'isdn',
- gtkpack(Gtk2::HBox->new(0,0),
- gtkpack__(Gtk2::VBox->new(0,0),
- Gtk2::Label->new(N("Dialing mode")),
- my @dialing_mode_radio = gtkradio(("auto") x 2, "manual"),
- ),
- Gtk2::VSeparator->new,
- gtkpack__(Gtk2::VBox->new(0,0),
- Gtk2::Label->new(N("Connection speed")),
- my @speed_radio = gtkradio(("64 Kb/s") x 2, "128 Kb/s"),
- ),
- ),
- gtkpack__(Gtk2::HBox->new(0,5),
- Gtk2::Label->new(N("Connection timeout (in sec)")),
- gtksignal_connect($gui->{intf}{huptimeout} = Gtk2::Entry->new,
- key_press_event => $apply),
- ),
- ),
- gtkpack__(Gtk2::HBox->new(0,5),
- Gtk2::Label->new(N("Metric")),
- gtksignal_connect(gtkset_text($gui->{intf}{METRIC} = Gtk2::Entry->new, $intf->{METRIC}),
- key_press_event => $apply)),
-
- );
- $dialing_mode_radio[0]->signal_connect(toggled => sub { $gui->{intf_radio}{dialing_mode} = 'auto'; $apply->() });
- $dialing_mode_radio[1]->signal_connect(toggled => sub { $gui->{intf_radio}{dialing_mode} = 'static'; $apply->() });
- $speed_radio[0]->signal_connect(toggled => sub { $gui->{intf_radio}{speed} = '64'; $apply->() });
- $speed_radio[1]->signal_connect(toggled => sub { $gui->{intf_radio}{speed} = '128'; $apply->() });
- $gui->{intf_bool}{ONBOOT}->set_active($interface eq 'adsl' ? adsl_atboot() : ($intf->{ONBOOT} eq 'yes' ? 1 : 0));
- $gui->{intf_bool}{MII_NOT_SUPPORTED}->set_active($intf->{MII_NOT_SUPPORTED} eq 'no' ? 1 : 0);
- $gui->{intf_bool}{HWADDR}->set_active($intf->{HWADDR});
- }
-
- if ($intf->{pages}{Account}) {
- if ($interface_name =~ /^speedtouch|sagem$/) {
- $gui->{description} = $interface_name eq 'speedtouch' ? 'Alcatel|USB ADSL Modem (Speed Touch)' : 'Analog Devices Inc.|USB ADSL modem';
- }
- gtkpack_(gtkset_border_width($gui->{sheet}{Account} = Gtk2::VBox->new(0,10), 5),
- if_($interface eq 'modem',
- 0, gtkpack(Gtk2::VBox->new(1,0),
- gtkpack__(Gtk2::HBox->new, Gtk2::Label->new(N("Authentication"))),
- gtkpack__(Gtk2::HBox->new, $gui->{intf}{auth} = gtksignal_connect(Gtk2::ComboBox->new_text,
- changed => $apply)),
- )),
- map { (0, gtkpack(Gtk2::VBox->new(1,0),
- gtkpack__(Gtk2::HBox->new, Gtk2::Label->new($_->[0])),
- gtkpack__(Gtk2::HBox->new, $gui->{intf}{$_->[1]} = gtksignal_connect(Gtk2::Entry->new,
- key_press_event => $apply)),
- ),
- );
- } ([ N("Account Login (user name)"), 'login' ],
- [ N("Account Password"), 'passwd' ],
- if_($interface =~ /^(isdn|modem)$/, [ N("Provider phone number"), $1 eq 'modem' ? 'phone' : 'phone_out' ]),
- ),
- );
-
- if ($interface eq 'modem') {
- my %auth_methods = map_index { $::i => $_ } N("PAP"), N("Terminal-based"), N("Script-based"), N("CHAP"), N("PAP/CHAP");
- $gui->{intf}{auth}->set_popdown_strings(sort values %auth_methods);
- $gui->{intf}{auth}->set_text($auth_methods{$intf->{Authentication}});
- }
- $gui->{intf}{passwd}->set_visibility(0);
- }
-
- if ($intf->{pages}{Modem}) {
- gtkpack(gtkset_border_width($gui->{sheet}{Modem} = Gtk2::HBox->new(0,10), 5),
- if_($interface eq 'modem',
- gtkpack__(Gtk2::VBox->new(0,5),
- (map { (gtkpack(Gtk2::VBox->new(1,0),
- gtkpack__(Gtk2::HBox->new, Gtk2::Label->new($_->[0])),
- gtkpack__(Gtk2::HBox->new, $gui->{intf}{$_->[1]} = gtksignal_connect(Gtk2::ComboBox->new_text,
- changed => $apply)),
- ),
- ),
- } ([ N("Flow control"), 'FlowControl' ],
- [ N("Line termination"), 'Enter' ],
- [ N("Connection speed"), 'Speed' ],
- )),
- # gtkpack(Gtk2::VBox->new(0,0), # no relative kppp option found :-(
- # Gtk2::Label->new(N("Dialing mode")),
- # gtkradio('', N("Tone dialing"), N("Pulse dialing")),
- # ),
- ),
- Gtk2::VSeparator->new,
- gtkpack__(Gtk2::VBox->new(0,10),
- gtkpack__(Gtk2::HBox->new(0,5),
- Gtk2::Label->new(N("Modem timeout")),
- $gui->{intf}{Timeout} = gtksignal_connect(Gtk2::SpinButton->new(Gtk2::Adjustment->new($intf->{Timeout}, 0, 120, 1, 5, 0), 0, 0),
- value_changed => $apply),
- ),
- gtksignal_connect($gui->{intf_bool}{UseLockFile} = Gtk2::CheckButton->new(N("Use lock file")),
- toggled => $apply),
- gtkpack__(Gtk2::HBox->new, gtksignal_connect($gui->{intf_bool}{WaitForDialTone} = Gtk2::CheckButton->new(N("Wait for dialup tone before dialing")),
- toggled => $apply)),
- gtkpack__(Gtk2::HBox->new(0,5),
- Gtk2::Label->new(N("Busy wait")),
- $gui->{intf}{BusyWait} = gtksignal_connect(Gtk2::SpinButton->new(Gtk2::Adjustment->new($intf->{BusyWait}, 0, 120, 1, 5, 0), 0, 0),
- value_changed => $apply),
- ),
- gtkpack__(Gtk2::HBox->new(0,5),
- Gtk2::Label->new(N("Modem sound")),
- gtkpack__(Gtk2::VBox->new(0,5), my @volume_radio = gtkradio('', N("Enable"), N("Disable"))),
- ),
- ),
- ),
- if_($interface eq 'isdn',
- gtkpack_(Gtk2::VBox->new(0,0),
- map { (0, gtkpack(Gtk2::VBox->new(1,0),
- gtkpack__(Gtk2::HBox->new, Gtk2::Label->new($_->[0])),
- gtkpack__(Gtk2::HBox->new, $gui->{intf}{$_->[1]} = gtksignal_connect(Gtk2::Entry->new,
- key_press_event => $apply)),
- ),
- );
- } ([ N("Card IRQ"), 'irq' ],
- [ N("Card mem (DMA)"), 'mem' ],
- [ N("Card IO"), 'io' ],
- [ N("Card IO_0"), 'io0' ],
- ),
- ),
- Gtk2::VSeparator->new,
- gtkpack__(Gtk2::VBox->new(0,0),
- Gtk2::Label->new(N("Protocol")),
- my @protocol_radio = gtkradio('', N("European protocol (EDSS1)"),
- N("Protocol for the rest of the world\nNo D-Channel (leased lines)")),
- ),
- ),
- );
- $protocol_radio[0]->signal_connect(toggled => sub { $gui->{intf_radio}{protocol} = 2; $apply->() });
- $protocol_radio[1]->signal_connect(toggled => sub { $gui->{intf_radio}{protocol} = 3; $apply->() });
- $volume_radio[0]->signal_connect(toggled => sub { $gui->{intf_radio}{Volume} = 1; $apply->() });
- $volume_radio[1]->signal_connect(toggled => sub { $gui->{intf_radio}{Volume} = 0; $apply->() });
- $gui->{intf}{FlowControl}->set_popdown_strings('Hardware [CRTSCTS]', 'Software [XON/XOFF]', 'None');
- $gui->{intf}{Enter}->set_popdown_strings('CR', 'CF', 'CR/LF');
- $gui->{intf}{Speed}->set_popdown_strings('2400', '9600', '19200', '38400', '57600', '115200');
- }
-
- if ($intf->{pages}{Information}) {
- my ($info) = $gui->{description} ?
- find { $_->{description} eq $gui->{description} } detect_devices::probeall : network::ethernet::mapIntfToDevice($interface_name);
- my @intfs = grep { $interface_name eq $_->[0] } @all_cards;
- if (is_empty_hash_ref($info) && @intfs == 1) {
- my $driver = $intfs[0][1];
- my @cards = grep { $_->{driver} eq $driver } detect_devices::probeall();
- @cards == 1 and $info = $cards[0];
- }
-
- gtkpack(gtkset_border_width($gui->{sheet}{Information} = Gtk2::VBox->new(0,10), 5),
- gtktext_insert(Gtk2::TextView->new,
- join('',
- map { $_->[0] . ": \x{200e}" . $_->[1] . "\n" } (
- [ N("Vendor"), split('\|', $info->{description}) ],
- [ N("Description"), reverse split('\|', $info->{description}) ],
- [ N("Media class"), $info->{media_type} || '-' ],
- [ N("Module name"), $info->{driver} || '-' ],
- [ N("Mac Address"), c::get_hw_address($interface_name) || '-' ],
- [ N("Bus"), $info->{bus} || '-' ],
- [ N("Location on the bus"), $info->{pci_bus} || '-' ],
- )
- )
- ),
- );
- }
-
- foreach (keys %{$gui->{intf}}) {
- next if ref($gui->{intf}{$_}) !~ /Gtk2::(ComboBox|Entry)/;
- # skip unset fields:
- next if !$intf->{$_};
- # special case b/c of translation:
- next if member($_, qw(BOOTPROTO ));
- if ($_ eq "FlowControl") {
- # kppp is writing translated strings :-( (eg: s/Software/Logiciel/):
- # (let's hope that all translations use 'CRTSCTS' and 'XON/OFF' as substring)
- $gui->{intf}{$_}->set_text('Hardware [CRTSCTS]') if $intf->{$_} =~ /CRTSCTS/;
- $gui->{intf}{$_}->set_text('Software [XON/XOFF]') if $intf->{$_} =~ m!XON/XOFF!;
- } else {
- $gui->{intf}{$_}->set_text($intf->{$_});
- }
- }
-
- $gui->{notebook} = Gtk2::Notebook->new;
- populate_notebook($gui->{notebook}, $gui);
-}
-
-sub populate_notebook {
- my ($notebook, $gui) = @_;
- foreach ('TCP/IP', 'Account', 'Wireless', 'Modem', 'Options', 'Information') {
- !$gui->{sheet}{$_} and next;
- $notebook->append_page($gui->{sheet}{$_}, Gtk2::Label->new(translate($_)));
- }
-}
-
-sub save {
- my ($netc, $p, $apply_button) = @_;
-
- my $dialog = _create_dialog(N("Please wait"));
- gtkpack($dialog->vbox,
- gtkshow(Gtk2::Label->new(N("Please Wait... Applying the configuration"))));
- $dialog->show_all;
- gtkset_mousecursor_wait();
-
- Glib::Timeout->add(200, sub {
- gtkflush();
- foreach (keys %$p) {
- save_notebook($netc, $p->{$_}{intf}, $p->{$_}{gui}) or return;
- $p->{$_}{intf}{save} ? $p->{$_}{intf}{save}->() : apply($netc, $p->{$_}{intf});
- }
-
- system("/etc/rc.d/init.d/network restart");
- $dialog->response(0);
- });
- $dialog->run;
-
- $apply_button->set_sensitive(0);
- gtkset_mousecursor_normal();
- $dialog->destroy;
-}
-
-sub save_notebook {
- my ($netc, $intf, $gui) = @_;
-
- $netc->{$_} = $gui->{netc}{$_}->get_text foreach keys %{$gui->{netc}};
- $gui->{intf}{$_} and $intf->{$_} = $gui->{intf}{$_}->get_text foreach keys %{$gui->{intf}};
- $gui->{intf_radio}{$_} and $intf->{$_} = $gui->{intf_radio}{$_} foreach keys %{$gui->{intf_radio}};
- $intf->{$_} = bool2yesno($gui->{intf_bool}{$_}->get_active) foreach keys %{$gui->{intf_bool}};
- $gui->{intf_bool}{MII_NOT_SUPPORTED} and $intf->{MII_NOT_SUPPORTED} = bool2yesno(!$gui->{intf_bool}{MII_NOT_SUPPORTED}->get_active);
- $gui->{intf_bool}{HWADDR} and (bool2yesno($gui->{intf_bool}{HWADDR}->get_active) eq 'yes' ? ($intf->{HWADDR} = 'yes') : delete $intf->{HWADDR});
-
- if (my $proto = $gui->{intf}{BOOTPROTO}) {
- $intf->{BOOTPROTO} = { reverse %{$proto->{protocols}} }->{$proto->get_text};
- }
- if ($intf->{BOOTPROTO} eq 'static') {
- check_field($intf, 'IPADDR', 'NETMASK') or $in->ask_warn(N("Error"), N("IP address should be in format 1.2.3.4")) and return 0;
- }
- if ($netc->{GATEWAY}) {
- check_field($netc, 'GATEWAY') or $in->ask_warn(N("Error"), N("Gateway address should be in format 1.2.3.4")) and return 0;
- }
- 1;
-}
-
-sub check_field {
- my ($field, @ip) = @_;
- (map { if_(!is_ip($field->{$_}), 1) } @ip) ? 0 : 1;
-}
-
-sub add_intf() {
- $::isWizard = 1;
- network::netconnect::main('', $netcnx, $in, $modules_conf, $netc, undef, $intf);
- $in->exit(0);
-}
-
-sub del_intf() {
- my ($intf2delete, $faillure);
- if (!keys %$intf) {
- $in->ask_warn(N("Error"), N("No ethernet network adapter has been detected on your system. Please run the hardware configuration tool."));
- $in->exit(0);
- }
- @all_cards = network::ethernet::get_eth_cards($modules_conf);
- my %ethernet_names = network::ethernet::get_eth_cards_names(@all_cards);
- my $wiz =
- {
- defaultimage => "drakconnect.png",
- name => N("Remove a network interface"),
- pages => {
- welcome => {
- no_back => 1,
- name => N("Select the network interface to remove:"),
- data => [ { label => N("Net Device"), val => \$intf2delete, allow_empty_list => 1,
- list => [ keys %$intf ],
- format => sub {
- my $type = network::tools::get_interface_type($intf->{$_[0]});
- $ethernet_names{$_[0]} || ($type ? "$type ($_[0])" : $_[0])
- }
- }
- ],
- post => sub {
- !$::testing and eval {
- if (member($intf2delete, qw(adsl modem))) {
- eval { rm_rf("/etc/ppp/peers/ppp0") };
- eval { rm_rf("/etc/sysconfig/network-scripts/ifcfg-ppp0") };
- }
- if ($intf2delete eq 'adsl') {
- eval { rm_rf("/etc/sysconfig/network-scripts/ifcfg-sagem") };
- } elsif ($intf2delete eq 'isdn') {
- eval { rm_rf("/etc/sysconfig/network-scripts/ifcfg-ippp0") };
- } else {
- system("ifdown $intf2delete");
- eval { rm_rf("/etc/sysconfig/network-scripts/$intf2delete") };
- eval { rm_rf("/etc/sysconfig/network-scripts/ifcfg-$intf2delete") };
- }
- };
- $faillure = $@;
- return "end";
- },
- },
- end => {
- name => sub {
- ($faillure ?
- N("An error occurred while deleting the \"%s\" network interface:\n\n%s",
- $intf2delete, $faillure) :
- N("Congratulations, the \"%s\" network interface has been successfully deleted", $intf2delete)
- )
- },
- end => 1,
- },
- },
- };
- require wizards;
- wizards->new->safe_process($wiz, $in);
- $in->exit(0);
-}
-
-sub get_intf_ip {
- my ($interface) = @_;
- my ($ip, $state, $mask);
- if (-x "/sbin/ifconfig") {
- local $_ = `LC_ALL=C LANGUAGE=C /sbin/ifconfig $interface`;
- $ip = /inet addr:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/mso ? $1 : N("No IP");
- $mask = /Mask:(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/mso ? $1 : N("No Mask");
- $state = /inet/ ? N("up") : N("down");
- } else {
- $ip = $intf->{$interface}{IPADDR};
- $state = "n/a";
- }
- ($ip, $state, $mask);
-}
-
-my %intf;
-
-sub update_list {
- my ($modules_conf) = @_;
- @all_cards = network::ethernet::get_eth_cards($modules_conf);
- my %new_intf = map { @$_ } @all_cards;
- my @new_intf = sort keys %new_intf;
- foreach my $interface (difference2(\@new_intf, [ keys %intf ])) {
- $intf{$interface} = $tree_model->append(undef);
- }
- foreach my $interface (@new_intf) {
- my ($ip, $state) = get_intf_ip($interface);
- $tree_model->set($intf{$interface}, map_index { $::i => $_ } (gtkcreate_pixbuf("eth_card_mini2.png"), $interface, $ip , $intf->{$interface}{BOOTPROTO}, $new_intf{$interface}, $state));
- }
- foreach my $i (difference2([ keys %intf ], \@new_intf)) {
- $tree_model->remove($intf{$i});
- delete $intf{$i};
- }
-}
-
-sub apply {
- my ($netc, $intf) = @_;
- my $dyn = $intf->{BOOTPROTO} ne 'static';
- my $lintf = $intf;
- #- always delete NETWORK and BROADCAST fields so that they get automatically recomputed by write_interface_conf
- delete $lintf->{$_} foreach qw(NETWORK BROADCAST), if_($dyn, qw(IPADDR NETMASK));
- network::network::sethostname($netc) if $dyn;
- network::network::configureNetwork2($in, $modules_conf, '', $netc, { $lintf->{DEVICE} => $lintf });
-}
-
-sub ethisup { `LC_ALL=C LANGUAGE=C /sbin/ifconfig $_[0]` =~ /inet/ }
-sub chk_internet() { `LC_ALL=C LANGUAGE=C /sbin/chkconfig --list | grep internet` =~ /:on/ ? 1 : 0 };
-sub adsl_atboot() { (any { /x--boot_time/ } cat_($network::tools::connect_file)) ? 0 : 1 };
-
-sub update_intbutt() {
- $int_state->set($isconnected ? N("Connected") : N("Not connected"));
- return if !$int_connect;
- $int_connect->child->set($isconnected ? N("Disconnect...") : N("Connect..."));
- $int_connect->set_sensitive(1);
-}
-
-my $to_update;
-sub update() {
- my $h = chomp_(`hostname`);
- $label_host->set_label($h);
- $int_label->set($netcnx->{type} eq 'lan' ? N("Gateway:") : N("Interface:"));
- $int_name->set($netcnx->{type} eq 'lan' ? $netc->{GATEWAY} : $netcnx->{NET_INTERFACE});
- update_list($modules_conf);
- update_intbutt() if $isconnected != -1;
- 1;
-}
-
-sub in_ifconfig {
- my ($intf) = @_;
- -e '/sbin/ifconfig' or return 1;
- $intf eq '' and return 1;
- `/sbin/ifconfig` =~ /$intf/;
-}
-
-sub update2() {
- undef $to_update;
- connected_bg(\$to_update);
- if (defined $to_update) {
- $isconnected = $to_update;
- if ($isconnected != -1) {
- if ($isconnected && !in_ifconfig($netcnx->{NET_INTERFACE})) {
- $warning_label1->set(N("Warning, another Internet connection has been detected, maybe using your network"));
- $isconnected = 0;
- } else { $warning_label1->set("") }
- update_intbutt();
- }
- }
- update();
- 1;
-}
-
-
-my $net_test;
-sub update_network_status() {
- unless ($net_test) {
- $net_test = network::test->new;
- $net_test->start;
- }
- if ($net_test->is_done) {
- $isconnected = $net_test->is_connected;
- update_intbutt();
- $net_test->start;
- }
- 1;
-}
-
-sub quit_global() {
- ugtk2->exit(0);
-}
-
-sub get_intf_status {
- my ($c) = @_;
- ethisup($c) ? N("Deactivate now") : N("Activate now")
-}
-
-sub configure_lan() {
- my $window = _create_dialog(N("LAN configuration"));
- my @card_tab;
-
- if (@all_cards < 1) {
- $window->vbox->add(Gtk2::Label->new(N("You don't have any configured interface.
-Configure them first by clicking on 'Configure'")));
- gtkpack(gtkset_layout($window->action_area, 'end'),
- gtksignal_connect(Gtk2::Button->new(N("Ok")),
- clicked => sub { Gtk2->main_quit })
- );
- $window->show_all;
- $window->run;
- $window->destroy;
- return;
- }
-
- $window->set_border_width(10);
- gtkpack($window->vbox,
- Gtk2::Label->new(N("LAN Configuration")),
- my $notebook = Gtk2::Notebook->new,
- );
-
- foreach (0..$#all_cards) {
- my @infos;
- my @conf_data;
- $card_tab[2*$_] = \@infos;
- $card_tab[2*$_+1] = \@conf_data;
-
- my $vbox_local = Gtk2::VBox->new(0,0);
- $vbox_local->set_border_width(10);
- $vbox_local->pack_start(Gtk2::Label->new(N("Adapter %s: %s", $_+1 , $all_cards[$_][0])),1,1,0);
- # Eth${_}Hostname = $netc->{HOSTNAME}
- # Eth${_}HostAlias = " . do { $netc->{HOSTNAME} =~ /([^\.]*)\./; $1 } . "
- # Eth${_}Driver = $all_cards[$_]->[1]
- my $interface = $all_cards[$_][0];
- my ($ip, undef, $mask) = get_intf_ip($interface);
- $mask ||= $intf->{$interface}{NETMASK};
- @conf_data = ([ N("IP address"), \$ip ],
- [ N("Netmask"), \$mask ],
- [ N("Boot Protocol"), \$intf->{$interface}{BOOTPROTO}, ["static", "dhcp", "bootp"] ],
- [ N("Started on boot"), \$intf->{$interface}{ONBOOT} , ["yes", "no"] ],
- [ N("DHCP client"), \$netcnx->{dhcp_client} ]
- );
- my $i = 0;
- my $size_group = Gtk2::SizeGroup->new('horizontal');
-
- foreach my $j (@conf_data) {
- my $l = Gtk2::Label->new($j->[0]);
- $l->set_justify('left');
- $infos[2*$i] = gtkpack_(Gtk2::HBox->new,
- 1, $l);
- $vbox_local->pack_start($infos[2*$i], 1, 1, 0);
- my $c;
- if (defined $j->[2]) {
- $c = Gtk2::ComboBox->new_text;
- $c->set_popdown_strings(@{$j->[2]});
- $infos[2*$i+1] = $c->entry;
- $infos[2*$i]->pack_start($c,0,0,0);
- } else {
- $infos[2*$i+1] = ($c = Gtk2::Entry->new);
- $infos[2*$i]->pack_start($infos[2*$i+1],0,0,0);
- }
- $size_group->add_widget($c);
- $infos[2*$i+1]->set_text(${$j->[1]});
- $i++;
- }
-
- my $widget_temp;
- if (-e "/etc/sysconfig/network-scripts/ifcfg-$interface") {
- $widget_temp = gtksignal_connect(Gtk2::Button->new(get_intf_status($interface)),
- clicked => sub {
- system("/sbin/if" . (ethisup($interface) ? N("down") : N("up")) . " $interface");
- $_[0]->set_label(get_intf_status($interface));
- update();
- });
- } else {
- $widget_temp = N("This interface has not been configured yet.\nRun the \"Add an interface\" assistant from the Mandrakelinux Control Center");
- }
- $vbox_local->pack_start(gtkpack__(Gtk2::HBox->new(0,0),
- $widget_temp
- ),0,0,0);
- # $list->append($_+1, $interface, $intf->{$interface}{IPADDR}, $intf->{$interface}{BOOTPROTO}, $all_cards[$_]->[1]);
- # $list->set_selectable($_, 0);
- $notebook->append_page($vbox_local, Gtk2::Label->new($interface));
- }
-
- my $exit_dialogsub = sub {
- $window->destroy;
- Gtk2->main_quit;
- };
-
- gtkpack($window->action_area,
- gtksignal_connect(Gtk2::Button->new(N("Cancel")),
- clicked => $exit_dialogsub),
- gtksignal_connect(Gtk2::Button->new(N("Ok")), clicked => sub {
- foreach (0..$#all_cards) {
- my @infos = @{$card_tab[2*$_]};
- each_index { ${$_->[1]} = $infos[2*$::i+1]->get_text } @{$card_tab[2*$_+1]};
- my $interface = $all_cards[$_][0];
- if ($intf->{$interface}{BOOTPROTO} ne "static") {
- delete @{$intf->{$interface}}{qw(IPADDR NETWORK NETMASK BROADCAST)};
- } else {
- if ($infos[1]->get_text ne "No ip") {
- $intf->{$interface}{IPADDR} = $infos[1]->get_text;
- $intf->{$interface}{NETMASK} = $infos[3]->get_text;
- }
- }
- }
- update();
- $button_apply->set_sensitive(1);
- $exit_dialogsub->();
- }),
- );
-
- $window->show_all;
- foreach (0..$#all_cards) {
- my @infos = @{$card_tab[2*$_]};
- $intf->{$all_cards[$_][0]}{BOOTPROTO} eq "dhcp" or $infos[8]->hide;
- }
- $window->run;
-}
-
-
-sub configure_net {
- my ($netcnx, $netc, $_intf) = @_;
- my $dialog = ugtk2->new('drakconnect');
- my $exit_dialogsub = sub { Gtk2->main_quit };
- if (!$netcnx->{type}) {
- $in->ask_warn(
- N("Warning"),
- #-PO: here "Add Connection" should be translated the same was as in control-center
- N("You don't have any configured Internet connection.
-Run the \"Add Connection\" assistant from the Mandrakelinux Control Center"));
- $in->exit;
- }
- my $cnx = {};
- $cnx = $netcnx->{$netcnx->{type}};
- unless ($::isEmbedded) {
- $dialog->{rwindow}->set_position('center');
- $dialog->{rwindow}->set_title(N("Internet connection configuration"));
- $dialog->{rwindow}->set_size_request(-1, -1);
- $dialog->{rwindow}->set_icon(gtkcreate_pixbuf("drakconnect"));
- }
- $dialog->{rwindow}->signal_connect(delete_event => $exit_dialogsub);
-
- my $param_vbox = Gtk2::VBox->new(0,0);
- my $i = 0;
-
- #- duplicated code (waiting for 9.1 to be out to merge everything correctly, avoid bug elsewhere).
- if ($netcnx->{type} =~ /adsl/) {
- require network::adsl;
- network::adsl::adsl_probe_info($cnx, $netc, $intf);
- }
- my @conf_data = (
- [ N("Host name (optional)"), \$netc->{HOSTNAME} ],
- [ N("First DNS Server (optional)"), \$netc->{dnsServer} ], # \$cnx->{dns1}
- [ N("Second DNS Server (optional)"), \$netc->{dnsServer2} ], #\$cnx->{dns2}
- [ N("Third DNS server (optional)"), \$netc->{dnsServer3} ],
- );
- my @infos;
- gtkpack($param_vbox,
- create_packtable({},
- map {
- my $c;
- if (defined $_->[2]) {
- $c = Gtk2::Combo->new;
- $c->set_popdown_strings(@{$_->[2]});
- $infos[2*$i+1] = $c->entry;
- } else {
- $c = $infos[2*$i+1] = Gtk2::Entry->new;
- }
- $infos[2*$i+1]->set_text(${$_->[1]});
- $i++;
- [ $_->[0], $c ];
- } @conf_data
- )
- );
-
- $dialog->{rwindow}->add(gtkpack_(Gtk2::VBox->new,
- 0, Gtk2::Label->new(N("Internet Connection Configuration")),
- 1, gtkadd(gtkcreate_frame(N("Internet access")),
- gtkset_border_width(create_packtable({ col_spacings => 5, row_spacings => 5, homogenous => 1 },
- [ Gtk2::Label->new(N("Connection type: ")),
- Gtk2::Label->new(translate($netcnx->{type})) ],
- [ $int_label, $int_name ],
- [ Gtk2::Label->new(N("Status:")),
- $int_state = Gtk2::Label->new(N("Testing your connection...")) ]
- ),
- 5),
- ),
- 1, gtkadd(gtkcreate_frame(N("Parameters")), gtkset_border_width($param_vbox, 5)),
- 0, gtkpack(create_hbox('edge'),
- gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => $exit_dialogsub),
- gtksignal_connect(Gtk2::Button->new(N("Ok")), clicked => sub {
- foreach my $i (0..$#conf_data) {
- ${$conf_data[$i][1]} = $infos[2*$i+1]->get_text;
- };
- # called from old GUI?
- if ($label_host) {
- update();
- $button_apply->set_sensitive(1);
- } else {
- configureNetwork2($in, $modules_conf, '', $netc, $intf);
- write_resolv_conf("/etc/resolv.conf", $netc);
- }
- $exit_dialogsub->();
- }),
- ),
- ),
- );
-
- $dialog->{rwindow}->show_all;
- update_network_status();
- Glib::Timeout->add(2000, \&update_network_status);
- $dialog->main;
- ugtk2->exit(0);
-}
-
diff --git a/perl-install/standalone/drakedm b/perl-install/standalone/drakedm
deleted file mode 100644
index b5fb82ae4..000000000
--- a/perl-install/standalone/drakedm
+++ /dev/null
@@ -1,85 +0,0 @@
-#!/usr/bin/perl
-# DrakxDM -- Display Manager chooser
-# Copyright (C) 2003-2004 Mandrakesoft (tvignaud@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use common;
-use any;
-use interactive;
-use services;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/drakedm-mdk.png";
-
-my $in = 'interactive'->vnew('su');
-
-my $cfg_file = '/etc/sysconfig/desktop';
-
-my %dm = ('GNOME' => [ N("GDM (GNOME Display Manager)"), '/usr/bin/gdm', 'gdm' ],
- 'KDM' => [ N("KDM (KDE Display Manager)"), '/usr/bin/kdm', 'kdebase-kdm' ],
- 'KDE' => [ N("MdkKDM (Mandrakelinux Display Manager)"), '/usr/bin/mdkkdm', 'mdkkdm' ],
- 'XDM' => [ N("XDM (X Display Manager)"), '/usr/bin/X11/xdm', 'xorg-x11' ],
- );
-
-my $dm;
-
-foreach (cat_($cfg_file)) {
- $dm = uc($1) if /^DISPLAYMANAGER=(.*)$/;
-}
-
-if (!$dm) {
- $dm = 'KDE';
- log::explanations("Defaulting to $dm for display manager")
-}
-
-my @raw_list = sort keys %dm;
-my @list = $::expert ? @raw_list : (grep { -e $dm{$_}->[1] } @raw_list);
-
-start:
-if ($in->ask_from(N("Choosing a display manager"),
- formatAlaTeX(N("X11 Display Manager allows you to graphically log
-into your system with the X Window System running and supports running
-several different X sessions on your local machine at the same time.")),
- [
- {
- allow_empty_list => 1,
- list => \@list,
- val => \$dm,
- type => 'list',
- format => sub { $dm{$_[0]}[0] },
- sort => 1,
- }
- ]
- )
- ) {
- ! -x $dm{$dm}[1] and do { $in->do_pkgs->ensure_is_installed($dm{$dm}[2], $dm{$dm}[1]) or goto start };
- substInFile {
- s/^(DISPLAYMANAGER)=.*(\n|)//;
- s/^\n//g;
- $_ .= "\nDISPLAYMANAGER=$dm\n" if eof;
- } $cfg_file;
- log::explanations(qq(Switching to "$dm" display manager));
- if (any::running_window_manager()) {
- $in->ask_yesorno('', N("The change is done, do you want to restart the dm service?"), 1) and
- $in->ask_yesorno('', N("You are going to close all running programs and lose your current session. Are you really sure that you want to restart the dm service?"), 1) and
- run_program::run("nohup", "/etc/rc.d/init.d/dm", "restart");
- }
-}
-
-$in->exit(0);
diff --git a/perl-install/standalone/drakfirewall b/perl-install/standalone/drakfirewall
deleted file mode 100755
index afd5abd13..000000000
--- a/perl-install/standalone/drakfirewall
+++ /dev/null
@@ -1,32 +0,0 @@
-#!/usr/bin/perl
-
-# Copyright (C) 1999-2004 Mandrakesoft (pixel@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use network::drakfirewall;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/firewall-mdk.png";
-
-my $in = 'interactive'->vnew('su');
-
-network::drakfirewall::main($in, undef);
-
-$in->exit;
diff --git a/perl-install/standalone/drakfloppy b/perl-install/standalone/drakfloppy
deleted file mode 100755
index e94ee0225..000000000
--- a/perl-install/standalone/drakfloppy
+++ /dev/null
@@ -1,341 +0,0 @@
-#!/usr/bin/perl
-
-# DrakFloppy
-# $Id$
-#
-# Copyright (C) 2001-2004 Mandrakesoft
-# Yves Duret
-# Thierry Vignaud
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-use strict;
-use diagnostics;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use common;
-use ugtk2 qw(:create :dialogs :helpers :wrappers);
-use detect_devices;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/drakfloppy-mdk.png";
-require_root_capability();
-
-my $window = ugtk2->new('drakfloppy');
-unless ($::isEmbedded) {
- $window->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) });
- $window->{rwindow}->set_title(N("drakfloppy"));
- $window->{rwindow}->set_border_width(5);
-
- ### menus definition
- # the menus are not shown but they provides shiny shortcut like C-q
- create_factory_menu($window->{rwindow}, (
- { path => N("/_File"), item_type => '<Branch>' },
- { path => N("/File/_Quit"), accelerator => N("<control>Q"), callback => sub { ugtk2->exit(0) } },
- )
- );
-}
-
-
-my (@modules, @temp_modules, %buttons, %options, $tree_model, $tree, $list_model, $list);
-
-my $conffile = "/etc/sysconfig/drakfloppy";
-
-# we must be robust against config file parsing
-eval { %options = getVarsFromSh($conffile) };
-@modules = split(' ', $options{MODULES});
-
-
-######## up part
-
-# device part
-my $device_combo = Gtk2::ComboBox->new_with_strings([ map { "/dev/" . $_->{device} } detect_devices::floppies() ]);
-$device_combo->set_active(0);
-
-# kernel part
-my $kernel_combo = Gtk2::ComboBox->new_with_strings([ sort grep { !/^\.\.?$/ } sort(all("/lib/modules")) ], chomp_(`uname -r`));
-
-
-##########################################################
-
-### main window
-$window->{window}->add(
- gtkpack_(Gtk2::VBox->new,
- if_($::isEmbedded, 0, Gtk2::Label->new(N("Boot disk creation"))),
- 0, gtkadd(Gtk2::Frame->new(N("General")),
- gtkpack__(Gtk2::VBox->new(0, 0),
- gtkpack__(Gtk2::HBox->new(1, 0),
- Gtk2::Label->new(N("Device")),
- $device_combo,
- gtksignal_connect(Gtk2::Button->new(N("Default")),
- clicked => sub { $device_combo->entry->set_text("/dev/fd0") }),
- ),
- gtkpack__(Gtk2::HBox->new(1, 0),
- Gtk2::Label->new(N("Kernel version")),
- $kernel_combo,
- gtksignal_connect(Gtk2::Button->new(N("Default")),
- clicked => sub {
- $kernel_combo->entry->set_text(chomp_(`uname -r`));
- }),
- ),
- ),
- ),
- 1, Gtk2::VBox->new,
- 0, create_okcancel({
- cancel_clicked => sub { ugtk2->exit(0) },
- ok_clicked => \&build_it,
- },
- undef, undef, '',
- [ N("Preferences"), \&pref_dialog, 0 ],
- ),
- ),
- );
-
-$window->{rwindow}->show_all;
-
-$window->main;
-ugtk2->exit(0);
-
-
-my $remove_but;
-
-sub pref_dialog() {
- my $dialog = gtkset_modal(gtkset_size_request(_create_dialog(N("Advanced preferences")), 600, -1), 1);
- $dialog->set_transient_for($window->{rwindow}) unless $::isEmbedded;
-
-
- # Create root tree:
- $tree_model = Gtk2::TreeStore->new(("Glib::String") x 2, "Glib::Int");
- $tree = Gtk2::TreeView->new_with_model($tree_model);
- $tree->set_headers_visible(0);
- $tree->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $tree->signal_connect('row-expanded', \&expand_tree);
- $tree->get_selection->signal_connect('changed' => \&selected_tree);
-
- # Create modules list:
- $list_model = Gtk2::ListStore->new(("Glib::String") x 3); # relative path, size, (hidden full path)
- $list = Gtk2::TreeView->new_with_model($list_model);
- each_index {
- $list->append_column(my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i));
- $col->set_sort_column_id($::i);
- $col->set_min_width((200, 50)[$::i]);
- } (N("Module name"), N("Size"));
-
- gtkpack_($dialog->vbox,
- 0, gtkadd(Gtk2::Frame->new(N("Mkinitrd optional arguments")),
- gtkpack__(Gtk2::VBox->new(0, 5),
- $buttons{force} = Gtk2::CheckButton->new(N("force")),
- $buttons{raid} = Gtk2::CheckButton->new(N("omit raid modules")),
- $buttons{needed} = Gtk2::CheckButton->new(N("if needed")),
- $buttons{scsi} = Gtk2::CheckButton->new(N("omit scsi modules")),
- ),
- ),
- 1, gtkadd(Gtk2::Frame->new(N("Add a module")),
- create_hpaned(
- gtkset_size_request(
- create_scrolled_window($tree),
- 200, $::isEmbedded ? 0 : 175),
- gtkpack_(Gtk2::VBox->new(0, 0),
- 1, gtkadd(Gtk2::ScrolledWindow->new,
- $list
- ),
- 0, gtksignal_connect($remove_but = Gtk2::Button->new(N("Remove a module")),
- clicked => sub {
- my $iter = ($list->get_selection->get_selected)[1];
- return unless $iter;
- my $removed = $list_model->get($iter, 2);
- $list_model->remove($iter);
- @temp_modules = grep { $_ ne $removed } @temp_modules;
- $remove_but->set_sensitive(scalar @temp_modules);
- }),
- ),
- ),
- ),
- );
-
- # restore values:
- $buttons{$_}->set_active($options{$_}) foreach keys %buttons;
- fill_tree($kernel_combo->entry->get_text);
- foreach my $module (@modules) {
- my $full_path = join('/', "/lib/modules", $kernel_combo->entry->get_text, $module);
- $full_path =~ s/\.(ko|o)(|.gz)//;
- my $size = get_file_size(glob_("$full_path.*"));
- $list_model->append_set(map_index { $::i => $_ } $module, $size, $full_path);
- }
-
- $remove_but->set_sensitive(scalar @modules);
- @temp_modules = ();
-
- gtkadd($dialog->action_area,
- create_okcancel({
- cancel_clicked => sub { $dialog->destroy },
- ok_clicked => sub {
- # save values:
- $options{$_} = $buttons{$_}->get_active foreach keys %buttons;
- my $val;
- @modules = ();
- $list_model->foreach(sub {
- my ($model, $_path, $iter) = @_;
- push @modules, $model->get($iter, 0);
- return 0;
- }, $val);
- $dialog->destroy;
- },
- }),
- );
- $dialog->show_all;
- $dialog->run;
-}
-
-#-------------------------------------------------------------
-# tree functions
-#-------------------------------------------------------------
-### Subroutines
-
-sub fill_tree {
- my ($root_dir) = @_;
- $root_dir = "/lib/modules/" . $root_dir;
- # Create root tree item widget
- my $parent_iter = $tree_model->append_set(undef, [ 0 => $root_dir, 1 => $root_dir, 2 => has_sub_trees($root_dir) ]);
-
- # Create the subtree
- expand_tree($tree, $parent_iter, $tree_model->get_path($parent_iter)) if has_sub_trees($root_dir);
-}
-
-
-# Called whenever an item is clicked on the tree widget.
-sub selected_tree {
- my ($select) = @_;
- my ($model, $iter) = $select->get_selected;
- $remove_but->set_sensitive($model && $iter);
-
- return unless $model; # no real selection
- my $file = $model->get($iter, 1);
-
- return if -d $file;
-
- my $size = get_file_size($file);
-
- return if member($file, @temp_modules);
- push @temp_modules, $file;
- $list_model->append_set([ 0 => stripit($file), 1 => $size, 2 => $file ]);
-}
-
-# Callback for expanding a tree - find subdirectories, files and add them to tree
-sub expand_tree {
- my ($tree, $parent_iter, $path) = @_;
- return if !$tree || !$parent_iter;
- my $dir = $tree_model->get($parent_iter, 1);
-
- #- if we're hinted to be expandable
- if ($tree_model->get($parent_iter, 2)) {
- #- hackish: if first child has '' as name, then we need to expand on the fly
- if ($tree_model->iter_has_child($parent_iter)) {
- my $child = $tree_model->iter_children($parent_iter);
- # BUG: ->iter_children return invalid iterators !!! thus the dummy empty line
- $tree_model->remove($child);
- }
- # do not refill the parent anymore
- $tree_model->set($parent_iter, 2 => 0);
-
- foreach my $dir_entry (sort(all($dir))) {
- my $entry_path = $dir . "/" . $dir_entry;
- if (-d $entry_path || $dir_entry =~ /\.(k|)o(\.gz)?$/) {
- $entry_path =~ s|//|/|g;
- my $iter = $tree_model->append_set($parent_iter, [ 0 => $dir_entry, 1 => $entry_path, 2 => has_sub_trees($entry_path) ]);
- #- hackery for partial displaying of trees, used in rpmdrake:
- #- if leaf is void, we may create the parent and one child (to have the [+] in front of the parent in the ctree)
- #- though we use '' as the label of the child; then rpmdrake will connect on tree_expand, and whenever
- #- the first child has '' as the label, it will remove the child and add all the "right" children
- $tree_model->append_set($iter, [ 0 => '' ]) if has_sub_trees($entry_path);
- }
- }
- }
- $tree->expand_row($path, 0);
-}
-
-
-
-#-------------------------------------------------------------
-# the function
-#-------------------------------------------------------------
-sub build_it() {
- my $initrd_args = join(' ',
- if_($options{force}, "-f"),
- if_($options{needed}, "--ifneeded"),
- if_($options{scsi}, "--omit-scsi-modules"),
- if_($options{raid}, "--omit-raid-modules"),
- if_(@modules, map { my $i = $_; $i =~ s!.*/!!; "--with=$i" } @modules),
- );
- $initrd_args = qq(--mkinitrdargs "$initrd_args") if $initrd_args;
- my $co = join(' ', "/sbin/mkbootdisk --noprompt --verbose --device", $device_combo->entry->get_text, $initrd_args);
- $options{MODULES} = join(' ', @modules);
- setVarsInSh($conffile, \%options);
-
- $co .= " " . $kernel_combo->entry->get_text;
- $co .= " 2>&1 |";
- $::testing or warn_dialog(N("Warning"), N("Be sure a media is present for the device %s", $device_combo->entry->get_text)) or return;
- # we test if the media is present
- test:
- my $a = "dd count=1 if=/dev/null of=" . $device_combo->entry->get_text . " 2>&1";
- my $b = `$a`;
- if (!$::testing && $b =~ /dd/) {
- err_dialog(N("Error"), N("There is no medium or it is write-protected for device %s.\nPlease insert one.", $device_combo->entry->get_text), { cancel => 1 }) ? goto test : return 0;
- }
-
- local *STATUS;
- open STATUS, $co or do { err_dialog(N("Error"), N("Unable to fork: %s", $!)); return };
- my $log = join('', <STATUS>);
- if (close STATUS) {
- info_dialog(N("Floppy creation completed"), N("The creation of the boot floppy has been successfully completed \n"));
- ugtk2->exit;
- } else {
- err_dialog(N("Error"),
- #-PO: Do not alter the <span ..> and </span> tags
- N("Unable to properly close mkbootdisk:\n\n<span foreground=\"Red\"><tt>%s</tt></span>", $log), { use_markup => 1 });
- }
-
- return 0;
-}
-
-sub get_file_size {
- my ($file) = @_;
- (lstat($file))[7];
-}
-
-####
-# This is put at the end of the file because any translatable string
-# appearing after this will not be found by xgettext, and so wont end in
-# the pot file...
-####
-
-# Test whether a directory has subdirectories
-sub has_sub_trees {
- my ($dir) = @_;
-
- foreach my $file (glob_("$dir/*")) {
- return 1 if -d $file || $file =~ /\.(k|)o(\.gz)?$/;
- }
-
- return 0;
-}
-
-sub stripit {
- my ($file) = @_;
- $file =~ s|/lib/modules/.*?/||g;
- $file;
-}
diff --git a/perl-install/standalone/drakfont b/perl-install/standalone/drakfont
deleted file mode 100755
index 8ab5f5d8c..000000000
--- a/perl-install/standalone/drakfont
+++ /dev/null
@@ -1,796 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2001-2004 by Mandrakesoft
-# DUPONT Sebastien
-# Damien Chaumette <dchaumette@mandrakesoft.com>
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# drakfont Future Overview
-# - Fonts import:
-# pfb ( Adobe Type 1 binary )
-# pfa ( Adobe Type 1 ASCII )
-# ttf ( True-Type )
-# pcf.gz
-# Speedo
-# and Bitmap (PCF, BDF, and SNF)
-# - Features
-# - Install fonts from any directory
-# - Get windows fonts on any vfat partitions
-# - Get fonts on any partitions.
-# - UN-installation of any fonts (even if not installed through drakfont)
-# - Support
-# - Xfs
-# - ghostscript & printer
-# - Staroffice & printer
-# - abiword
-# - netscape
-# - Koffice, Gnumeric, ... studying
-# - all fonts supported by printer
-# - anti-aliases by RENDER in Xfree86 ....
-# supported by KDE.
-# will be supported by gnome 1.2.
-# Visual Interface:
-# Window interface:
-# - Fontselectiondialog widget
-# - Command buttons under Fontselectiondialog (like the actual frontend).
-# Commands buttons:
-# - import from windows partition.
-# import from all fat32 partitions and look for winnt/windows/font
-# and import all (delete doubles) but don't import if they already exist.
-# - import from directory
-# look to see if each font exists and do not delete the original.
-# (replace all, no, none)
-# expert options:
-# specify the directory, and look to see if it exists before
-# if it exists ask: (replace all, no, none)
-# - uninstall with list per font type
-# Expert additional switch
-# - option support: ghostscript, Staroffice, etc...
-# check-button. (by default all check)
-# - Printer Application Fonts Support...
-# check-button. (by default all check)
-#
-# TODO:
-# - Speedo and Bitmap (PCF, BDF, and SNF)
-#
-# REQUIRE:
-# - font-tools.*.mdk.i586.rpm
-#
-# USING:
-# - pfm2afm: by Ken Borgendale: Convert a Windows .pfm file to a .afm (Adobe Font Metrics)
-# - type1inst: by James Macnicol: type1inst generates files fonts.dir fonts.scale & Fontmap.
-# - ttf2pt1: by Andrew Weeks, Frank Siegert, Thomas Henlich, Sergey Babkin convert ttf font files to afm and pfb fonts
-#
-#
-# directory to install fonts /usr/X11R6/lib/X11/fonts/
-# -->> /usr/X11R6/lib/X11/fonts/drakfont
-
-use strict;
-use diagnostics;
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use ugtk2 qw(:create :dialogs :helpers :wrappers);
-use common;
-
-require_root_capability();
-
-$ugtk2::wm_icon = "drakfont";
-
-# global variables needed by each functions
-my $xlsfonts = 0;
-my $windows = 0;
-my $replace;
-my $so = 1;
-my $gs = 1;
-my $abi = 1;
-my $printer = 1;
-my $mode = -1;
-my @application;
-my @install;
-my @uninstall;
-my $interactive;
-my $dialog;
-my $pbar;
-my $pbar1;
-my $pbar2;
-my $pbar3;
-my $window1;
-my $model;
-my $list;
-my $list_all_font_path;
-my $left_list;
-my $right_list;
-my $left_model;
-my $right_model;
-
-foreach (@ARGV) {
- /--list|-l/ and $list_all_font_path = 1, $mode = -1;
- /--xls_fonts/ and $xlsfonts = 1, $mode = -1;
- /--windows_import|-wi/ and $windows = 1, $mode = -1;
- /--replace|-r/ and $replace = 1, $mode = -1;
- /--application/ and $mode = 0, next;
- $mode == 0 and push @application, $_;
- /--install/ and $mode = 1, next;
- $mode == 1 and push @install, $_;
- /--uninstall/ and $mode = 2, next;
- $mode == 2 and push @uninstall, $_;
-}
-
-foreach my $i (@application) {
- if ($i =~ /so/i) {
- if ($gs != 2) { $gs = 0 }
- $so = 2;
- }
- if ($i =~ /gs/i) {
- if ($so != 2) { $so = 0 }
- $gs = 2;
- }
-}
-
-# PATH and binary full path
-#my $xfs_conffile = '/etc/fonts/fonts.conf';
-my $drakfont_dir = '/usr/X11R6/lib/X11/fonts/drakfont';
-my $ttf2pt1 = '/usr/sbin/ttf2pt1';
-my $pfm2afm = '/usr/sbin/pfm2afm';
-my $type1inst = '/usr/sbin/type1inst';
-my $chkfontpath = '/usr/sbin/chkfontpath';
-# mkttfdir only knows about iso-8859-1, using ttmkfdir -u instead -- pablo
-my $ttmkfdir = '/usr/sbin/ttmkfdir';
-my $fccache = '/usr/bin/fc-cache';
-
-my @font_list; # list of fonts to install
-my @installed_fonts; # list of installed fonts
-my @installed_fonts_path; # list of path included in xfs
-my @installed_fonts_full_path; # full path list of fonts to uninstall
-
-sub list_fontpath() {
- foreach (grep { /\d+:\s/ } `$chkfontpath -l`) {
- chomp;
- s/\d+:\s//gi;
- s/:\w*$//gi;
- push @installed_fonts_path, $_;
- }
-}
-
-sub chk_empty_xfs_path() {
- foreach my $tmp_path (@installed_fonts_path) {
- if (every { /^fonts/ || /^type/ } all($tmp_path)) {
- system("$chkfontpath -r $tmp_path ")
- or print "PERL::system command failed during chkfontpath\n";
- }
- }
-}
-
-sub search_installed_fonts() {
- list_fontpath();
- interactive_progress($pbar, 0.1, N("Search installed fonts"));
- push @installed_fonts, all($_) foreach @installed_fonts_path;
- interactive_progress($pbar, 0.1, N("Unselect fonts installed"));
-}
-
-sub search_installed_fonts_full_path() {
- list_fontpath();
- foreach my $i (@installed_fonts_path) {
- foreach my $j (all($i)) {
- push @installed_fonts_full_path, "$i/$j";
- }
- }
-}
-
-sub search_windows_font() {
- foreach my $fstab_line (grep { /vfat|smbfs|ntfs/ } cat_('/etc/mtab')) {
- my $win_dir = (split('\s', $fstab_line))[1];
- my @list_fonts_win = all("$win_dir/windows/fonts");
- my @list_fonts_winnt = all("$win_dir/winnt/fonts");
- my $nb_dir = @list_fonts_win + @list_fonts_winnt;
- foreach ([ \@list_fonts_win, "windows" ],
- [ \@list_fonts_winnt, "winnt" ]) {
- foreach my $i (@{ $_->[0] }) {
- if ($interactive) {
- if ($nb_dir) {
- progress($pbar, 0.25 / $nb_dir, N("parse all fonts"));
- } else {
- err_dialog(N("Error"), N("No fonts found"));
- return 0;
- }
- }
- !$replace && any { /$i/ } @installed_fonts and next;
- any { /$i$/ } @font_list or push @font_list, "$win_dir/$_->[1]/fonts/$i";
- }
- }
- $interactive && $nb_dir and progress($pbar, 1, N("done"));
- }
- if (!@font_list) {
- print "drakfont:: could not find any font in /win*/fonts \n";
- $interactive
- and err_dialog(N("Error"), N("Could not find any font in your mounted partitions"));
- return 0;
- }
- 1;
-}
-
-sub is_a_font($) {
- my ($file) = @_;
- any { $file =~ /\Q.$_\E$/i } qw(ttf pfa pfb pcf pcf.gz pfm gsf);
-}
-
-# Optimisation de cette etape indispensable
-sub search_dir_font() {
- foreach my $fn (@install) {
- my @font_list_tmp;
- if (!(-e $fn)) { print "$fn :: no such file or directory \n" }
- else {
- if (-d $fn) {
- foreach my $i (all($fn)) {
- if (is_a_font($i)) {
- push @font_list_tmp, $i;
- foreach my $i (@font_list_tmp) {
- !$replace && any { /$i/ } @installed_fonts and next;
- any { /$i/ } @font_list or push @font_list, "$fn/$i";
- }
- }
- }
- }
- elsif (is_a_font($fn)) {
- !$replace && any { /$fn/ } @installed_fonts and next;
- !any { /$fn/ } @installed_fonts and push @font_list, $fn;
- }
- }
- interactive_progress($pbar, 0.50 / @install, N("Reselect correct fonts"));
- }
- interactive_progress($pbar, 1, N("done"));
- !@font_list && $interactive and err_dialog(N("Error"), N("Could not find any font.\n"));
-}
-
-sub search_dir_font_uninstall {
- my ($fn) = @_;
- print "Fonts to uninstal: " . $_ . "\n" foreach uniq(@font_list, -d $fn ? (grep { is_a_font($_) } all($fn)) : if_(is_a_font($fn), $fn));
-}
-
-sub search_dir_font_uninstall_gi() {
- @font_list = @uninstall;
- interactive_progress($pbar, 1, N("Search for fonts in installed list"));
-}
-
-sub print_list() {
- print "Font(s) to Install:\n\n";
- print "$_\n" foreach @font_list;
-}
-
-sub dir_created() {
- return if $::testing;
- -e $drakfont_dir or mkdir_p($drakfont_dir);
- -e $drakfont_dir . "/Type1" or mkdir_p($drakfont_dir . "/Type1");
- -e $drakfont_dir . "/ttf" or mkdir_p($drakfont_dir . "/ttf");
- -e $drakfont_dir . "/tmp" or mkdir_p($drakfont_dir . "/tmp");
- -e $drakfont_dir . "/tmp/ttf" or mkdir_p($drakfont_dir . "/tmp/ttf");
- -e $drakfont_dir . "/tmp/Type1" or mkdir_p($drakfont_dir . "/tmp/Type1");
- -e $drakfont_dir . "/tmp/tmp" or mkdir_p($drakfont_dir . "/tmp/tmp");
-}
-
-
-sub convert_fonts {
- my ($fonts, $converter, $font_type, $o_generate_pfb) = @_;
- $o_generate_pfb = $o_generate_pfb ? "-b" : "";
- foreach my $fontname (@$fonts) {
- system("cd $drakfont_dir/tmp/tmp && $converter $o_generate_pfb $fontname");
- interactive_progress($pbar2, 0.50 / @$fonts, N("%s fonts conversion", $font_type));
- }
-}
-
-sub convert_ttf_fonts {
- my ($fonts, $o_generate_pfb) = @_;
- convert_fonts($fonts, $ttf2pt1, "TTF", $o_generate_pfb);
-}
-
-
-sub move_fonts {
- my ($src_dir, $dest_dir, @extensions) = @_;
- my @fonts = map { s!.*/!!; $_ } map { glob("$src_dir/*.$_") } @extensions;
- system("cd $src_dir && mv @fonts $dest_dir") if @fonts;
-}
-
-sub put_font_dir_real {
- my ($subdir, $command, $progress, $title) = @_;
- system("cd $drakfont_dir/$subdir && $fccache && $command");
- interactive_progress($pbar2, $progress, $title);
- return "$chkfontpath -a $drakfont_dir/$subdir; rm -f /usr/X11R6/lib/X11/fonts/fonts.cache-1";
-}
-
-sub put_font_dir() {
- -e "/usr/share/ghostscript" or do { $gs = 0; print "ghostscript is not installed on your system...\n" };
- if (@font_list) {
- dir_created();
- foreach my $i (@font_list) {
- cp_af($i, $drakfont_dir . "/tmp/tmp");
- interactive_progress($pbar1, 1 / @font_list, N("Fonts copy"));
- }
- interactive_progress($pbar1, 0.01, N("done"));
- interactive_progress($pbar2, 0.10, N("True Type fonts installation"));
- foreach my $font (glob("$drakfont_dir/tmp/tmp/*.TTF")) {
- my $newfont = $font;
- $newfont =~ s/\.TTF$/.ttf/;
- rename($font, $newfont);
- }
- system('cd ' . $drakfont_dir . '/tmp/tmp && cp *.ttf ../../ttf; chmod 644 ../../ttf/*ttf');
- interactive_progress($pbar2, 0.20, N("please wait during ttmkfdir..."));
- my $update_chkfontpath = put_font_dir_real("ttf", "$ttmkfdir -u > fonts.dir", 0.10, N("True Type install done"));
-
- if ($gs) {
- convert_ttf_fonts([ glob("$drakfont_dir/tmp/tmp/*.ttf") ], 1);
- move_fonts("$drakfont_dir/tmp/tmp", "../Type1", qw(afm gsf pfb pfm));
- system("cd $drakfont_dir/tmp/Type1 && $type1inst");
- interactive_progress($pbar2, 0.1, N("type1inst building"));
- if ($so) {
- -e "$drakfont_dir/tmp/Type1/Fontmap"
- and system("cd $drakfont_dir/tmp/Type1 && cat Fontmap >> `rpm -ql ghostscript | grep Fontmap.GS` ");
- move_fonts("$drakfont_dir/tmp/Type1", "../../Type1", qw(afm gsf pfb pfm));
- } else {
- system("cd $drakfont_dir/tmp/Type1 && cat Fontmap >> `rpm -ql ghostscript | grep Fontmap.GS` ");
- move_fonts("$drakfont_dir/tmp/Type1", "../../Type1", qw(afm gsf pfb pfm));
- }
- $update_chkfontpath .= "; " . put_font_dir_real("Type1", $type1inst, 0.05, N("Ghostscript referencing"));
- } elsif ($so) {
- convert_ttf_fonts([ glob("$drakfont_dir/tmp/tmp/*.ttf") ]);
- convert_fonts([ glob("$drakfont_dir/tmp/tmp/*.pfm") ], $pfm2afm, "PFM");
- move_fonts("$drakfont_dir/tmp/tmp", "../Type1", qw(afm));
- move_fonts("$drakfont_dir/tmp/Type1", "../../Type1", qw(afm));
- $update_chkfontpath .= put_font_dir_real("Type1", $type1inst, 0.14, N("type1inst building"));
- }
-
- interactive_progress($pbar2, 1, N("done"));
- interactive_progress($pbar3, 0.25, N("Suppress Temporary Files"));
- rm_rf("$drakfont_dir/tmp/");
- print "\n\nretarting xfs......\n";
- interactive_progress($pbar3, 0.5, N("Restart XFS"));
- system($update_chkfontpath);
- system('/etc/rc.d/init.d/xfs restart');
- system('xset fp rehash');
- interactive_progress($pbar3, 0.30, N("done"));
- }
-}
-
-sub remove_gs_fonts() {
- my @Fontmap_new;
-
- if (all("$drakfont_dir/remove")) {
- system(" cd $drakfont_dir/remove && $type1inst");
- my @Fontmap_out = cat_("$drakfont_dir/remove/Fontmap");
- my $FontmapGS = `rpm -ql ghostscript | grep Fontmap.GS`;
- chomp($FontmapGS);
- my @FontmapGS_list = cat_($FontmapGS);
- foreach my $font_gs (@FontmapGS_list) {
- my @tmp_list = split(' ', $font_gs);
- any { /$tmp_list[0]/ } @Fontmap_out or push @Fontmap_new, $font_gs;
- }
- print $_ foreach @Fontmap_new;
- output($FontmapGS, @Fontmap_new);
- }
-
-}
-
-sub remove_fonts() {
- my @list_dir;
- -e $drakfont_dir . "/remove" or mkdir_p($drakfont_dir . "/remove") if !$::testing;
- interactive_progress($pbar, 1, N("done"));
-
- foreach my $i (@font_list) {
- local $_ = $i;
- if (/.pfb$/ || /.gsf$/ || /.pfm$/ || /.pfa$/) {
- system("mv $_ $drakfont_dir/remove ");
- } else {
- next if $::testing;
- if (/.ttf$/) {
- rm_rf($_);
- # rebuild of the fonts.dir and fc-cache files
- system("cd `dirname $_` && $fccache && $ttmkfdir -u > fonts.dir");
- } else { rm_rf($i) }
- }
- $i =~ s!/\w*\.\w*!!gi;
- any { $i } @list_dir or push @list_dir, $i;
- interactive_progress($pbar1, 1 / @font_list, N("Suppress Fonts Files"));
- }
- interactive_progress($pbar1, 0.01, N("done"));
- -e "/usr/share/ghostscript" and remove_gs_fonts();
- foreach my $i (@list_dir) {
- if (listlength all($i) < 3) {
- system("chkfontpath -r $i") or print "PERL::system command failed during chkfontpath\n";
- } else {
- system("cd $i && type1inst") or print "PERL::system command failed during cd or type1inst\n";
- }
- interactive_progress($pbar2, 1 / @list_dir, N("Suppress Fonts Files"));
- }
- interactive_progress($pbar2, 0.01, N("xfs restart"));
- system("/etc/rc.d/init.d/xfs restart");
- system('xset fp rehash');
- -e "/usr/share/ghostscript" and rm_rf("$drakfont_dir/remove") if !$::testing;
- interactive_progress($pbar2, 0.01, N("done"));
-}
-
-sub license_msg() {
- print N("Before installing any fonts, be sure that you have the right to use and install them on your system.\n\n-You can install the fonts the normal way. In rare cases, bogus fonts may hang up your X Server.") . "\n";
-}
-
-sub backend_mod() {
- $xlsfonts and system("xlsfonts");
- $list_all_font_path and system($chkfontpath);
-
- if ($windows) {
- license_msg();
- print "\nWindows fonts Installation........\n";
- search_installed_fonts();
- if (search_windows_font()) {
- print_list();
- put_font_dir();
- }
- print "\nThe End...........................\n";
- }
-
- if (@install) {
- license_msg();
- print "\nInstall Specifics Fonts...........\n";
- search_installed_fonts();
- search_dir_font();
- print "Font to install: " . $_ . "\n" foreach @font_list;
- put_font_dir();
- print "\nThe End...........................\n";
- }
-
- if (@uninstall) {
- print "\nUninstall Specifics Fonts.........\n";
- search_installed_fonts_full_path();
- if ($interactive) { search_dir_font_uninstall_gi() }
- else { search_dir_font_uninstall() foreach @uninstall }
- remove_fonts();
- print "\nThe End............................\n";
- }
-}
-
-sub create_fontsel() {
- Gtk2::FontSelection->new;
-}
-
-sub interactive_mode() {
- $interactive = 1;
- $window1 = ugtk2->new('drakfont');
- $window1->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) });
- if ($::isEmbedded) {
- } else {
- $window1->{rwindow}->set_position('center');
- $window1->{rwindow}->set_title(N("DrakFont"));
- }
-
- my $button = {};
- my $disable = sub { my ($b) = @_; $button->{$_}->set_sensitive($_ ne $b) foreach keys %$button };
-
- local $::Wizard_no_previous = 1;
- gtkadd($window1->{window},
- gtkpack_(Gtk2::VBox->new(0, 2),
- if_(!$::isEmbedded, 0, Gtk2::Banner->new("drakfont", N("DrakFont"))),
- 0, Gtk2::WrappedLabel->new(N("Font List")),
- 1, create_fontsel(),
- 0, create_okcancel(my $oc = {
- ok_clicked => sub { Gtk2->main_quit },
- },
- undef, undef, '',
- if_([ N("About"), \&help, 1 ]),
- [ N("Options"), \&appli_choice, 1 ],
- [ N("Uninstall"), \&uninstall, 1 ],
- [ N("Import"), \&advanced_install, 1 ],
- ),
- ),
- );
- $oc->{ok}->set_label(N("Close"));
-
- $disable->('font_list');
- $window1->{rwindow}->show_all;
- $window1->{rwindow}->realize;
- $window1->main;
- ugtk2->exit(0);
-}
-
-$list_all_font_path || $xlsfonts || $windows || @install || @uninstall ? backend_mod() : interactive_mode();
-
-sub help() {
- ugtk2::create_dialog(N("Help"), formatAlaTeX(
- #-PO: keep the double empty lines between sections, this is formatted a la LaTeX
- N("Copyright (C) 2001-2002 by Mandrakesoft
-
-
- DUPONT Sebastien (original version)
-
- CHAUMETTE Damien <dchaumette\@mandrakesoft.com>
-
- VIGNAUD Thierry <tvignaud\@mandrakesoft.com>")
-
-. "\n\n\n" . N("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, 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, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.")
-
-. "\n\n\n" . N("Thanks:
-
- - pfm2afm:
- by Ken Borgendale:
- Convert a Windows .pfm file to a .afm (Adobe Font Metrics)
-
- - type1inst:
- by James Macnicol:
- type1inst generates files fonts.dir fonts.scale & Fontmap.
-
- - ttf2pt1:
- by Andrew Weeks, Frank Siegert, Thomas Henlich, Sergey Babkin
- Convert ttf font files to afm and pfb fonts
-")));
-}
-
-sub appli_choice() {
- dialog(N("Options"),
- [
- 0, N("Choose the applications that will support the fonts:"),
- 0, Gtk2::WrappedLabel->new(N("Before installing any fonts, be sure that you have the right to use and install them on your system.\n\nYou can install the fonts the normal way. In rare cases, bogus fonts may hang up your X Server.")),
- (map {
- my ($label, $ref) = @$_;
- (0, gtkpack_(Gtk2::HBox->new,
- 0, $label,
- 1, Gtk2::HBox->new,
- # BUG: that code never had supported canceling
- 0, gtksignal_connect(gtkset_active(Gtk2::CheckButton->new, $$ref), toggled => sub { $$ref = $$ref ? 0 : 1 }),
- ),
- );
- } ([ N("Ghostscript"), \$gs ],
- [ N("StarOffice"), \$so ],
- [ N("Abiword"), \$abi ],
- [ N("Generic Printers"), \$printer ],
- ),
- ),
- ],
- [
- gtksignal_connect(Gtk2::Button->new(N("Ok")),
- clicked => \&exitdialog,
- ),
- ],
- );
-}
-
-my $select_font_msg;
-
-sub font_choice() {
- my $file_dialog;
- $select_font_msg = N("Select the font file or directory and click on 'Add'");
- $file_dialog = Gtk2::FileSelection->new(N("File Selection"));
- $file_dialog->signal_connect(delete_event => sub { $file_dialog->response('close') });
- $file_dialog->ok_button->signal_connect(clicked => \&file_ok_sel, $file_dialog);
- $file_dialog->ok_button->set_label(N("Add"));
- $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->response('cancel') });
- $file_dialog->cancel_button->set_label(N("Close"));
- $file_dialog->show;
- $file_dialog->run;
- $file_dialog->destroy;
-}
-
-sub file_ok_sel {
- my ($_w, $file_selection) = @_;
- my $file_name = $file_selection->get_filename;
- if ($file_name =~ /\Q$select_font_msg/) {
- create_dialog(N("Error"), N("You've not selected any font"));
- } else {
- print "-- @install\n";
- if (!member($file_name, @install)) {
- push @install, $file_name;
- $model->append_set(undef, [ 0 => $file_name ]);
- }
- }
- $file_selection->response('ok')
-}
-
-sub list_remove() { #- TODO : multi-selection
- my ($treeStore, $iter) = $list->get_selection->get_selected;
- return unless $iter;
- my $to_remove = $treeStore->get($iter, 0);
- my ($index) = map_index { if_($_ eq $to_remove, $::i) } @install;
- splice @install, $index, 1;
- $treeStore->remove($iter);
-}
-
-sub exitdialog() { Gtk2->main_quit };
-
-sub dialog {
- my ($title, $widgets, $buttons, $o_main_loop) = @_;
- $dialog = _create_dialog($title, { transient => $::isEmbedded ? $::Plug : $window1->{window} });
- $dialog->signal_connect(delete_event => \&exitdialog);
- gtkpack_($dialog->vbox, @$widgets);
- gtkpack($dialog->action_area, @$buttons) if $buttons;
- $dialog->show_all;
- $window1->{rwindow}->set_sensitive(0);
- if ($o_main_loop) {
- gtkflush();
- $o_main_loop->();
- } else {
- Gtk2->main;
- }
- $dialog->destroy if $dialog;
- undef $dialog;
- $window1->{rwindow}->set_sensitive(1);
-}
-
-sub advanced_install() {
- my $button;
- $model = Gtk2::TreeStore->new("Glib::String");
- $list = Gtk2::TreeView->new_with_model($model);
- $list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $list->set_headers_visible(0);
- $list->get_selection->set_mode('browse');
- $list->set_rules_hint(1);
- $model->signal_connect("row-inserted" => sub { $button and $button->set_sensitive(1) });
- $model->signal_connect("row-deleted" => sub { $button and $button->set_sensitive($model->get_iter_first) });
-
- dialog(N("Import fonts"),
- [ 1, create_scrolled_window($list) ],
- [
- gtksignal_connect(Gtk2::Button->new(N("Add")), clicked => \&font_choice),
- gtksignal_connect(Gtk2::Button->new(N("Remove Selected")), clicked => \&list_remove),
- gtksignal_connect($button = gtkset_sensitive(Gtk2::Button->new(N("Install fonts")), 0),
- clicked => sub {
- $dialog->destroy;
- undef $dialog;
- import_status() if @install;
- }),
- gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => \&exitdialog),
- ],
- );
-}
-
-sub list_to_remove() {
- #my @files_path = grep(!/fonts/, all($current_path)); garbage ?
- gtkflush();
- my (@tux) = $left_list->get_selection->get_selected_rows; #- get tree & paths
- push @uninstall, map { $left_model->get($left_model->get_iter($_), 0) } @tux;
- #push @uninstall, $current_path . "/" . $files_path[$_] foreach @number_to_remove; garbage ?
- show_list_to_remove();
-}
-
-sub show_list_to_remove() {
- my $model = Gtk2::TreeStore->new("Glib::String");
- my $list = Gtk2::TreeView->new_with_model($model);
- $list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $list->set_headers_visible(0);
- $list->get_selection->set_mode('browse');
- $list->set_rules_hint(1);
-
- $model->append_set(undef, [ 0 => $_ ]) foreach @uninstall;
-
- dialog(N("Uninstall"),
- [
- 1, gtkpack_(Gtk2::HBox->new(0, 4), 1, create_scrolled_window($list)),
- ],
- [
- gtksignal_connect(Gtk2::Button->new(N("click here if you are sure.")),
- clicked => sub { import_status_uninstall(); exitdialog() }),
- gtksignal_connect(Gtk2::Button->new(N("here if no.")),
- clicked => \&exitdialog
- ),
- ],
- );
-}
-
-sub uninstall() { #- TODO : add item to right list with gtksignal_connect
- @install = ();
- @installed_fonts_path = ();
- list_fontpath();
- chk_empty_xfs_path();
-
- #- left part
- $left_model = Gtk2::TreeStore->new("Glib::String");
- $left_list = Gtk2::TreeView->new_with_model($left_model);
- $left_list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $left_list->set_headers_visible(0);
- $left_list->set_rules_hint(1);
- $left_list->get_selection->set_mode('multiple');
-
- $left_model->append_set(undef, [ 0 => $_ ]) foreach @installed_fonts_path;
-
- #- right part
- $right_model = Gtk2::TreeStore->new("Glib::String");;
- $right_list = Gtk2::TreeView->new_with_model($right_model);
- $right_list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0));
- $right_list->set_headers_visible(0);
- $right_list->get_selection->set_mode('multiple');
- $right_list->set_rules_hint(1);
-
- dialog(N("Uninstall"),
- [
- 1, gtkpack_(Gtk2::HBox->new(0, 4),
- 1, create_scrolled_window($left_list),
- #1, create_scrolled_window($right_list)
- ),
- ],
- [
- gtksignal_connect(Gtk2::Button->new(N("Unselected All")),
- clicked => sub { $left_list->get_selection->unselect_all }
- ),
- gtksignal_connect(Gtk2::Button->new(N("Selected All")),
- clicked => sub { $left_list->get_selection->select_all }
- ),
- gtksignal_connect(Gtk2::Button->new(N("Remove List")), clicked => sub { exitdialog(); list_to_remove() }),
- gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => \&exitdialog),
- ],
- );
-}
-
-sub import_status() {
- $pbar = Gtk2::ProgressBar->new;
- $pbar1 = Gtk2::ProgressBar->new;
- $pbar2 = Gtk2::ProgressBar->new;
- $pbar3 = Gtk2::ProgressBar->new;
- dialog(N("Importing fonts"),
- [
- 0, create_packtable({ col_spacings => 10, row_spacings => 50 },
- [ "", "" ],
- [ N("Initial tests"), $pbar, $pbar->set_text(' ') ],
- [ N("Copy fonts on your system"), $pbar1, $pbar1->set_text(' ') ],
- [ N("Install & convert Fonts"), $pbar2, $pbar2->set_text(' ') ],
- [ N("Post Install"), $pbar3, $pbar3->set_text(' ') ],
- ),
- ],
- [],
- \&backend_mod,
- );
-}
-
-sub import_status_uninstall() {
- $pbar = Gtk2::ProgressBar->new;
- $pbar1 = Gtk2::ProgressBar->new;
- $pbar2 = Gtk2::ProgressBar->new;
- dialog(N("Importing fonts"),
- [
- 0, create_packtable({ col_spacings => 10, row_spacings => 50 },
- [ "", "" ],
- [ "", "" ],
- [ N("Initial tests"), $pbar, $pbar->set_text(' ') ],
- [ N("Remove fonts on your system"), $pbar1, $pbar1->set_text(' ') ],
- [ N("Post Uninstall"), $pbar2, $pbar2->set_text(' ') ],
- ),
- ],
- [],
- \&backend_mod,
- );
-}
-
-sub progress {
- my ($progressbar, $incr, $label_text) = @_;
- $progressbar->set_fraction(min(1, $progressbar->get_fraction + $incr));
- $progressbar->set_text($label_text);
- gtkflush();
-}
-
-sub interactive_progress {
- $interactive and progress(@_);
-}
diff --git a/perl-install/standalone/drakgw b/perl-install/standalone/drakgw
deleted file mode 100755
index 4cf70cc1f..000000000
--- a/perl-install/standalone/drakgw
+++ /dev/null
@@ -1,613 +0,0 @@
-#!/usr/bin/perl
-
-#
-# author Guillaume Cottenceau (gc@mandrakesoft.com)
-# modified by Florin Grad (florin@mandrakesoft.com)
-#
-# Copyright 2000-2004 Mandrakesoft
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License version 2, as
-# published by the Free Software Foundation.
-#
-# 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use detect_devices;
-use interactive;
-use network::network;
-use network::ethernet;
-use run_program;
-use log;
-use c;
-use network::netconnect;
-use network::shorewall;
-
-$::isInstall and die "Not supported during install.\n";
-
-
-local $_ = join '', @ARGV;
-
-$::Wizard_pix_up = "drakgw.png";
-my $direct = /-direct/;
-
-my $sysconf_network = "/etc/sysconfig/network";
-my $sysconf_dhcpd = "/etc/sysconfig/dhcpd";
-my $masq_file = "/etc/shorewall/masq";
-my $dhcpd_conf = "/etc/dhcpd.conf";
-my $squid_conf = "/etc/squid/squid.conf";
-my $squid_port = network::network::read_squid_conf()->{http_port}[0] ||= "3128";
-my $cups_conf = "/etc/cups/cupsd.conf";
-
-my $in = 'interactive'->vnew('su');
-my $shorewall = network::shorewall::read($in, 'silent');
-
-$::Wizard_title = N("Internet Connection Sharing");
-
-$in->isa('interactive::gtk') and $::isWizard = 1;
-
-sub sys { system(@_) == 0 or log::l("[drakgw] Warning, sys failed for $_[0]") }
-
-sub outpend {
- my $f = shift;
- log::explanations("modified file $f");
- append_to_file($f, @_);
-}
-
-sub start_daemons () {
- return if $::testing;
- my $cups_used = 0;
- log::explanations("Starting daemons");
- if (-f "/etc/rc.d/init.d/cups") {
- if (system("/etc/rc.d/init.d/cups status >/dev/null") == 0) {
- $cups_used = 1;
- sys("/etc/rc.d/init.d/cups stop");
- }
- }
- system("/etc/rc.d/init.d/dhcpd status >/dev/null") == 0 and sys("/etc/rc.d/init.d/dhcpd stop");
- system("/etc/rc.d/init.d/squid status >/dev/null") == 0 and sys("/etc/rc.d/init.d/squid stop");
- system("/etc/rc.d/init.d/named status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/named stop");
-
- my $netscripts = '/etc/sysconfig/network-scripts';
- sys("$netscripts/net_cnx_down >/dev/null") if cat_("$netscripts/net_cnx_down") !~ /network/;
- sys("/etc/rc.d/init.d/network restart >/dev/null");
- sys("$netscripts/net_cnx_up >/dev/null") if cat_("$netscripts/net_cnx_down") !~ /network/;
-
- sys("/etc/rc.d/init.d/$_ start >/dev/null"), sys("/sbin/chkconfig --level 345 $_ on") foreach 'named', 'dhcpd', 'squid';
- sys("/etc/rc.d/init.d/cups start >/dev/null") if $cups_used;
-}
-
-sub stop_daemons () {
- return if $::testing;
- log::explanations("Stopping daemons");
- foreach (qw(dhcpd squid named)) {
- system("/etc/rc.d/init.d/$_ status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/$_ stop");
- }
- sys("/sbin/chkconfig --level 345 $_ off") foreach 'named', 'dhcpd', 'squid';
-}
-
-my $wait_configuring;
-
-sub fatal_quit ($) {
- log::l("[drakgw] FATAL: $_[0]");
- undef $wait_configuring;
- $in->ask_warn('', $_[0]);
- quit_global($in, -1);
-}
-
-my ($kernel_version) = c::kernel_version() =~ /(...)/;
-log::l("[drakgw] kernel_version $kernel_version");
-
-$kernel_version >= 2.4 or fatal_quit(N("Sorry, we support only 2.4 and above kernels."));
-
-begin:
-
-#- **********************************
-#- * 0th step: verify if we are already set up
-
-if ($shorewall && -f $masq_file || -f "$masq_file.drakgwdisable" && grep { !/^#/ } cat_($masq_file) || grep { !/^#/ } cat_("$masq_file.drakgwdisable")) {
- $::Wizard_no_previous = 1;
- my $r;
- if (-f "$masq_file.drakgwdisable") {
- $r = $in->ask_from_list_(N("Internet Connection Sharing currently disabled"),
-N("The setup of Internet connection sharing has already been done.
-It's currently disabled.
-
-What would you like to do?"),
- [ N_("enable"), N_("reconfigure"), N_("dismiss") ]);
- if ($r eq "enable") {
- foreach ($dhcpd_conf, $squid_conf, $masq_file) {
- rename($_, "$_.old") if -f $_;
- rename("$_.drakgwdisable", $_) or die "Could not find configuration. Please reconfigure.";
- };
- {
- my $_wait_enabl = $in->wait_message('', N("Enabling servers..."));
- start_daemons();
- print "add rules entries\n";
- substInFile {
- s/#LAST LINE -- ADD YOUR ENTRIES BEFORE THIS ONE -- DO NOT REMOVE/REDIRECT\tloc\t$squid_port\ttcp\twww\t-\nACCEPT\tfw\tnet\ttcp\twww\n#LAST LINE -- ADD YOUR ENTRIES BEFORE THIS ONE -- DO NOT REMOVE/;
- } "/etc/shorewall/rules";
- run_program::run('chkconfig', '--add', 'shorewall');
- run_program::run('service', '>', '/dev/null', 'shorewall', 'restart') if $::isStandalone;
- }
- log::l("[drakgw] Enabled");
- }
- $::Wizard_finished = 1;
- $in->ask_okcancel('', N("Internet Connection Sharing is now enabled."));
- quit_global($in, 0);
- } elsif (!$shorewall->{disabled}) {
- $r = $in->ask_from_list_(N("Internet Connection Sharing currently enabled"),
-N("The setup of Internet Connection Sharing has already been done.
-It's currently enabled.
-
-What would you like to do?"),
- [ N_("disable"), N_("reconfigure"), N_("dismiss") ]) or quit_global($in, 0);
- if ($r eq "disable") {
- if (!$::testing) {
- my $_wait_disabl = $in->wait_message('', N("Disabling servers..."));
- stop_daemons();
- }
- foreach ($dhcpd_conf, $squid_conf, $masq_file) {
- if (-f $_) { rename($_, "$_.drakgwdisable") or die "Could not rename $_ to $_.drakgwdisable" };
- }
- print "remove rules entries\n";
- substInFile {
- s/REDIRECT\tmasq\t$squid_port\ttcp\twww\t\-\n//;
- s/REDIRECT\tloc\t$squid_port\ttcp\twww\t\-\n//;
- s/ACCEPT\tfw\tnet\ttcp\twww\n//;
- } "/etc/shorewall/rules";
- sys("/etc/init.d/shorewall restart >/dev/null");
- log::l("[drakgw] Disabled");
- $::Wizard_finished = 1;
- $in->ask_okcancel('', N("Internet Connection Sharing is now disabled."));
- quit_global($in, 0);
- }
- if ($r eq "dismiss") {
- quit_global($in, 0);
- }
- }
- if ($r eq "dismiss") {
- quit_global($in, 0);
- }
- }
-
-
-#- **********************************
-#- * 1st step: detect/setup
-step_ask_confirm:
-
-$::Wizard_no_previous = 1;
-
-$direct or $in->ask_okcancel(N("Internet Connection Sharing"),
-N("You are about to configure your computer to share its Internet connection.
-With that feature, other computers on your local network will be able to use this computer's Internet connection.
-
-Make sure you have configured your Network/Internet access using drakconnect before going any further.
-
-Note: you need a dedicated Network Adapter to set up a Local Area Network (LAN)."), 1) or goto begin;
-
-
-
-step_detectsetup:
-
-my @configured_devices = map { /ifcfg-(\S+)/ } glob('/etc/sysconfig/network-scripts/ifcfg*');
-
-my %aliased_devices;
-/^\s*alias\s+(eth[0-9])\s+(\S+)/ and $aliased_devices{$1} = $2 foreach cat_("/etc/modules.conf");
-
-my $card_netconnect = network::netconnect::get_net_device() || "eth0";
-defined $card_netconnect and log::l("[drakgw] Information from netconnect: ignore card $card_netconnect");
-
-my $modules_conf = modules::any_conf->read;
-my @all_cards = network::ethernet::get_eth_cards($modules_conf);
-my %net_devices = network::ethernet::get_eth_cards_names(@all_cards);
-put_in_hash(\%net_devices, { 'ppp+' => 'ppp+', 'ippp+' => 'ippp+' });
-
- $in->ask_from('',
- N("Please enter the name of the interface connected to the internet.
-
-Examples:
- ppp+ for modem or DSL connections,
- eth0, or eth1 for cable connection,
- ippp+ for a isdn connection.
-"),
- [ { label => N("Net Device"), val => \$card_netconnect, list => [ sort keys %net_devices ], format => sub { $net_devices{$_[0]} || $_[0] }, not_edit => 0 } ])
- or goto step_ask_confirm;
-
-my @cards = grep {
- log::l("[drakgw] Have network card: $_");
- $_ ne $card_netconnect
-} detect_devices::getNet();
-push @cards, $card_netconnect if $::testing;
-log::l("[drakgw] Available network cards: ", join(", ", @cards));
-
-my $format = sub {
- $aliased_devices{$_[0]} ?
- N("Interface %s (using module %s)", $_[0], $aliased_devices{$_[0]}) :
- N("Interface %s", $_[0]);
-};
-
-#- setup the network interface we shall use
-
-step_interface_choice:
-my $device;
-if (!@cards)
-{
- $in->ask_warn(N("No network adapter on your system!"),
- N("No ethernet network adapter has been detected on your system. Please run the hardware configuration tool."));
- quit_global($in, 0);
-}
-elsif (@cards == 1)
-{
- $device = $cards[0];
- $in->ask_okcancel(N("Network interface"),
-N("There is only one configured network adapter on your system:
-
-%s
-
-I am about to setup your Local Area Network with that adapter.", $format->($device)), 1) or goto step_detectsetup;
-} else {
- $device = $in->ask_from_listf(N("Choose the network interface"),
- N("Please choose what network adapter will be connected to your Local Area Network."),
- $format,
- \@cards,
- ) or goto step_detectsetup;
- defined $device or quit_global($in, 0);
-}
-log::explanations("Choosing network device: $device");
-my $conf = read_interface_conf("/etc/sysconfig/network-scripts/ifcfg-$device");
-
-my $server_ip = $conf->{IPADDR} ||= network::network::read_dhcpd_conf()->{option_routers}[0] ||= "192.168.1.1";
-my $lan_address = $server_ip =~ m/(.*)\.(.*)/ && $1 ? "$1.0" : "192.168.1.0";
-my $nameserver_ip = network::network::read_resolv_conf_raw()->{nameserver}[0] ||= network::network::read_dhcpd_conf()->{domain_name_servers}[0] ||= "192.168.1.1";
-my $netmask = $conf->{NETMASK} ||= network::network::read_dhcpd_conf()->{subnet_mask}[0] ||= "255.255.255.0";
-my $start_range = network::network::read_dhcpd_conf()->{dynamic_bootp}[0] ||= "16";
-my $end_range = network::network::read_dhcpd_conf()->{dynamic_bootp}[1] ||= "253";
-my $default_lease = network::network::read_dhcpd_conf()->{max_lease_time}[0] ||= "21600";
-my $max_lease = network::network::read_dhcpd_conf()->{default_lease_time}[0] ||= "43200";
-my $internal_domain_name = network::network::read_dhcpd_conf()->{domain_name}[0] ||= network::network::read_resolv_conf_raw()->{search}[0] ||= "homeland.net";
-my $squid_cache_size = network::network::read_squid_conf()->{cache_size}[1] ||= "100";
-my $squid_admin_mail = network::network::read_squid_conf()->{admin_mail}[0] ||= 'admin@mydomain.com';
-my $squid_visible_hostname = network::network::read_squid_conf()->{visible_hostname}[0] ||= 'myfirewall@mydomain.com';
-
-my $reconf_dhcp_server_intf = 1;
-
-if (any { /$device/ } @configured_devices) {
- step_warning_already_conf:
- my $auto = N("Yes");
- my $_dhcp_details = N("Yes");
-
- $in->ask_from(N("Network interface already configured"),
- N("Warning, the network adapter (%s) is already configured.
-
-Do you want an automatic re-configuration?
-
-You can do it manually but you need to know what you're doing.", $device),
- [ { label => N("Automatic reconfiguration"), val => \$auto, list => [ N("Yes"), N("No (experts only)") ] },
- { val => N("Show current interface configuration"), clicked =>
- sub { $in->ask_okcancel(N("Current interface configuration"),
- N("Current configuration of `%s':
-
-Network: %s
-IP address: %s
-IP attribution: %s
-Driver: %s", $device, $conf->{NETWORK}, $conf->{IPADDR}, $conf->{BOOTPROTO}, $aliased_devices{$device} || '(unknown)')) } } ]) or goto step_interface_choice;
-
- if ($auto ne N("Yes")) {
- $reconf_dhcp_server_intf = 0;
- $server_ip = $conf->{IPADDR} ||= network::network::read_dhcpd_conf()->{option_routers}[0] ||= "192.168.1.1";
- $nameserver_ip = $conf->{IPADDR} ||= network::network::read_dhcpd_conf()->{domain_name_servers}[0] ||= "192.168.1.1";
- $lan_address = $server_ip =~ m/(.*)\.(.*)/ && $1 ? "$1.0" : $conf->{NETWORK};
- $in->ask_from('',
- N("I can keep your current configuration and assume you already set up a DHCP server; in that case please verify I correctly read the Network that you use for your local network; I will not reconfigure it and I will not touch your DHCP server configuration.
-
-The default DNS entry is the Caching Nameserver configured on the firewall. You can replace that with your ISP DNS IP, for example.
-
-Otherwise, I can reconfigure your interface and (re)configure a DHCP server for you.
-
-"),
- [ { label => N("Local Network adress"), val => \$lan_address, type => 'entry' },
- { label => N("Netmask"), val => \$netmask, type => 'entry' } ])
- or goto step_warning_already_conf;
- $in->ask_from('',
- N("DHCP Server Configuration.
-
-Here you can select different options for the DHCP server configuration.
-If you don't know the meaning of an option, simply leave it as it is."),
- [ { label => N("(This) DHCP Server IP"), val => \$server_ip, type => 'entry' },
- { label => N("The DNS Server IP"), val => \$nameserver_ip, type => 'entry' },
- { label => N("The internal domain name"), val => \$internal_domain_name, type => 'entry' },
- { label => N("The DHCP start range"), val => \$start_range, type => 'entry' },
- { label => N("The DHCP end range"), val => \$end_range, type => 'entry' },
- { label => N("The default lease (in seconds)"), val => \$default_lease, type => 'entry' },
- { label => N("The maximum lease (in seconds)"), val => \$max_lease, type => 'entry' },
- { label => N("Re-configure interface and DHCP server"), val => \$reconf_dhcp_server_intf, type => 'bool' } ])
- or goto step_warning_already_conf;
- }
-}
-
-if (!($lan_address =~ s/\.0$//)) {
- $in->ask_warn('',
- N("The Local Network did not finish with `.0', bailing out."));
- quit_global($in, 0);
-}
-log::explanations("Using LAN address <$lan_address>");
-
-
-#- test for potential conflict with other networks
-
-foreach (grep { $_ ne $device } @configured_devices) {
- any { /$lan_address/ } cat_("/etc/sysconfig/network-scripts/ifcfg-$_") and
- ($in->ask_warn('', N("Potential LAN address conflict found in current config of %s!\n", $_)) or goto step_detectsetup);
-}
-
-
-#- test for potential conflict with previous firewall config
-network::shorewall::check_iptables($in) or goto step_detectsetup;
-
-#- **********************************
-#- * 2nd step: configure
-
-$wait_configuring = $in->wait_message(N("Configuring..."),
- N("Configuring scripts, installing software, starting servers..."));
-
-
-#- setup the /etc/sysconfig/network-script/ script
-
-if ($reconf_dhcp_server_intf && !$::testing) {
- log::explanations("Reconfiguring network parameters of $device");
- my $network_scripts = "/etc/sysconfig/network-scripts";
- my $ifcfg = "$network_scripts/ifcfg-$device";
- renamef($ifcfg, "$network_scripts/old.ifcfg-$device");
- output($ifcfg,
- join('', qq(DEVICE=$device
-BOOTPROTO=static
-IPADDR=$server_ip
-NETMASK=$netmask
-NETWORK=$lan_address.0
-BROADCAST=$lan_address.255
-ONBOOT=yes
-),
- if_($conf && $conf->{MII_NOT_SUPPORTED},
- "MII_NOT_SUPPORTED=$conf->{MII_NOT_SUPPORTED}\n")
-));
-}
-
-
-#- install and setup the RPM packages
-
-my %rpm2file = ('dhcp-server' => '/usr/sbin/dhcpd',
- squid => '/usr/sbin/squid',
- bind => '/usr/sbin/named',
- shorewall => '/sbin/shorewall',
- 'caching-nameserver' => '/var/named/named.local');
-
-#- first: try to install all in one step
-my @needed_to_install = grep { !-e $rpm2file{$_} } keys %rpm2file;
-@needed_to_install and $in->do_pkgs->install(@needed_to_install) if !$::testing;
-#- second: try one by one if failure detected
-if (!$::testing && any { !-e $rpm2file{$_} } keys %rpm2file) {
- foreach (keys %rpm2file) {
- -e $rpm2file{$_} or $in->do_pkgs->install($_);
- -e $rpm2file{$_} or fatal_quit(N("Problems installing package %s", $_));
- }
-}
-
-put_in_hash($shorewall ||= {}, {
- disabled => 0,
- net_interface => $card_netconnect,
- loc_interface => [ grep { $_ ne $card_netconnect } @cards ],
- masquerade => { subnet => "$lan_address.0/$netmask" },
-});
-
-
-#- be sure that FORWARD_IPV4 is enabled in /etc/sysconfig/network
-
-log::explanations("Enabling IPV4 forwarding");
-substInFile { s/^FORWARD_IPV4.*\n//; $_ .= "FORWARD_IPV4=true\n" if eof } $sysconf_network if !$::testing;
-
-
-#- setup the DHCP server
-
-if ($reconf_dhcp_server_intf && !$::testing) {
- log::explanations("Configuring a DHCP server on $lan_address.0");
- renamef($dhcpd_conf, "$dhcpd_conf.old");
- output($dhcpd_conf, qq(subnet $lan_address.0 netmask $netmask {
- # default gateway
- option routers $server_ip;
- option subnet-mask $netmask;
-
- option domain-name "$internal_domain_name";
- option domain-name-servers $nameserver_ip;
-
- range dynamic-bootp $lan_address.$start_range $lan_address.$end_range;
- default-lease-time $default_lease;
- max-lease-time $max_lease;
-}
-));
-}
-
-my $update_dhcp = '/usr/sbin/update_dhcp.pl';
--e $update_dhcp and system($update_dhcp);
-
-
-#- put the interface for the dhcp server in the sysconfig-dhcp config, for the /etc/init.d script of dhcpd
-
-log::explanations("Update network interfaces list for dhcpd server");
-substInFile { s/^INTERFACES\n//; $_ .= qq(INTERFACES="$device"\n) if eof } $sysconf_dhcpd if !$::testing;
-
-#- setup the transparent SQUID Proxy Cache server
-
-log::explanations("Configuring a Transparent Squid Proxy Cache server on $lan_address.0");
-renamef($squid_conf, "$squid_conf.old");
-output($squid_conf, qq(
-http_port $squid_port
-hierarchy_stoplist cgi-bin ?
-acl QUERY urlpath_regex cgi-bin \\?
-no_cache deny QUERY
-cache_dir diskd /var/spool/squid $squid_cache_size 16 256
-cache_store_log none
-auth_param basic children 5
-auth_param basic realm Squid proxy-caching web server
-auth_param basic credentialsttl 2 hours
-refresh_pattern ^ftp: 1440 20% 10080
-refresh_pattern ^gopher: 1440 0% 1440
-refresh_pattern . 0 20% 4320
-half_closed_clients off
-acl all src 0.0.0.0/0.0.0.0
-acl manager proto cache_object
-acl localhost src 127.0.0.1/255.255.255.255
-acl to_localhost dst 127.0.0.0/8
-acl SSL_ports port 443 563
-acl Safe_ports port 80 # http
-acl Safe_ports port 21 # ftp
-acl Safe_ports port 443 563 # https, snews
-acl Safe_ports port 70 # gopher
-acl Safe_ports port 210 # wais
-acl Safe_ports port 1025-65535 # unregistered ports
-acl Safe_ports port 280 # http-mgmt
-acl Safe_ports port 488 # gss-http
-acl Safe_ports port 591 # filemaker
-acl Safe_ports port 777 # multiling http
-acl CONNECT method CONNECT
-http_access allow manager localhost
-http_access deny manager
-http_access deny !Safe_ports
-http_access deny CONNECT !SSL_ports
-http_access deny to_localhost
-acl mynetwork src $lan_address.0/$netmask
-http_access allow mynetwork
-http_access allow localhost
-http_reply_access allow all
-icp_access allow all
-visible_hostname $squid_visible_hostname
-httpd_accel_host virtual
-httpd_accel_with_proxy on
-httpd_accel_uses_host_header on
-append_domain .$internal_domain_name
-err_html_text $squid_admin_mail
-deny_info ERR_CUSTOM_ACCESS_DENIED all
-memory_pools off
-coredump_dir /var/spool/squid
-ie_refresh on
-)) if !$::testing;
-
-#- Set up /etc/cups/cupsd.conf to make the broadcasting of the printer info
-#- working correctly:
-#-
-#- 1. ServerName <server's IP address> # because clients do necessarily
-#- # know the server's name
-#-
-#- 2. BrowseAddress <server's Broadcast IP> # broadcast printer info into
-#- # the local network.
-#-
-#- 3. BrowseOrder Deny,Allow
-#- BrowseDeny All
-#- BrowseAllow <IP mask for local net> # Only accept broadcast signals
-#- # coming from local network
-#-
-#- 4. <Location />
-#- Order Deny,Allow
-#- Deny From All
-#- Allow From <IP mask for local net> # Allow only machines of local
-#- </Location> # network to access the server
-#-
-#- These steps are only done when the CUPS package is installed.
-
-#- Modify the root location block in /etc/cups/cupsd.conf
-
-if (-f $cups_conf && !$::testing) {
- log::explanations("Updating CUPS configuration accordingly");
-
- substInFile {
- s/^ServerName[^:].*\n//; $_ .= "ServerName $server_ip\n" if eof;
- s/^BrowseAddress.*\n//; $_ .= "BrowseAddress $lan_address.255\n" if eof;
- s/^BrowseOrder.*\n//; $_ .= "BrowseOrder Deny,Allow\n" if eof;
- s/^BrowseDeny.*\n//; $_ .= "BrowseDeny All\n" if eof;
- s/^BrowseAllow.*\n//; $_ .= "BrowseAllow $lan_address.*\n" if eof;
- } $cups_conf;
-
- my @cups_conf_content = cat_($cups_conf);
- my @root_location; my $root_location_start; my $root_location_end;
-
- # Cut out the root location block so that it can be treated seperately
- # without affecting the rest of the file
- if (any { m|^\s*<Location\s+/\s*>| } @cups_conf_content) {
- $root_location_start = -1;
- $root_location_end = -1;
- # Go through all the lines, bail out when start and end line found
- for (my $i = 0; $i < @cups_conf_content && $root_location_end == -1; $i++) {
- if ($cups_conf_content[$i] =~ m|^\s*<\s*Location\s+/\s*>|) {
- $root_location_start = $i;
- } elsif ($cups_conf_content[$i] =~ m|^\s*<\s*/Location\s*>| && $root_location_start != -1) {
- $root_location_end = $i;
- }
- }
- # Rip out the block and store it seperately
- @root_location = splice(@cups_conf_content, $root_location_start, $root_location_end - $root_location_start + 1);
- } else {
- # If there is no root location block, create one
- $root_location_start = @cups_conf_content;
- @root_location = ("<Location />\n", "</Location>\n");
- }
-
- # Delete all former "Order", "Allow", and "Deny" lines from the root location block
- s/^\s*Order.*//, s/^\s*Allow.*//, s/^\s*Deny.*// foreach @root_location;
-
- # Add the new "Order" and "Deny" lines, add an "Allow" line for the local network
- splice(@root_location, -1, 0, $_) foreach "Order Deny,Allow\n", "Deny From All\n", "Allow From 127.0.0.1\n",
- "Allow From $lan_address.*\n";
-
- # Put the changed root location block back into the file
- splice(@cups_conf_content, $root_location_start, 0, @root_location);
-
- output $cups_conf, @cups_conf_content;
-}
-
-
-#- start the daemons
-
-start_daemons();
-
-network::shorewall::write($shorewall);
-print "add rules entries\n";
-substInFile {
- s/#LAST LINE -- ADD YOUR ENTRIES BEFORE THIS ONE -- DO NOT REMOVE/REDIRECT\tloc\t$squid_port\ttcp\twww\t-\nACCEPT\tfw\tnet\ttcp\twww\n#LAST LINE -- ADD YOUR ENTRIES BEFORE THIS ONE -- DO NOT REMOVE/;
-} "/etc/shorewall/rules";
-run_program::run('chkconfig', '--add', 'shorewall');
-run_program::run('service', '>', '/dev/null', 'shorewall', 'restart') if $::isStandalone;
-
-#- bye-bye message
-
-undef $wait_configuring;
-
-$::Wizard_no_previous = 1;
-$::Wizard_finished = 1;
-
-$in->ask_okcancel(N("Congratulations!"),
-N("Everything has been configured.
-You may now share Internet connection with other computers on your Local Area Network, using automatic network configuration (DHCP) and
- a Transparent Proxy Cache server (SQUID)."));
-
-
-log::l("[drakgw] Installation complete, exiting");
-quit_global($in, 0);
-
-sub quit_global {
- my ($in, $exitcode) = @_;
- $in->exit($exitcode);
- goto begin
-}
diff --git a/perl-install/standalone/drakhelp b/perl-install/standalone/drakhelp
deleted file mode 100644
index d76ce8939..000000000
--- a/perl-install/standalone/drakhelp
+++ /dev/null
@@ -1,48 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use diagnostics;
-
-use lib qw(/usr/lib/libDrakX);
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use common;
-use any;
-use ctxhelp;
-use log;
-
-
-sub usage() {
- print STDERR N(" drakhelp 0.1
-Copyright (C) 2003-2004 Mandrakesoft.
-This is free software and may be redistributed under the terms of the GNU GPL.
-
-Usage:
-") . N(" --help - display this help
-") . N(" --id <id_label> - load the html help page which refers to id_label
-") . N(" --doc <link> - link to another web page ( for WM welcome frontend)
-");
- exit(0)
-}
-my ($opt, $idlabel) = @ARGV;
-@ARGV == 2 && ($opt eq '--id' || $opt eq '--doc' || $opt eq '--help') or usage();
-
-$ugtk2::wm_icon = "help";
-my $in = interactive->vnew;
-my ($instpath, $ancpath, $package) = ctxhelp::path2help($opt, $idlabel);
-
--e $instpath or system("/usr/sbin/drakhelp_inst $package");
--e $instpath or $in->ask_warn(N("Mandrakelinux Help Center"), N("%s cannot be displayed \n. No Help entry of this type\n", $instpath));
-
-my $wm = any::running_window_manager();
-my %launchhelp = (
- 'kwin' => sub { system("webclient-kde " . $ancpath . "&") },
- 'gnome-session' => sub { system("yelp ghelp://" . $ancpath . "&") },
- 'other' => sub { my $browser = $ENV{BROWSER} || find { -x "/usr/bin/$_" } qw(mozilla konqueror epiphany galeon) or $in->ask_warn('drakhelp', N("No browser is installed on your system, Please install one if you want to browse the help system"));
- log::explanations("Loading help system : $ancpath");
- system("$browser " . $ancpath . "&")
- }
- );
-member($wm, 'kwin', 'gnome-session') or $wm = 'other';
--e $instpath and eval { $launchhelp{$wm}->() };
diff --git a/perl-install/standalone/drakperm b/perl-install/standalone/drakperm
deleted file mode 100755
index 39579af91..000000000
--- a/perl-install/standalone/drakperm
+++ /dev/null
@@ -1,433 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use diagnostics;
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-
-use common;
-use ugtk2 qw(:helpers :wrappers :create);
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/drakperm-mdk.png";
-require_root_capability();
-local $_ = join '', @ARGV;
-
-#- vars declaration
-my ($level) = chomp_(`cat /etc/sysconfig/msec | grep SECURE_LEVEL= |cut -d= -f2`);
-my $default_perm_level = "level " . $level;
-my %perm_files = ($default_perm_level => '/usr/share/msec/perm.' . $level,
- 'editable' => '/etc/security/msec/perm.local',
- );
-
-my %perm_l10n = ($default_perm_level => N("System settings"),
- 'editable' => N("Custom settings"),
- 'all' => N("Custom & system settings"),
- );
-my %rev_perm_l10n = reverse %perm_l10n;
-my ($editable, $modified) = (0, 0);
-
-my @rules;
-
-#- Widget declaration
-my $w = ugtk2->new('drakperm');
-$w->{rwindow}->set_size_request(620, 400) unless $::isEmbedded;
-my $W = $w->{window};
-$W->signal_connect(delete_event => sub { ugtk2->exit });
-my $model = Gtk2::ListStore->new("Gtk2::Gdk::Pixbuf", ("Glib::String") x 5);
-my $permList = Gtk2::TreeView->new_with_model($model);
-
-my $pixbuf = gtkcreate_pixbuf('non-editable');
-
-my @column_sizes = (150, 100, 100, 15, -1);
-
-# TreeView layout is (Editable, Path, User, Group, Permissions, [hidden]index_id)
-$permList->append_column(Gtk2::TreeViewColumn->new_with_attributes(N("Editable"), Gtk2::CellRendererPixbuf->new, 'pixbuf' => 0));
-each_index {
- my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i + 1);
- $col->set_min_width($column_sizes[$::i+1]);
- $permList->append_column($col);
-} (N("Path"), N("User"), N("Group"), N("Permissions"));
-
-my $index = 0;
-load_perms();
-
-#- widgets settings
-my $combo_perm = Gtk2::ComboBox->new_with_strings([ sort(values %perm_l10n) ]);
-
-sub add_callback() {
- row_setting_dialog();
- $modified++;
-}
-
-sub edit_callback() {
- my (undef, $iter) = $permList->get_selection->get_selected;
- return unless $iter;
- row_setting_dialog($iter);
-}
-
-my @buttons;
-
-sub del_callback() {
- my ($tree, $iter) = $permList->get_selection->get_selected;
- my $removed_idx = $tree->get($iter, 5);
- @rules = grep { $_->{index} ne $removed_idx } @rules;
- $tree->remove($iter);
- sensitive_buttons(0);
- $modified++;
-}
-
-sub move_callback {
- my ($direction) = @_;
- my ($model, $iter) = $permList->get_selection->get_selected;
- return if !$iter;
- my $path = $model->get_path($iter) or return;
- $direction eq 'up' ? $path->prev : $path->next;
- my $iter2 = $model->get_iter($path);
- return if !$iter2 || $model->get($iter2, 0);
- $model->swap($iter, $iter2);
- $modified = 1;
- hide_up_button_iffirst_item($path);
- hide_down_button_iflast_item($path);
- $permList->get_selection->select_iter($iter);
- $permList->queue_draw;
-}
-
-$permList->signal_connect(button_press_event => sub {
- return unless $editable;
- my (undef, $event) = @_;
- my (undef, $iter) = $permList->get_selection->get_selected;
- return unless $iter;
- row_setting_dialog($iter) if $event->type eq '2button-press';
- });
-
-
-my $tips = Gtk2::Tooltips->new;
-
-$W->add(gtkpack_(Gtk2::VBox->new(0,5),
- 0, Gtk2::WrappedLabel->new(N("Here you can see files to use in order to fix permissions, owners, and groups via msec.\nYou can also edit your own rules which will owerwrite the default rules."), 0.5),
- 1, gtkadd(Gtk2::Frame->new,
- gtkpack_(gtkset_border_width(Gtk2::VBox->new, 5),
- 0, Gtk2::WrappedLabel->new(N("The current security level is %s.
-Select permissions to see/edit", $level), 0.5),
- 0, gtkpack_(gtkset_layout(Gtk2::HButtonBox->new, 'spread'),
- 0, $combo_perm,
- ),
- 1, create_scrolled_window($permList),
- 0, my $up_down_box = gtkadd(Gtk2::HBox->new(0, 5), @buttons =
- map {
- gtkset_tip($tips,
- gtksignal_connect(Gtk2::Button->new($_->[0]), clicked => $_->[2]),
- $_->[1]);
- } ([ N("Up"), N("Move selected rule up one level"), sub { move_callback('up') } ],
- [ N("Down"), N("Move selected rule down one level"), sub { move_callback('down') } ],
- [ N("Add a rule"), N("Add a new rule at the end"), \&add_callback ],
- [ N("Delete"), N("Delete selected rule"), \&del_callback ],
- [ N("Edit"), N("Edit current rule"), \&edit_callback ])),
- 0, Gtk2::VBox->new,
- ),
- ),
- 0, create_okcancel({
- cancel_clicked => sub { ugtk2->exit },
- ok_clicked => \&save_perm,
- },
- undef, undef, '',
- [ N("Help"), sub { unless (fork()) { exec("drakhelp --id drakperm") } } ],
- )
- )
- );
-$W->show_all;
-$w->{rwindow}->set_position('center') unless $::isEmbedded;
-
-$combo_perm->entry->set_text($perm_l10n{all});
-display_perm('all');
-my $_combo_sig = $combo_perm->entry->signal_connect(changed => sub {
- my $class = $rev_perm_l10n{$combo_perm->entry->get_text};
- $permList->set_reorderable($class eq 'editable');
- display_perm($class , @_);
- });
-
-$permList->get_selection->signal_connect('changed' => sub {
- my ($select) = @_;
- my (undef, $iter) = $select->get_selected;
- return if !$iter;
- my $locked = $model->get($iter, 0);
- sensitive_buttons($iter ? $editable && !$locked : 0);
- return if $locked;
- my $curr_path = $model->get_path($iter);
- hide_up_button_iffirst_item($curr_path);
- hide_down_button_iflast_item($curr_path);
- });
-
-$w->main;
-ugtk2->exit;
-
-
-sub hide_up_button_iffirst_item {
- my ($curr_path) = @_;
- my $first_path = $model->get_path($model->get_iter_first);
- $buttons[0]->set_sensitive($first_path && $first_path->compare($curr_path));
-}
-
-sub hide_down_button_iflast_item {
- my ($curr_path) = @_;
- $curr_path->next;
- my $next_item = $model->get_iter($curr_path);
- $buttons[1]->set_sensitive($next_item && !$model->get($next_item, 0));
-}
-
-
-sub display_perm {
- my ($perm_level) = @_;
- return unless $perm_level;
- my $show_sys_rules = $perm_level eq $default_perm_level;
- my $show_user_rules = $perm_level eq 'editable';
- my $show_all_rules = $perm_level eq 'all';
- # cleaner way: only remove filtered out rules, add those not any more filtered rather than refilling the whole tree
- $model->clear;
- foreach my $rule (@rules) {
- next if !$show_all_rules && ($show_user_rules && $rule->{editable} || $show_sys_rules && !$rule->{editable});
- $model->append_set(map_index { if_(defined $rule->{$_}, $::i => $rule->{$_}) } qw(editable path user group perms index));
- };
-
- # alter button box behavior
- $editable = $perm_level =~ /^level \d/ ? 0 : 1;
- $up_down_box->set_sensitive($editable);
- sensitive_buttons(0) if $editable;
-}
-
-sub save_perm() {
- my $val;
- if ($modified) {
- my $F;
- open $F, '>' . $perm_files{editable} or die(qq(Impossible to process "$perm_files{editable}"));
- $model->foreach(sub {
- my ($model, $_path, $iter) = @_;
- return 0 if $model->get($iter, 0);
- my $line = $model->get($iter, 1) . "\t" . $model->get($iter, 2) . ($model->get($iter, 3) ? "." . $model->get($iter, 3) : "") . "\t" . $model->get($iter, 4) . "\n";
- print $F $line;
- return 0;
- }, $val);
- close $F;
- }
- $modified = 0;
- ugtk2->exit;
-}
-
-sub load_perms() {
- foreach my $file (@perm_files{($default_perm_level, 'editable')}) {
- my @editable = if_($file ne $perm_files{editable}, editable => $pixbuf);
- local $_;
- foreach (cat_($file)) {
- next if /^#/;
- # Editable, Path, User, Group, Permissions
- if (m/^(\S+)\s+([^.\s]+)\.(\S+)?\s+(\d+)/) {
- push @rules, { @editable, path => $1, user => $2, group => $3, perms => $4, index => $index };
- } elsif (m/^(\S+)\s+current?\s+(\d+)/) {
- push @rules, { @editable, path => $1, user => 'current', group => '', perms => $2, index => $index };
- } else {
- warn qq(unparsable "$_"line);
- }
- $index++;
- }
- }
-}
-
-sub row_setting_dialog {
- my ($iter) = @_;
-
- my $dlg = Gtk2::Dialog->new;
- $dlg->set_transient_for($w->{rwindow}) unless $::isEmbedded;
- $dlg->set_modal(1);
-# $dlg->set_resizable(0);
- my $browse = Gtk2::Button->new(N("browse"));
- my $file = Gtk2::Entry->new;
- my ($other, $group, $user, $s) = reverse(split(//, $model->get($iter, 4))) if $iter;
- my @bits = qw(sticky gid suid);
- my @rights = qw(read write execute);
- my @owners = (N_("user"), N_("group"), N_("other"));
-
- my %rights = (user => $user, group => $group, other => $other);
- my %rights_labels = (user => N("User"), group => N("Group"), other => N("Other"));
- my %checks = ('read' => {
- label => N("Read"),
- tip => { map { $_ =>
- #-PO: here %s will be either "user", "group" or "other"
- N("Enable \"%s\" to read the file", translate($_))
- } keys %rights },
- },
- 'write' => {
- label => N("Write"),
- tip => { map { $_ =>
- #-PO: here %s will be either "user", "group" or "other"
- N("Enable \"%s\" to write the file", translate($_))
- } keys %rights },
- },
- 'execute' => {
- label => N("Execute"),
- tip => { map { $_ =>
- #-PO: here %s will be either "user", "group" or "other"
- N("Enable \"%s\" to execute the file", translate($_))
- } keys %rights },
- },
- sticky => { label => N("Sticky-bit"), tip => N("Used for directory:\n only owner of directory or file in this directory can delete it") },
- suid => { label => N("Set-UID"), tip => N("Use owner id for execution") },
- gid => { label => N("Set-GID"), tip => N("Use group id for execution") },
- );
-
- #- dlg widgets settings
- my %s_right = get_right($s);
-
- my $alrd_exsts = defined $iter;
- $file->set_text($model->get($iter, 1)) if $iter;
-
- my $users = Gtk2::ComboBox->new_with_strings([ get_user_or_group('users') ]);
- $users->entry->set_text($model->get($iter, 2)) if $iter;
-
- my $groups = Gtk2::ComboBox->new_with_strings([ get_user_or_group() ]);
- $groups->entry->set_text($model->get($iter, 3)) if $iter;
-
- my $id_box = gtkadd(Gtk2::HBox->new,
- Gtk2::Label->new(N("User:")),
- $users,
- Gtk2::Label->new(N("Group:")),
- $groups,
- );
-
- my $usr_check = gtksignal_connect(gtkset_tip($tips, Gtk2::CheckButton->new(N("Current user")),
- N("When checked, owner and group won't be changed")),
- clicked => sub { $id_box->set_sensitive(!$_[0]->get_active) });
-
- if ($iter && $model->get($iter, 2) eq 'current') {
- $usr_check->set_active(1);
- $id_box->set_sensitive(0)
- } else { $usr_check->set_active(0) }
-
-
- $browse->signal_connect(clicked => sub {
- my $file_dlg = Gtk2::FileSelection->new(N("Path selection"));
- $file_dlg->set_modal(1);
- $file_dlg->set_transient_for($dlg);
- $file_dlg->show;
- $file_dlg->set_filename($file->get_text);
- $file_dlg->cancel_button->signal_connect(clicked => sub { $file_dlg->destroy });
- $file_dlg->ok_button->signal_connect(clicked => sub {
- $file->set_text($file_dlg->get_filename);
- $file_dlg->destroy;
- });
- });
- my %perms;
-
- gtkpack_($dlg->vbox,
- 0, gtkadd(Gtk2::Frame->new(N("Path")),
- gtkpack_(gtkset_border_width(Gtk2::HBox->new, 3),
- 1, $file,
- 0, $browse
- )
- ),
- 0, gtkadd(Gtk2::Frame->new(N("Property")),
- gtkadd(gtkset_border_width(Gtk2::VBox->new, 3),
- $usr_check,
- $id_box,
- ),
- ),
- 1, gtkadd(Gtk2::Frame->new(N("Permissions")),
- gtkpack(gtkset_border_width(Gtk2::HBox->new, 3),
- gtkadd(Gtk2::VBox->new,
- Gtk2::Label->new(""),
- map { Gtk2::Label->new($checks{$_}{label}) } @rights,
- ),
- (map {
- my $owner = $_;
- $perms{$owner} = { get_right($rights{$owner}) };
- my $vbox = gtkadd(Gtk2::VBox->new,
- Gtk2::Label->new($rights_labels{$owner}),
- map {
- my $c = $_;
- my $active = $perms{$owner}{$c};
- $perms{$owner}{$c} = Gtk2::CheckButton->new;
- $tips->set_tip($perms{$owner}{$c},
- $checks{$c}{tip}{$owner},
- );
- gtkset_active($perms{$owner}{$c}, $active);
- } @rights,
- );
-
- $vbox;
- } @owners),
- gtkpack(Gtk2::VBox->new,
- Gtk2::Label->new(' '),
- map { $perms{$_} = gtkset_tip($tips, Gtk2::CheckButton->new($checks{$_}{label}), $checks{$_}{tip}) } @bits,
- ),
- ),
- ),
- );
- $perms{sticky}->set_active($s_right{execute});
- $perms{gid}->set_active($s_right{write});
- $perms{suid}->set_active($s_right{read});
-
- $dlg->set_has_separator(0);
-
- gtkadd($dlg->action_area,
- create_okcancel(my $w =
- {
- cancel_clicked => sub { $dlg->destroy },
- ok_clicked => sub {
- my ($path, $user, $group, $perms, $_idx);
- $path = $file->get_text;
- if ($usr_check->get_active) {
- $user = 'current';
- $group = '';
- } else {
- $user = $users->entry->get_text;
- $group = $groups->entry->get_text;
- }
- $perms = sprintf("%03o", eval(join('', "0b",
- (map { $perms{$_}->get_active || 0 } reverse @bits),
- (map { my $owner = $_;map_index {
- $perms{$owner}{$_}->get_active || 0
- } @rights } @owners))));
- # create new item if needed (that is when adding a new one) at end of list
- if (!$iter) {
- $iter = $model->append;
- push @rules, { path => $path, user => $user, group => $group, perms => $perms, index => $index };
- $model->set($iter, 5 => $index++);
- }
- $model->set($iter, 1 => $path, 2 => $user, 3 => $group, 4 => $perms);
- $dlg->destroy;
- $modified++;
- }
- },
- ),
- );
-
- $w->{ok}->set_sensitive(!$model->get($iter, 0)) if $alrd_exsts;
- $dlg->show_all;
-
-}
-
-sub get_user_or_group {
- my ($what) = @_;
- my @users;
-
- local $_;
- foreach (cat_($what eq 'users' ? '/etc/passwd' : '/etc/group')) {
- m/^([^#:]+):[^:]+:[^:]+:/ or next;
- push @users, $1;
- }
- return sort(@users);
-}
-
-sub get_right {
- my ($right) = @_;
- my %rght = ('read' => 0, 'write' => 0, 'execute' => 0);
- $right - 4 >= 0 and $rght{read}=1 and $right = $right-4;
- $right - 2 >= 0 and $rght{write}=1 and $right = $right-2;
- $right - 1 >= 0 and $rght{execute}=1 and $right = $right-1;
- return %rght;
-}
-
-sub sensitive_buttons {
- foreach my $i (0, 1, 3, 4) {
- $buttons[$i]->set_sensitive($_[0]);
- }
-}
diff --git a/perl-install/standalone/drakproxy b/perl-install/standalone/drakproxy
deleted file mode 100755
index 622c61859..000000000
--- a/perl-install/standalone/drakproxy
+++ /dev/null
@@ -1,34 +0,0 @@
-#!/usr/bin/perl
-
-# DrakProxy
-
-# Copyright (C) 1999-2004 Mandrakesoft (damien@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use interactive;
-use network::network;
-use any;
-use common;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/drakproxy-mdk.png";
-my $u = { getVarsFromSh('/etc/profile.d/proxy.sh') };
-my $in = 'interactive'->vnew('su');
-network::network::miscellaneous_choose($in, $u);
-network::network::proxy_configure($u);
-$in->exit(0);
diff --git a/perl-install/standalone/drakpxe b/perl-install/standalone/drakpxe
deleted file mode 100755
index 5e374faff..000000000
--- a/perl-install/standalone/drakpxe
+++ /dev/null
@@ -1,515 +0,0 @@
-#!/usr/bin/perl
-#
-# François Pons <fpons@mandrakesoft.com>
-#
-# Copyright 2003-2004 Mandrakesoft
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License version 2, as
-# published by the Free Software Foundation.
-#
-# 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use interactive;
-use network::network;
-use log;
-use c;
-
-$::isInstall and die "Not supported during install.\n";
-
-$::Wizard_pix_up = "drakgw.png"; #- to change ? keep existing one, nobody will see (too late) ;-)
-my $direct = grep { /-direct/ } @ARGV;
-
-
-#
-#my $sysconf_network = "/etc/sysconfig/network";
-#my $sysconf_dhcpd = "/etc/sysconfig/dhcpd";
-#my $rc_firewall_generic = "/etc/rc.d/rc.firewall";
-#my $rc_firewall_drakgw = "/etc/rc.d/rc.firewall.inet_sharing";
-#my $rc_firewall_24 = "/etc/rc.d/rc.firewall.inet_sharing-2.4";
-#my $masq_file = "/etc/shorewall/masq";
-#my $cups_conf = "/etc/cups/cupsd.conf";
-#
-#my $shorewall = network::shorewall::read();
-#
-#- get network configuration.
-my $netc = {};
-my $intf = {};
-network::network::read_all_conf('', $netc, $intf);
-
-my $in = 'interactive'->vnew('su');
-$::Wizard_title = N("PXE Server Configuration");
-
-!$::isEmbedded && $in->isa('interactive::gtk') and $::isWizard = 1;
-
-#pur_gtk_mode() if $::isEmbedded && $in->isa('interactive::gtk');
-
-sub sys { system(@_) == 0 or log::l("[drakpxe] Warning, sys failed for $_[0]") }
-
-sub outpend {
- log::explanations("modified file $_[0]");
- my $f = shift; local *F; open F, ">>$f" or die "outpend in file $f failed: $!\n"; print F foreach @_;
-}
-
-sub start_daemons () {
- log::explanations("Starting daemons");
-
- system("/etc/rc.d/init.d/dhcpd status >/dev/null") == 0 and sys("/etc/rc.d/init.d/dhcpd stop");
-
- sys("/etc/rc.d/init.d/$_ start >/dev/null"), sys("/sbin/chkconfig --level 345 $_ on") foreach 'httpd', 'dhcpd';
-}
-
-sub stop_daemons () {
- log::explanations("Stopping daemons");
- foreach (qw(dhcpd httpd)) {
- system("/etc/rc.d/init.d/$_ status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/$_ stop");
- }
- sys("/sbin/chkconfig --level 345 $_ off") foreach 'dhcpd', 'httpd';
-}
-
-my $wait_configuring;
-
-sub quit_global {
- my ($in, $exitcode) = @_;
- $in->exit($exitcode);
- goto begin
-}
-
-sub fatal_quit ($) {
- log::l("[drakpxe] FATAL: $_[0]");
- undef $wait_configuring;
- $in->ask_warn('', $_[0]);
- quit_global($in, -1);
-}
-
-#my ($kernel_version) = c::kernel_version() =~ /(...)/;
-#log::l("[drakgw] kernel_version $kernel_version");
-#
-#$kernel_version >= 2.4 or fatal_quit(N("Sorry, we support only 2.4 kernels."));
-
-begin:
-
-#- **********************************
-#- * 0th step: verify if we have multiple network interface.
-
-$::Wizard_no_previous = 1;
-
-$direct or $in->ask_okcancel(N("Installation Server Configuration"),
-N("You are about to configure your computer to install a PXE server as a DHCP server
-and a TFTP server to build an installation server.
-With that feature, other computers on your local network will be installable using this computer as source.
-
-Make sure you have configured your Network/Internet access using drakconnect before going any further.
-
-Note: you need a dedicated Network Adapter to set up a Local Area Network (LAN)."), 1) or quit_global($in, 0);
-
-undef $::Wizard_no_previous;
-
-
-#- **********************************
-#- * 1st step: verify if we have multiple network interface.
-
-step_check_intf:
-
-my @intf = grep { exists $_->{NETWORK} } map {
- unless ($_->{NETWORK}) {
- foreach my $s (split "\n", `route`) {
- print STDERR "$s\n";
- $s =~ /^(\S+)\s+\S+\s+$_->{NETMASK}\s+.*$_->{DEVICE}/ and $_->{NETWORK} = $1;
- }
- } $_ } values %$intf;
-if (@intf < 1) {
- #- no interface already configured found, ask user to configure.
- $in->ask_warn(N("No network adapter on your system!"),
- N("No ethernet network adapter has been detected on your system. Please run the hardware configuration tool."));
- quit_global($in, 0);
-} elsif (@intf > 1) {
- #- there are more than one interface, we need to choose one of them.
- @intf = $in->ask_from_listf(N("Choose the network interface"),
- N("Please choose which network interface will be used for the dhcp server."),
- sub { N("Interface %s (on network %s)", $_[0]{DEVICE}, $_[0]{NETWORK}) },
- \@intf,
- ) or goto begin;
-}
-
-
-#- **********************************
-#- * 3rd step: select installation directory to be used (if not present, next step
-#- will be creation and copy from existing one).
-
-step_ip_range:
-
-#- read current configuration, or create a default suitable automatically.
-my $dhcpd_conf = parse_dhcpd_conf("/etc/dhcpd.conf", {}, $netc, $intf[0]);
-
-#- get back default of ip.
-my $pool;
-foreach (@{$dhcpd_conf->{network}{pool}}) {
- exists $_->{allow}{$dhcpd_conf->{class_PXE}} and $pool = $_, last;
-}
-my ($start_ip, $end_ip) = @{$pool || { start_ip => join('.', (split '\.', $intf[0]{NETWORK})[0..2], 16),
- end_ip => join('.', (split '\.', $intf[0]{NETWORK})[0..2], 253) }}{qw(start_ip end_ip)};
-
-#- it become too complicated to handle address range, so ask user directly.
-$in->ask_from('DHCP Server Configuration',
- N("The DHCP server will allow other computer to boot using PXE in the given range of address.
-
-The network address is %s using a netmask of %s.
-
-", $intf[0]{NETWORK}, $intf[0]{NETMASK}), [ { label => N("The DHCP start ip"), val => \$start_ip, type => 'entry' },
- { label => N("The DHCP end ip"), val => \$end_ip, type => 'entry' }, ])
- or goto begin;
-
-
-#- **********************************
-#- * 3rd step: select installation directory to be used (if not present, next step
-#- will be creation and copy from existing one).
-
-step_install_dir:
-
-my $dir = "/export"; #- TODO change according configuration?
-
-$in->ask_from('Choose the installation image directory',
- N("Please indicate where the installation image will be available.
-
-If you do not have an existing directory, please copy the CD or DVD contents.
-
-"),
- [ { label => N("Installation image directory"), val => \$dir, type => 'entry' }, ])
- or goto step_ip_range;
-
-unless (-d $dir && -e "$dir/VERSION" && -d "$dir/install/isolinux" && -d "$dir/install/stage2") {
- $in->ask_warn(N("No image found"),
- N("No CD or DVD image found, please copy the installation program and rpm files."));
- goto step_install_dir;
-}
-
-#- **********************************
-#- * 4st step: ask user for auto installation file.
-
-step_auto_install:
-
-my $auto_inst_cfg = "install/auto_inst.cfg"; #- TODO change according configuration?
--e "$dir/$auto_inst_cfg" or $auto_inst_cfg = '';
-
-$in->ask_from('Choose auto installation',
- N("Please indicate where the auto_install.cfg file is located.
-
-Leave it blank if you do not want to set up automatic installation mode.
-
-"),
- [ { label => N("Location of auto_install.cfg file"), val => \$auto_inst_cfg, type => 'entry' }, ])
- or goto step_install_dir;
-
-#- now install packages...
-my %rpm2file = ('dhcp-server' => '/usr/sbin/dhcpd',
- 'pxe' => '/usr/sbin/pxe',
- 'tftp-server' => '/usr/sbin/in.tftpd',
- if_(! -x '/usr/sbin/httpd' && ! -x '/usr/sbin/httpd-perl', 'apache2' => '/usr/sbin/httpd2'));
-
-#- first: try to install all in one step
-my @needed_to_install = grep { !-e $rpm2file{$_} } keys %rpm2file;
-@needed_to_install and $in->do_pkgs->install(@needed_to_install);
-#- second: try one by one if failure detected
-if (any { !-e $rpm2file{$_} } keys %rpm2file) {
- foreach (keys %rpm2file) {
- -e $rpm2file{$_} or $in->do_pkgs->install($_);
- -e $rpm2file{$_} or fatal_quit(N("Problems installing package %s", $_));
- }
-}
-
-#- check if a pool already exist allowing PXE, else create one wich will be correct.
-if ($pool) {
- @$pool{qw(start_ip end_ip)} = ($start_ip, $end_ip);
-} else {
- $pool = { start_ip => $start_ip, end_ip => $end_ip };
- foreach (keys %{$dhcpd_conf->{class}}) {
- $pool->{$_ eq $dhcpd_conf->{class_PXE} || $_ eq 'Etherboot' ? 'allow' : 'deny'}{$_} = undef;
- }
- push @{$dhcpd_conf->{network}{pool}}, $pool;
-}
-build_dhcpd_conf($dhcpd_conf, "/etc/dhcpd.conf");
-
-#- make kernel and initrd available for initrd.
-mkdir "/var/lib/tftpboot/PXEClient/images";
-sys("cp", "-af", "$dir/install/isolinux/alt0", "/var/lib/tftpboot/PXEClient/images/");
-
-my $pxelinux_cfg = parse_pxelinux_cfg("/var/lib/tftpboot/PXEClient/pxelinux.cfg/default");
-my $label;
-foreach my $i (0..99) {
- $label = undef;
- foreach my $e (@{$pxelinux_cfg->{entry}}) {
- $e->{label} eq "halt$i" and $label = "halt$i", last;
- }
- defined $label or $label = "halt$i", last;
-}
-my $server = $intf[0]{IPADDR} || $netc->{HOSTNAME};
-push @{$pxelinux_cfg->{entry}}, { label => $label,
- kernel => "images/alt0/vmlinuz",
- append => "initrd=images/alt0/all.rdz ramdisk=32000 vga=788 ".($auto_inst_cfg ? "kickstart=$auto_inst_cfg " : "")."automatic=method:http,network:dhcp,interface:eth0,dns:$netc->{dnsServer},server:$server,directory:$dir root=/dev/ram3" };
-build_pxelinux_cfg($pxelinux_cfg, "/var/lib/tftpboot/PXEClient/pxelinux.cfg/default");
-
-#- make directory available for httpd.
-log::explanations("Linking $dir in /var/www/html to make it available");
-system "mkdir", "-p", "/var/www/html/$dir";
-rmdir "/var/www/html/$dir";
-symlink $dir, "/var/www/html/$dir";
-
-stop_daemons();
-start_daemons();
-
-#- sub for reading/writing dhcpd.conf and pxelinux.cfg/default...
-sub parse_dhcpd_conf {
- my ($file, undef, $netc, $intf) = @_;
- my (%dhcpd_conf, $pool);
- local (*F, $_);
-
- #- fake reading configuration from dhcpd.conf file which is really too complex for this tools.
- $dhcpd_conf{class_PXE} = 'PXE';
- $dhcpd_conf{class} = { PXE => undef, Etherboot => undef, known => undef };
- add2hash($dhcpd_conf{network} = { pool => [] }, $intf);
- add2hash($dhcpd_conf{network}, $netc);
-
- if (open F, $file) {
- while (<F>) {
- if (/^\s*pool\s*{/ .. /}/) {
- /^\s*range\s+(\S+)\s+(\S+)\s*;/ and ($pool->{start_ip}, $pool->{end_ip}) = ($1, $2);
- /^\s*(allow|deny)\s+members\s+of\s+"([^"]*)"\s*;/ and $pool->{$1}{$2} = undef;
- /}/ and do { push @{$dhcpd_conf{network}{pool}}, $pool; $pool = undef };
- }
- }
- close F;
- }
-
- \%dhcpd_conf;
-}
-
-sub build_dhcpd_conf {
- my ($dhcpd_conf, $file) = @_;
- local *F;
- my $server = $dhcpd_conf->{network}{IPADDR} || $dhcpd_conf->{network}{HOSTNAME};
- open F, ">$file" or return;
- log::explanations("Modified file $file");
- print F qq(# for explanation in french go to : http://www.delafond.org/traducmanfr/man/man5/dhcpd.conf.5.html
-ddns-update-style none;
-allow booting;
-allow bootp;
-
-# Your dhcp server is not master on your network !
-#not authoritative;
-# Your dhcpd server is master on your network !
-#authoritative;
-not authoritative;
-
-#Interface where dhcpd is active
-DHCPD_INTERFACE = "$dhcpd_conf->{network}{DEVICE}";
-
-# Definition of PXE-specific options
-# Code 1: Multicast IP address of bootfile
-# Code 2: UDP port that client should monitor for MTFTP responses
-# Code 3: UDP port that MTFTP servers are using to listen for MTFTP requests
-# Code 4: Number of secondes a client must listen for activity before trying
-# to start a new MTFTP transfer
-# Code 5: Number of secondes a client must listen before trying to restart
-# a MTFTP transfer
-
-# define Option for the PXE class
-option space PXE;
-option PXE.mtftp-ip code 1 = ip-address;
-option PXE.mtftp-cport code 2 = unsigned integer 16;
-option PXE.mtftp-sport code 3 = unsigned integer 16;
-option PXE.mtftp-tmout code 4 = unsigned integer 8;
-option PXE.mtftp-delay code 5 = unsigned integer 8;
-option PXE.discovery-control code 6 = unsigned integer 8;
-option PXE.discovery-mcast-addr code 7 = ip-address;
-
-#Define options for pxelinux
-option space pxelinux;
-option pxelinux.magic code 208 = string;
-option pxelinux.configfile code 209 = text;
-option pxelinux.pathprefix code 210 = text;
-option pxelinux.reboottime code 211 = unsigned integer 32;
-site-option-space "pxelinux";
-# These lines should be customized to your setup
-#option pxelinux.configfile "configs/common";
-#option pxelinux.pathprefix "/pxelinux/files/";
-#filename "/pxelinux/pxelinux.bin";
-
-option pxelinux.magic f1:00:74:7e;
-option pxelinux.reboottime 30;
-#if exists dhcp-parameter-request-list {
- # Always send the PXELINUX options
-# append dhcp-parameter-request-list 208, 209, 210, 211;
-# append dhcp-parameter-request-list 208,211;
-# }
-
-#Class that determine the options for Etherboot 5.x requests
-class "Etherboot" {
-
-#if The vendor-class-identifier equal Etherboot-5.0
-match if substring (option vendor-class-identifier, 0, 9) = "Etherboot";
-
-# filename define the file retrieve by the client, there nbgrub
-# our TFTP is chrooted so is just the path to the file
-filename "/etherboot/nbgrub";
-
-#Used by etherboot to detect a valid pxe dhcp server
-option vendor-encapsulated-options 3c:09:45:74:68:65:72:62:6f:6f:74:ff;
-
-# Set the "vendor-class-identifier" field to "PXEClient" in dhcp answer
-# if this field is not set the pxe client will ignore the answer !
-option vendor-class-identifier "Etherboot";
-
-vendor-option-space PXE;
-option PXE.mtftp-ip 0.0.0.0;
-
-# IP of you TFTP server
-next-server $server;
-}
-
-
-# create the Class PXE
-class "PXE" {
-# if the "vendor-class-identifier" is set to "PXEClient" in the client dhcp request
-match if substring(option vendor-class-identifier, 0, 9) = "PXEClient";
-
-# filename define the file retrieve by the client, there pxelinux.0
-# our TFTP is chrooted so is just the path to the file
-# If you prefer use grub, use pxegrub compiled for your ethernet card.
-#filename "/PXEClient/pxegrub";
-filename "/PXEClient/pxelinux.0";
-
-# Set the "vendor-class-identifier" field to "PXEClient" in dhcp answer
-# if this field is not set the pxe client will ignore the answer !
-option vendor-class-identifier "PXEClient";
-
-
-vendor-option-space PXE;
-option PXE.mtftp-ip 0.0.0.0;
-
-# IP of you TFTP server
-next-server $server;
-}
-
-# the class know exist just for deny the response to other DHCP request
-class "known" {
- match hardware;
- one-lease-per-client on;
- ddns-updates on;
- ddns-domainname = "$dhcpd_conf->{network}{DOMAINNAME}";
- option domain-name "$dhcpd_conf->{network}{DOMAINNAME}";
- option domain-name-servers $dhcpd_conf->{network}{dnsServer};
- ddns-hostname = pick-first-value(ddns-hostname, option host-name);
- option fqdn.no-client-update on;
- set vendor_class_identifier = option vendor-class-identifier;
-}
-
-# Tags uses by setup_node_mac_to_dhcp
-# TAG: NODE_LIST_BEGIN
-
-# TAG: NODE_LIST_END
-shared-network "mynetwork" {
- subnet $dhcpd_conf->{network}{NETWORK} netmask $dhcpd_conf->{network}{NETMASK} {
- option subnet-mask $dhcpd_conf->{network}{NETMASK};
- option routers $dhcpd_conf->{network}{GATEWAY};
- default-lease-time 28800;
- max-lease-time 86400;
- option domain-name "$dhcpd_conf->{network}{DOMAINNAME}";
- option domain-name-servers $dhcpd_conf->{network}{dnsServer};
-# Used by clusterautosetup-client to find its server
- next-server $server;
-
-);
- foreach (@{$dhcpd_conf->{network}{pool}}) {
- print F " pool {
- range $_->{start_ip} $_->{end_ip};
-";
- print F qq( allow members of "$_";\n) foreach keys %{$_->{allow}};
- print F qq( deny members of $_";\n) foreach keys %{$_->{deny}};
- print F " }\n";
- }
-print F qq(
-
-# pool {
-# range 192.168.200.200 192.168.200.254;
-# give an address of the the pool for PXE client and deny the other
-#allow members of "PXE";
-#deny members of "known";
-#allow members of "Etherboot";
-# }
- }
-}
-);
- close F;
-}
-
-sub parse_pxelinux_cfg {
- my ($file) = @_;
- my (%pxelinux_cfg, $entry);
- local (*F, $_);
-
- if (open F, $file) {
- while (<F>) {
- chomp;
- s/#.*//; next if /^\s*$/;
- if (/^\s*(PROMPT|DEFAULT|DISPLAY|TIMEOUT)\s+(.*)/i) {
- $pxelinux_cfg{$1} = $2;
- } elsif (/^\s*label\s+(.*)/i) {
- $entry and push @{$pxelinux_cfg{entry}}, $entry;
- $entry = { label => $1 },
- } elsif (/^\s*(LOCALBOOT|KERNEL|APPEND)\s+(.*)/i) {
- $entry->{$1} = $2;
- } else {
- log::l("ignoring line in file $file due to parsing error");
- }
- }
- $entry and push @{$pxelinux_cfg{entry}}, $entry;
- close F;
- }
- #- try to fix bad file (first version of drakpxe for example).
- my %default_pxelinux_cfg = (PROMPT => 1,
- DEFAULT => "local",
- DISPLAY => "messages",
- TIMEOUT => 50,
- entry => [ { label => "local",
- LOCALBOOT => 0 } ],
- );
- foreach (qw(PROMPT DEFAULT DISPLAY TIMEOUT entry)) {
- length $pxelinux_cfg{$_} > 0 or $pxelinux_cfg{$_} = $default_pxelinux_cfg{$_};
- }
- \%pxelinux_cfg;
-}
-
-sub build_pxelinux_cfg {
- my ($pxelinux_cfg, $file) = @_;
- local *F;
- open F, ">$file" or return;
- log::explanations("Modified file $file");
- foreach (keys %$pxelinux_cfg) {
- /^entry$/ and next;
- print F "$_ $pxelinux_cfg->{$_}\n";
- }
- foreach my $e (@{$pxelinux_cfg->{entry}}) {
- print F "label $e->{label}\n";
- foreach (keys %$e) {
- /^label$/ and next;
- print F " $_ $e->{$_}\n";
- }
- }
- close F;
-}
-
diff --git a/perl-install/standalone/drakroam b/perl-install/standalone/drakroam
deleted file mode 100755
index bdb25e61c..000000000
--- a/perl-install/standalone/drakroam
+++ /dev/null
@@ -1,397 +0,0 @@
-#!/usr/bin/perl
-
-# drakroam: wireless network roaming GUI
-# beta version uses wlandetect as backend
-# Austin Acton, 2004
-# <austin@mandrake.org>
-# Licensed under the GPL
-
-# problems
-# - deletes comments in config file
-# - expects an ifcfg file for static IP configurations (not uncommon)
-# - roaming status fails (no idea why)
-# maybe same reason bash-completion killall can't see wlandetect?
-
-# todo (wlandetect version)
-# - make known and available lists have more rows by default (why so small?)
-# - refresh status every x seconds
-# - find a good way to drop the access point and resume roaming
-# - make 'key' column wider by default
-# todo (waproamd version)
-# - listen to dbus for pings from waproamd; update all on receiving a dbus ping
-# - setup static network configurations
-# - handle keys (can key file be named after ESSID?)
-# - should files be named as MAC or as essid:ESSID ?
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone;
-use common;
-use run_program;
-
-require ugtk2;
-ugtk2->import(qw(:wrappers :create));
-use Gtk2::SimpleList;
-
-require_root_capability();
-
-# global settings
-my $route = '/sbin/route';
-my $AboutFile = 'ABOUT';
-my $HelpFile = 'README';
-my $IWList = '/sbin/iwlist';
-my $IWConfig = '/sbin/iwconfig';
-my $IFConfig = '/sbin/ifconfig';
-my $IFUp = '/sbin/ifup';
-my $IFDown = '/sbin/ifdown';
-my $DHClient = '/sbin/dhclient';
-
-# initialize variables
-my $ScanInterval = 30; # tell deamon to search for new nets every x seconds
-
-my ($KnownList, $AvailableList);
-my $device;
-
-my %available_roaming_daemons = (
- wlandetect => {
- config_location => '/etc/wlandetect.conf',
- binary => '/usr/sbin/wlandetect',
- start_options => sub {
- my ($interval, $device) = @_;
- "-d -t $interval";
- },
- read_config => sub {
- my ($config) = @_;
- each_index {
- /^#/ || /^\n/ and next; #ignore comments and blank lines
- if (/^(\S+)\s+(.*)$/) {
- my ($essid, $mode, $channel, $dhcp, $key);
- my $command = $2;
- # setup new network entry
- $essid = $1;
- ($mode) = $command =~ /mode\s([^\s;]+)/;
- ($channel) = $command =~ /channel\s([^\s;]+)/;
- ($key) = $command =~ /key\s([^\s;]+)/;
- $dhcp = $command =~ /dhclient/;
- &AddNet($essid, $mode, $channel, $dhcp, $key);
- }
- else { die "Line $::i of configuration file is not parseable.\n" }
- } cat_($config)
- },
- write_config => sub {
- my ($config) = @_;
- my @contents = (
- "#wlandetect configuration file\n",
- "#format: essid<tab><tab>commands\n",
- "#use \@DEV\@ for device name\n"
- );
- foreach my $row (@{$KnownList->{data}}) { # again, lame
- my $essid = $row->[0];
- my $iwc = join(' ', $IWConfig, "essid $essid",
- if_($row->[1], "mode $row->[1]"),
- if_($row->[2], "channel $row->[2]"),
- if_($row->[4], "key $row->[4]"));
- my $ifc = $row->[3] ? "$IFConfig \@DEV\@ up; $DHClient \@DEV\@" : "$IFUp \@DEV\@";
- push @contents, "$essid\t\t$iwc; $ifc\n";
- }
- output_p($config, @contents);
- },
- add_net => sub {},
- remove_net => sub {},
- },
- waproamd => {
- config_location => '/etc/waproamd/scripts',
- binary => '/usr/sbin/waproamd',
- start_options => sub {
- my ($interval, $device) = @_;
- "-i $device -t $interval";
- },
- read_config => sub {
- my ($config) = @_;
- foreach my $net (all($config)) {
- $net eq "default" or next;
- print "Adding net $net\n";
- push @{$KnownList->{data}}, [$net];
- }
- },
- write_config => sub {},
- add_net => sub {
- my ($config, $essid) = @_;
- output_p("$config/$essid", qq(# essid specific config file));
- },
- remove_net => sub {
- my ($config, $essid) = @_;
- system("rm -f $config/$essid");
- },
- },
-);
-
-my $roaming_daemon = $available_roaming_daemons{wlandetect};
-
-my $ScanEntry = Gtk2::Entry->new;
-$ScanEntry->set_width_chars(4);
-$ScanEntry->set_text($ScanInterval);
-
-$KnownList = Gtk2::SimpleList->new(
- "ESSID" => "text",
- "Mode" => "text",
- "Channel" => "text",
- "DHCP" => "bool",
- "Key" => "text"
- );
-$KnownList->get_selection->set_mode('single');
-$KnownList->set_reorderable(1);
-$KnownList->set_column_editable(1, TRUE); # allow to change mode
-$KnownList->set_column_editable(2, TRUE); # allow to change channel
-$KnownList->set_column_editable(4, TRUE); # allow to change key
-
-$AvailableList = Gtk2::SimpleList->new(
- "ESSID" => "text",
- "Type" => "text",
- "Encryption" => "text",
- "Signal (%)" => "int"
- );
-$AvailableList->get_selection->set_mode('single');
-
-my $NetLabel = Gtk2::Label->new;
-my $IpLabel = Gtk2::Label->new;
-my $GwLabel = Gtk2::Label->new;
-my $ModeLabel = Gtk2::Label->new;
-my $WepLabel = Gtk2::Label->new;
-my $SignalLabel = Gtk2::Label->new;
-
-my $w = ugtk2->new('Drakroam');
-gtkadd(gtkset_border_width($w->{window}, 2),
- gtkpack_(Gtk2::VBox->new,
- 0, gtkadd(gtkset_border_width(Gtk2::Frame->new("Status"), 2),
- gtkpack(Gtk2::VBox->new,
- create_packtable({ col_spacings => 5, row_spacings => 5, homogenous => 1 },
- [ $NetLabel, $IpLabel, $GwLabel ],
- [ $ModeLabel, $WepLabel, $SignalLabel ],
- ),
- gtkpack(create_hbox(),
- gtksignal_connect(Gtk2::Button->new("Disconnect"), clicked => sub { &Disconnect }),
- gtksignal_connect(Gtk2::Button->new("Refresh"), clicked => sub { &UpdateStatus })
- )
- )
- ),
- 0, gtkadd(gtkset_border_width(Gtk2::Frame->new("Roaming"), 2),
- gtkpack(create_hbox(),
- gtkpack(Gtk2::VBox->new,
- my $RoamStatus = Gtk2::Label->new("Roaming: off"),
- gtkpack(create_hbox(),
- gtksignal_connect(Gtk2::Button->new("Start"), clicked => sub { &StartRoam }),
- gtksignal_connect(Gtk2::Button->new("Stop"), clicked => sub { &StopRoam })
- )
- ),
- gtkpack(Gtk2::VBox->new,
- Gtk2::Label->new("Scan interval (sec): "),
- gtkpack(Gtk2::HBox->new,
- $ScanEntry,
- gtksignal_connect(Gtk2::Button->new("Set"), clicked => sub { &SetInterval })
- )
- )
- )
- ),
- 1, gtkadd(gtkset_border_width(Gtk2::Frame->new("Known Networks (Drag up/down or edit)"), 2),
- gtkpack_(Gtk2::VBox->new,
- 1, create_scrolled_window($KnownList),
- 0, gtkpack(create_hbox(),
- gtksignal_connect(Gtk2::Button->new("Remove"), clicked => sub {
- my ($selected) = $KnownList->get_selected_indices;
- &RemoveNet($selected);
- }),
- gtksignal_connect(Gtk2::Button->new("Connect"), clicked => sub {
- my ($selected) = $KnownList->get_selected_indices;
- &ConnectNow($selected);
- }),
- gtksignal_connect(Gtk2::Button->new("Save"), clicked => sub { &WriteConfig })
- )
- )
- ),
- 1, gtkadd(gtkset_border_width(Gtk2::Frame->new("Available Networks"), 2),
- gtkpack_(Gtk2::VBox->new,
- 1, create_scrolled_window($AvailableList),
- 0, gtkpack(create_hbox(),
- gtksignal_connect(Gtk2::Button->new("Add"), clicked => sub {
- my @selected = $AvailableList->get_selected_indices;
- my ($mode, $channel, $key);
- my $essid = $AvailableList->{data}["@selected"][0];
- my $dhcp = 1; # assume dhcp for new networks
- &AddNet($essid, $mode, $channel, $dhcp, $key);
- }),
- gtksignal_connect(Gtk2::Button->new("Rescan"), clicked => sub { &UpdateAvailable })
- )
- )
- ),
- 0, gtkpack(create_hbox(),
- gtksignal_connect(Gtk2::Button->new("Help"), clicked => sub { &Dialog($HelpFile) }),
- gtksignal_connect(Gtk2::Button->new("About"), clicked => sub { &Dialog($AboutFile) }),
- gtksignal_connect(Gtk2::Button->new("Save and close"), clicked => sub {
- &WriteConfig;
- Gtk2->main_quit;
- })
- )
- )
- );
-
-# fill the GUI
-&ReadConfig;
-&UpdateAll;
-
-sub UpdateAll {
- &UpdateAvailable; #must go first as it defines the device name
- &UpdateStatus;
- &UpdateRoaming;
-}
-
-sub isRoamingRunning() {
- my $name = basename($roaming_daemon->{binary});
- any { /\Q$name\E$/ } run_program::get_stdout("ps", "-A");
-}
-
-sub UpdateRoaming() {
- my $status = isRoamingRunning() ? "on" : "off";
- $RoamStatus->set_text("Roaming: $status");
- return FALSE; #- do not update again if launched on timeout
-}
-
-sub UpdateStatus() {
- my $CurrentNet = "-";
- my $CurrentIP = "---.---.---.---";
- my $CurrentGW = "---.---.---.---";
- my $CurrentMode = "";
- my $CurrentWEP = "";
- my $CurrentSignal = "-";
- print("Updating\n");
- foreach (run_program::get_stdout($IWConfig, $device)) {
- /ESSID:"(\S*)"/ and $CurrentNet = $1;
- /Mode:(\S*)\s/ and $CurrentMode = $1;
- /key:(\S*)\s/ and $CurrentWEP = $1;
- m!Quality:(\S*)/! and $CurrentSignal = $1;
- }
- foreach (run_program::get_stdout($IFConfig, $device)) {
- if (/inet addr:(\S*)\s/) { $CurrentIP = $1 }
- }
- foreach (run_program::get_stdout($route)) {
- if (/default\s*(\S*)\s/) { $CurrentGW = $1 }
- else { $CurrentGW = "---.---.---.---" }
- }
- $NetLabel->set_text("Net: $CurrentNet");
- $ModeLabel->set_text("Mode: $CurrentMode");
- $IpLabel->set_text("IP: $CurrentIP");
- $WepLabel->set_text("Encryption: $CurrentWEP");
- $GwLabel->set_text("Gateway: $CurrentGW");
- $SignalLabel->set_text("Signal: $CurrentSignal");
-}
-
-sub UpdateAvailable() {
- my ($essid, $mode, $wep, $signal);
- print("Running iwlist\n");
- @{$AvailableList->{data}} = ();
- foreach (run_program::get_stdout($IWList, "scan")) {
- /([^ ]+)([ \t]+)Scan completed :/ and $device = $1;
- /([^ ]+)([ \t]+)No scan results/ and $device = $1;
- /ESSID:"(\S*)"/ and $essid = $1;
- /Mode:(\S*)/ and $mode = $1;
- m!Quality:(\S*)/! and $signal = $1;
- if (/key:(\S*)\s/) {
- $wep = $1;
- print("ESSID: $essid, Mode: $mode, WEP: $wep, Signal: $signal\n");
- push @{$AvailableList->{data}}, [$essid, $mode, $wep, $signal];
- }
- }
-}
-
-sub AddNet {
- my ($essid, $mode, $channel, $dhcp, $key) = @_;
- print "Adding net $essid\n";
- push @{$KnownList->{data}}, [ $essid, $mode, $channel, $dhcp, $key ];
- $_->{add_net}($_->{config_location}, $essid) foreach values %available_roaming_daemons;
-}
-
-sub RemoveNet {
- my ($selected) = @_;
- my $essid = $KnownList->{data}[$selected][0];
- print "Removing net $essid\n";
- splice @{$KnownList->{data}}, $selected, 1;
- $_->{remove_net}($_->{config_location}, $essid) foreach values %available_roaming_daemons;
-}
-
-sub ReadConfig() {
- $_->{read_config}($_->{config_location}) foreach values %available_roaming_daemons;
-}
-
-sub WriteConfig() {
- $_->{write_config}($_->{config_location}) foreach values %available_roaming_daemons;
-}
-
-sub StartRoam() {
- my $options = $roaming_daemon->{start_options}($ScanInterval, $device);
- my $name = basename($roaming_daemon->{binary});
- system("killall $name; $roaming_daemon->{binary} $options &");
- Glib::Timeout->add(1000, \&UpdateRoaming);
-}
-
-sub StopRoam() {
- my $name = basename($roaming_daemon->{binary});
- system("killall $name");
- Glib::Timeout->add(1000, \&UpdateRoaming);
-}
-
-sub SetInterval() {
- $ScanInterval = $ScanEntry->get_text;
- if (isRoamingRunning()) {
- StopRoam();
- StartRoam();
- }
-}
-
-sub ConnectNow {
- my ($row) = @_;
- my @command = "";
- push @command, "$IWConfig $device essid $KnownList->{data}[$row][0] ";
- if ($KnownList->{data}[$row][1]) {
- push @command, "mode $KnownList->{data}[$row][1] ";
- }
- if ($KnownList->{data}[$row][2]) {
- push @command, "channel $KnownList->{data}[$row][2] ";
- }
- if ($KnownList->{data}[$row][4]) {
- push @command, "key $KnownList->{data}[$row][4] ";
- }
- push @command, "; ";
- if ($KnownList->{data}[$row][3]) {
- push @command, "$IFConfig $device up; $DHClient $device";
- }
- else {
- push @command, "$IFUp $device"
- }
- my $ToBash = join("", @command);
- print("Sending $ToBash\n");
- system($ToBash);
- &UpdateStatus;
-}
-
-sub Disconnect {
- print("Dropping $device\n");
- system("$IFDown $device");
- &UpdateStatus;
-}
-
-sub Dialog {
- my ($FilePointer) = @_;
- my $content = join('', cat_($FilePointer));
- # dump into a dialog
- my $AboutWindow = Gtk2::Dialog->new("Drakroam Info", $w->{window},
- 'destroy-with-parent',
- N("Ok") => 'none');
- $AboutWindow->vbox->add(create_scrolled_window(Gtk2::Label->new($content)));
- $AboutWindow->signal_connect(response => sub { $_[0]->destroy });
- $AboutWindow->show_all;
-}
-
-# start GUI
-print "Starting GUI\n";
-
-$w->main;
diff --git a/perl-install/standalone/draksec b/perl-install/standalone/draksec
deleted file mode 100755
index 4a40372d6..000000000
--- a/perl-install/standalone/draksec
+++ /dev/null
@@ -1,364 +0,0 @@
-#!/usr/bin/perl
-#*****************************************************************************
-#
-# Copyright (c) 2002-2004 Christian Belisle
-# Thierry Vignaud <tvignaud@mandrakesoft.com>
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License version 2, as
-# published by the Free Software Foundation.
-#
-# 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-#*****************************************************************************
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use common;
-use standalone;
-use vars qw($MODE %options);
-use ugtk2 qw(:helpers :wrappers :ask :create);
-use run_program;
-use security::level;
-use security::msec;
-use security::help;
-use security::l10n;
-
-#$MODE = 'basic';
-#$0 =~ /draksec-firewall$/ and $MODE = 'firewall';
-#$0 =~ /draksec-perms$/ and $MODE = 'perms';
-
-#/^-?-(\S+)$/ and $options{$1} = 1 foreach @ARGV;
-
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/draksec-mdk.png";
-my ($w, %fields);
-
-############################ I18N ###################################
-
-my @help;
-
-my %translations = (
- 'ALL' => N("ALL"),
- 'LOCAL' => N("LOCAL"),
- 'NONE' => N("NONE"),
- 'default' => N("Default"),
- 'ignore' => N("Ignore"),
- 'no' => N("No"),
- 'yes' => N("Yes"),
-);
-my %inv_translations = reverse %translations;
-
-sub to_i18n { map { $translations{$_} || $_ } @_ }
-sub from_i18n { $inv_translations{$_[0]} || $_[0] }
-sub resize { gtkset_size_request($_[0], 50, -1) }
-
-%fields = security::l10n::fields();
-my %inv_fields = reverse %fields;
-
-# factorize this with rpmdrake and harddrake2
-sub wait_msg {
- my $mainw = ugtk2->new(N("Please wait"), (modal => 1, if_(!$::isEmbedded, transient => $w->{rwindow})));
- $mainw->{window}->add(Gtk2::WrappedLabel->new($_[0]));
- $mainw->{rwindow}->show_all;
- gtkset_mousecursor_wait($mainw->{rwindow}->window);
- gtkflush();
- $mainw;
-}
-
-sub remove_wait_msg { $_[0]->destroy }
-
-sub basic_seclevel_explanations() {
- my $text = Gtk2::TextView->new;
- use Gtk2::Pango;
- my %common_opts = ('left-margin' => '10', 'right-margin' => '10');
- # this is a small parser for a Pango Text Attribute Markup Language-like for TextViews widget
- gtktext_insert($text, [ map {
- if (s!^/span>!!) {
- [ $_, \%common_opts ];
- } elsif (s!span !!) {
- my %tags = %common_opts;
- while (s!(\w+?)="(\w+?)"!!) {
- $tags{weight} ||= Gtk2::Pango->PANGO_WEIGHT_BOLD if $1 eq 'foreground';
- $tags{$1} = $2 eq "bold" ? Gtk2::Pango->PANGO_WEIGHT_BOLD : $2;
- }
- s/^>//;
- [ $_, \%tags ];
- } else {
- [ $_, \%common_opts ];
- }
- } split("<", formatAlaTeX(
-#-PO: Do not alter the <span ..> and </span> tags.
-#-PO: Translate the security levels (Poor, Standard, High, Higher and Paranoid) in the same way, you translated these individuals words.
-#-PO: keep the double empty lines between sections, this is formatted a la LaTeX.
- N("Here, you can setup the security level and administrator of your machine.
-
-
-The '<span weight=\"bold\">Security Administrator</span>' is the one who will receive security alerts if the
-'<span weight=\"bold\">Security Alerts</span>' option is set. It can be a username or an email.
-
-
-The '<span weight=\"bold\">Security Level</span>' menu allows you to select one of the six preconfigured security levels
-provided with msec. These levels range from '<span weight=\"bold\">poor</span>' security and ease of use, to
-'<span weight=\"bold\">paranoid</span>' config, suitable for very sensitive server applications:
-
-
-<span foreground=\"royalblue3\">Poor</span>: This is a totally unsafe but very
-easy to use security level. It should only be used for machines not connected to
-any network and that are not accessible to everybody.
-
-
-<span foreground=\"royalblue3\">Standard</span>: This is the standard security
-recommended for a computer that will be used to connect to the Internet as a
-client.
-
-
-<span foreground=\"royalblue3\">High</span>: There are already some
-restrictions, and more automatic checks are run every night.
-
-
-<span foreground=\"royalblue3\">Higher</span>: The security is now high enough
-to use the system as a server which can accept connections from many clients. If
-your machine is only a client on the Internet, you should choose a lower level.
-
-
-<span foreground=\"royalblue3\">Paranoid</span>: This is similar to the previous
-level, but the system is entirely closed and security features are at their
-maximum"))) ]);
- create_scrolled_window($text, [ 'never', 'automatic' ]);
-}
-
-sub new_nonedit_combo {
- my ($string_list, $o_default_value) = @_;
- Gtk2::ComboBox->new_with_strings([ to_i18n(@$string_list) ], to_i18n($o_default_value));
-}
-
-sub register_help_page {
- my ($domain) = @_;
- push @help,
- ([
- [ $domain . "\n\n",
- {
- justification => 'center',
- scale => Gtk2::Pango->PANGO_SCALE_LARGE,
- weight => Gtk2::Pango->PANGO_WEIGHT_BOLD,
- },
- ],
- [ N("Description of the fields:\n\n"), ],
- ],
- );
-}
-
-
-sub register_help_entry {
- my ($label, $default, $opt) = @_;
- my $help = $security::help::help{$opt};
- push @{$help[-1]},
- ([
- formatAlaTeX($label) . ":\n",
- { foreground => "royalblue3" },
- ],
- [ join("\n", formatAlaTeX($help), N("(default value: %s)", to_i18n($default)), "\n") ]
- );
-}
-
-my $msec = new security::msec;
-$w = ugtk2->new('draksec');
-my $window = $w->{window};
-
-
-############################ MAIN WINDOW ###################################
-# Set different options to Gtk2::Window
-unless ($::isEmbedded) {
- $w->{rwindow}->set_position('center');
- $w->{rwindow}->set_title("DrakSec");
- $window->set_size_request(598, 520);
-}
-
-# Connect the signals
-$window->signal_connect('delete_event', sub { $window->destroy });
-$window->signal_connect('destroy', sub { ugtk2->exit });
-
-$window->add(my $vbox = gtkshow(Gtk2::VBox->new(0, 0)));
-
-# Create the notebook (for bookmarks at the top)
-my $notebook = create_notebook();
-
-my $common_opts = { col_spacings => 10, row_spacings => 5, mcc => 1 };
-
-######################## BASIC OPTIONS PAGE ################################
-my ($seclevel_entry, $secadmin_entry);
-
-$notebook->append_page(gtkshow(gtkpack_(Gtk2::VBox->new(0, 0),
- 1, basic_seclevel_explanations(),
- 0, create_packtable($common_opts,
- [
- do {
- my @sec_levels = security::level::get_common_list();
- my $current_level = security::level::get_string();
-
- push(@sec_levels, $current_level) unless member($current_level, @sec_levels);
- $seclevel_entry = new_nonedit_combo(\@sec_levels, $current_level);
-
- Gtk2::WrappedLabel->new(N("Security Level:")), $seclevel_entry;
- }
- ],
- [ Gtk2::WrappedLabel->new(N("Security Alerts:")),
- my $secadmin_check = gtksignal_connect(Gtk2::CheckButton->new, toggled => sub {
- $secadmin_entry->set_sensitive($_[0]->get_active);
- }) ],
- [ Gtk2::WrappedLabel->new(N("Security Administrator:")),
- $secadmin_entry = Gtk2::Entry->new_with_text($msec->get_check_value("MAIL_USER")) ]))),
- Gtk2::Label->new(N("Basic options")));
-
-if ($msec->get_check_value("MAIL_WARN") eq "yes") {
- $secadmin_check->set_active(1);
-} else {
- $secadmin_entry->set_sensitive(0);
- }
-
-######################### NETWORK & SYSTEM OPTIONS #########################
-my @yesno_choices = qw(yes no default ignore);
-my @alllocal_choices = qw(ALL LOCAL NONE default);
-my @all_choices = (@yesno_choices, @alllocal_choices);
-my %options_values;
-
-foreach ([ 'network', N("Network Options") ], [ 'system', N("System Options") ]) {
- my ($domain, $label) = @$_;
- register_help_page($label);
- my %values;
- gtkappend_page($notebook, gtkshow(gtkpack_(Gtk2::VBox->new,
- 1, create_scrolled_window(create_packtable($common_opts,
- map {
- my $i = $_;
-
- my $entry;
- my $opt = $inv_fields{$i} || $i;
- my $default = $msec->get_function_default($opt);
- if (member($default, @all_choices)) {
- $values{$i} = new_nonedit_combo(member($default, @yesno_choices) ? \@yesno_choices : if_(member($default, @alllocal_choices), \@alllocal_choices));
- $entry = $values{$i}->entry;
- } else {
- $values{$i} = Gtk2::Entry->new;
- $entry = $values{$i};
- }
- $entry->set_text(to_i18n($msec->get_function_value($opt)));
- register_help_entry($i, $default, $opt);
- [ Gtk2::WrappedLabel->new($i), resize($values{$i}) ];
- } sort map { $fields{$_} || $_ } $msec->list_functions($domain),
- ),
- [ 'never', 'automatic' ],
- ),
- )
- ),
- Gtk2::WrappedLabel->new($label));
- $options_values{$domain} = \%values;
-}
-
-######################## PERIODIC CHECKS ###################################
-my %security_checks_value;
-
-my $check_string = N("Periodic Checks");
-
-register_help_page($check_string);
-gtkappend_page($notebook, gtkshow(gtkpack_(Gtk2::VBox->new,
- 1, create_scrolled_window(create_packtable($common_opts,
- map {
- my $i = $_;
- my $opt = $inv_fields{$i} || $i;
- $security_checks_value{$i} = new_nonedit_combo([ 'yes', 'no', 'default' ], $msec->get_check_value($opt));
- my $entry = $security_checks_value{$i}->entry;
- register_help_entry($i, $msec->get_check_default($opt), $opt);
- [ gtkshow(Gtk2::WrappedLabel->new($i)), resize($security_checks_value{$i}) ];
- } sort map { $fields{$_} || $_ } $msec->list_checks)))),
- Gtk2::Label->new($check_string));
-
-
-####################### OK CANCEL BUTTONS ##################################
-gtkpack_($vbox,
- 1, gtkshow($notebook),
- 0, create_okcancel(my $oc =
- {
- cancel_clicked => sub { ugtk2->exit(0) },
- ok_clicked => sub {
- my $seclevel_value = $seclevel_entry->entry->get_text;
- my $secadmin_check_value = $secadmin_check->get_active;
- my $secadmin_value = $secadmin_entry->get_text;
- my $w;
-
- log::explanations("Configuring msec");
-
- if ($seclevel_value ne security::level::get_string()) {
- $w = wait_msg(N("Please wait, setting security level..."));
- log::explanations(qq(Setting security level to "$seclevel_value"));
- security::level::set(security::level::from_string($seclevel_value));
- remove_wait_msg($w);
- }
-
- $w = wait_msg(N("Please wait, setting security options..."));
- log::explanations(qq(Setting security administrator option to ") . bool2yesno($secadmin_check_value) . '"');
- $msec->set_check('MAIL_WARN', bool2yesno($secadmin_check_value));
-
- if ($secadmin_value ne $msec->get_check_value('MAIL_USER') && $secadmin_check_value) {
- log::explanations(qq(Setting security administrator contact to "$secadmin_value"));
- $msec->set_check('MAIL_USER', $secadmin_value);
- }
-
- log::explanations("Setting security periodic checks");
- foreach my $key (keys %security_checks_value) {
- $msec->set_check($inv_fields{$key} || $key, from_i18n($security_checks_value{$key}->entry->get_text));
- }
- $msec->apply_checks;
-
- foreach my $domain (keys %options_values) {
- log::explanations("Setting msec functions related to $domain");
- foreach my $key (keys %{$options_values{$domain}}) {
- my $opt = $options_values{$domain}{$key};
- $msec->set_function($inv_fields{$key} || $key, from_i18n($opt->get_text));
- }
- }
- $msec->apply_functions;
- log::explanations("Applying msec changes");
- run_program::run("/usr/sbin/msec");
-
- remove_wait_msg($w);
-
- ugtk2->exit(0);
- }
- },
- undef, undef, '',
- [ N("Help"), sub {
- my $text = Gtk2::TextView->new;
- create_dialog(N("Help"),
- gtktext_insert($text,
- [
- # -1 b/c of main page:
- @{$help[$notebook->get_current_page-1]}
- ]
- ),
- { use_markup => 1,
- if_(!$::isEmbedded, transient => $w->{window}),
- height => 400,
- width => 600,
- scroll => 1,
- },
- );
- } ],
- ),
- );
-
-$notebook->signal_connect("switch-page" => sub { $oc->{buttons}{N("Help")}->set_sensitive($_[2]) });
-
-$oc->{buttons}{N("Help")}->set_sensitive(0);
-$oc->{cancel}->can_default(1);
-$oc->{cancel}->grab_default;
-
-$w->main;
-ugtk2->exit(0);
diff --git a/perl-install/standalone/draksound b/perl-install/standalone/draksound
deleted file mode 100755
index da018d17a..000000000
--- a/perl-install/standalone/draksound
+++ /dev/null
@@ -1,61 +0,0 @@
-#!/usr/bin/perl
-# DrakxSound
-# Copyright (C) 2002-2004 Mandrakesoft (tvignaud@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use strict;
-use interactive;
-use common;
-use harddrake::sound;
-use modules;
-use detect_devices;
-
-my $in = 'interactive'->vnew('su');
-
-
-my $modules_conf = modules::any_conf->read;
-
-if (my @devices = modules::probe_category('multimedia/sound')) {
- # TODO: That need some work for multiples sound cards
- map_index {
- # allocate sound-slot in the same order as install2.pm
- # fill $device->{driver} with the right sound-slot-XX or default driver if missing sound-slot [real fix'll be in harddrake service]
- my $driver = $modules_conf->get_alias("sound-slot-$::i");
- $driver = $modules_conf->get_alias($driver) if $driver =~ /sound-card/; # alsaconf ...
- $_->{current_driver} = $driver if $driver;
- $_->{sound_slot_index} = $::i;
- harddrake::sound::config($in, $modules_conf, $_, $::i);
- } @devices;
-} else {
- $in->ask_warn(N("No Sound Card detected!"),
- formatAlaTeX(
- #-PO: keep the double empty lines between sections, this is formatted a la LaTeX
- N("No Sound Card has been detected on your machine. Please verify that a Linux-supported Sound Card is correctly plugged in.
-
-
-You can visit our hardware database at:
-
-
-http://www.linux-mandrake.com/en/hardware.php3") .
-N("\n\n\nNote: if you've an ISA PnP sound card, you'll have to use the alsaconf or the sndconfig program. Just type \"alsaconf\" or \"sndconfig\" in a console.")));
-}
-
-$modules_conf->write;
-$in->exit(0);
diff --git a/perl-install/standalone/draksplash b/perl-install/standalone/draksplash
deleted file mode 100755
index 4a59407bd..000000000
--- a/perl-install/standalone/draksplash
+++ /dev/null
@@ -1,558 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-use common;
-use ugtk2 qw(:create :dialogs :helpers :wrappers);
-use interactive;
-
-#- convenience variables for true and false
-my $true = 1;
-
-
-my $in = 'interactive'->vnew('su');
-
-my $window = ugtk2->new('DrakSplash');
-$window->{rwindow}->signal_connect(delete_event => \&CloseAppWindow);
-
-#- verification of package image magik
-unless ($in->do_pkgs->is_installed('ImageMagick')) {
- $in->ask_okcancel(N("Error"), N("package 'ImageMagick' is required to be able to complete configuration.\nClick \"Ok\" to install 'ImageMagick' or \"Cancel\" to quit"))
- && $in->do_pkgs->install('ImageMagick')
- or CloseAppWindow();
-}
-
-#- application vars
-my $tmp_path = '/tmp/draksplash/';
-mkdir($tmp_path) if !-d $tmp_path;
-my $thm_path = '/usr/share/bootsplash/themes/';
-my $boot_conf_path = '/etc/bootsplash/themes/';
-my $cfg_path = "/cfg/";
-
-my $img_file;
-
-my $prev_window;
-
-my %font_size = ('h' =>16, 'w' =>8);
-my %theme = ('name' => 'new_theme',
- 'res' => {
- 'res' => '800x600',
- 'h' => '600',
- 'w' => '800',
- },
- 'boot_conf' => {
- 'tx' => 0,
- 'ty' => 0,
- 'tw' => 0,
- 'th' => 0,
- 'px' => 0,
- 'py' => 0,
- 'pw' => 0,
- 'ph' => 0,
- 'pc' => '0x21459d',
- },
- 'boot_img' => ''
- );
-
-my %scale_size = ('tx' => ($theme{res}{w} / $font_size{w}),
- 'ty' => ($theme{res}{h} / $font_size{h}),
- 'tw' => ($theme{res}{w} / $font_size{w}),
- 'th' => ($theme{res}{h} / $font_size{h}),
- 'px' => $theme{res}{w},
- 'py' => $theme{res}{h},
- 'pw' => $theme{res}{w},
- 'ph' => $theme{res}{h},
- );
-
-my %first = ('frame' => Gtk2::Frame->new(N("first step creation")),
- 'widget' => {
- 'label' => {
- 'res' => N("final resolution"),
- 'file' => N("choose image file"),
- 'name' => N("Theme name")
- },
- 'button' => {
- #'boot_conf' => N("Make bootsplash step 2"),
- #'lilo_conf' => N("Go to lilosplash configuration"),
- 'file' => N("Browse"),
- },
- 'combo' => {
- 'res' => ['800x600', '1024x768', '1280x1024'],
- 'name' => [ $theme{name}, giv_exist_thm() ]
- },
- extras => {
- res => {
- noneditable => 1,
- },
- },
- },
- 'pos' => [ 'name', 'res', 'file', 'boot_conf', #'save', #'kill'
- ],
- );
-my %boot_conf_frame = ('frame' => Gtk2::Frame->new(N("Configure bootsplash picture")),
- 'widget' => {
- 'label' => {
- 'tx' => N("x coordinate of text box\nin number of characters"),
- 'ty' => N("y coordinate of text box\nin number of characters"),
- 'tw' => N("text width"),
- 'th' => N("text box height"),
- 'px' => N("the progress bar x coordinate\nof its upper left corner"),
- 'py' => N("the progress bar y coordinate\nof its upper left corner"),
- 'pw' => N("the width of the progress bar"),
- 'ph' => N("the height of the progress bar"),
- 'pc' => N("the color of the progress bar")
- },
- #- must set scale values to true to get them created by mk_frame
- 'scale' => {
- 'tx' => 1,
- 'ty' => 1,
- 'tw' => 1,
- 'th' => 1,
- 'px' => 1,
- 'py' => 1,
- 'pw' => 1,
- 'ph' => 1,
- },
- 'button' => {
- #'annul' => N("Go back"),
- 'prev' => N("Preview"),
- 'kill' => N("Quit"),
- 'save' => N("Save theme"),
- 'pc' => N("Choose color"),
- },
- 'check' => {
- 'logo' => N("Display logo on Console"),
- 'quiet' => N("Make kernel message quiet by default"),
- },
- },
- 'pos' => [ 'tx',
- 'ty',
- 'tw',
- 'th',
- 'px',
- 'py',
- 'pw',
- 'ph',
- 'pc',
- 'logo',
- 'quiet',
- # 'annul',
- 'prev',
- 'save',
- 'kill',
- ],
- );
-#- var action is used to hide/show the correct frame
-$first{frame}->add(mk_frame(\%first));
-my $first_vbox = Gtk2::VBox->new(0, 5);
-
-
-#****************************- Signal event actions
-#- change resolution
-$first{widgets}{combo}{res}->entry->signal_connect(changed => sub {
- $theme{res}{res} = $first{widgets}{combo}{res}->entry->get_text;
- ($theme{res}{w}, $theme{res}{h}) = $theme{res}{res} =~ /([^x]+)x([^x]+)/;
- &set_scale_size;
- $boot_conf_frame{frame}->destroy;
- $boot_conf_frame{frame} = Gtk2::Frame->new(N("Configure bootsplash picture"));
- &make_boot_frame;
- $first_vbox->add($boot_conf_frame{frame});
- member($theme{name}, giv_exist_thm()) && thm_in_this_res() && get_this_thm_res_conf() || $in->ask_warn(N("Notice"), N("This theme does not yet have a bootsplash in %s!", $theme{res}{res}));
- });
-#- go to bootsplash configuration step 2
-#$first{widgets}{button}{boot_conf}->signal_connect(clicked => sub{show_act(\%boot_conf_frame) } );
-#- image file selection for new theme
-$first{widgets}{button}{file}->signal_connect(clicked => sub {
- my $file_dialog = gtkset_modal(Gtk2::FileSelection->new(N("choose image")), 1);
- $file_dialog->set_transient_for($window->{rwindow});
-
- $file_dialog->set_filename($img_file || '~/');
- $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy });
- $file_dialog->ok_button->signal_connect(clicked => sub { $img_file = $file_dialog->get_filename; $file_dialog->destroy });
- $file_dialog->show;
-});
-#- changing theme name
-$first{widgets}{combo}{name}->entry->signal_connect(changed => sub { get_this_thm_res_conf(); $theme{name} = $first{widgets}{combo}{name}->entry->get_text });
-#**************************************************
-
-
-$first_vbox->add($first{frame});
-$first_vbox->add($boot_conf_frame{frame});
-&make_boot_frame;
-
-# set window attributes and show it
-
-unless ($::isEmbedded) {
- $window->{rwindow}->set_border_width(5);
- $window->{window}->add($first_vbox);
- $window->{rwindow}->set_position('center');
- $window->{rwindow}->show_all;
-#&show_act(\%first);
-}
-
-# Gtk event loop
-$window->main;
-
-# Should never get here
-ugtk2->exit(0);
-
-### Callback function to close the window
-sub CloseAppWindow() {
- ugtk2->exit(0);
-}
-
-#- ====## used funtions ##=====
-
-#- Desc => write config file for boot theme and copy image in the right location
-sub write_boot_thm {
- my $_w = $in->wait_message('', N("saving Bootsplash theme..."));
- &set_thm_values;
- my $logo = $boot_conf_frame{widgets}{check}{logo}->get_active ? 'yes' : 'no';
- my $quiet = $boot_conf_frame{widgets}{check}{quiet}->get_active ? 'yes' : 'no';
- my $globalconf_file = $boot_conf_path.$theme{name}.'/global.config';
- my $cfg_file = $boot_conf_path . $theme{name} . "$cfg_path/bootsplash-" . $theme{res}{res} . '.cfg';
- #- verify all dir exists or create them
- foreach my $dir ($boot_conf_path . $theme{name} . $cfg_path, $thm_path.$theme{name} . '/images/') {
- mkdir_p($dir) if !-d $dir;
- }
- #- copy image to dest by convert
- system('convert -scale '.$theme{res}{res} . ' ' . $img_file . ' ' . $thm_path.$theme{name} . '/images/bootsplash-' . $theme{res}{res} . '.jpg');
- system('/usr/share/bootsplash/scripts/rewritejpeg '.$thm_path.$theme{name}.'/images/bootsplash-'.$theme{res}{res}.'.jpg');
- #- write conf files
- output($cfg_file, qq(# This is the configuration file for the $theme{res}{res} bootsplash picture
-# this file is necessary to specify the coordinates of the text box on the
-# splash screen.
-
-# tx is the x coordinate of the text window in characters. default is 24
-# multiply width font width for coordinate in pixels.
-tx=$theme{boot_conf}{tx}
-
-# ty is the y coordinate of the text window in characters. default is 14
-ty=$theme{boot_conf}{ty}
-
-# tw is the width of the text window in characters. default is 130
-# note: this should at least be 80 as on the standard linux text console
-tw=$theme{boot_conf}{tw}
-
-# th is the height of the text window in characters. default is 44
-# NOTE: this should at least be 25 as on the standard linux text console
-th=$theme{boot_conf}{th}
-
-# px is the progress bar x coordinate of its upper left corner
-px=$theme{boot_conf}{px}
-
-# py is the progress bar y coordinate of its upper left corner
-py=$theme{boot_conf}{py}
-
-# pw is the with of the progress bar
-pw=$theme{boot_conf}{pw}
-
-# ph is the height of the progress bar
-ph=$theme{boot_conf}{ph}
-
-# pc is the color of the progress bar
-pc=$theme{boot_conf}{pc}));
- output($globalconf_file, qq(# Display logo on console.
-LOGO_CONSOLE=$logo
-
-# Make kernel message quiet by default.
-QUIET=$quiet));
-}
-
-
-#- Desc => read the current bootsplash theme configuration if exist
-sub get_this_thm_res_conf() {
- member($first{widgets}{combo}{name}->entry->get_text, giv_exist_thm())
- and $theme{name} = $first{widgets}{combo}{name}->entry->get_text
- and thm_in_this_res(1)
- and read_boot_conf();
- my $file = $thm_path.$theme{name}."/images/bootsplash-".$theme{res}{res}.".jpg";
- $img_file = $file if -f $file;
- return 1;
-}
-
-sub read_boot_conf {
- chdir($boot_conf_path);
- my $file = $theme{name} . "/$cfg_path/bootsplash-" . $theme{res}{res} . '.cfg';
- if (-f $file) {
- $theme{boot_conf} = { getVarsFromSh($file) };
- &set_scale_values;
- }
-}
-
-my %adj;
-sub set_scale_values() {
- foreach (keys %{$theme{boot_conf}}) {
- $adj{$_} and $adj{$_}->set_value($theme{boot_conf}{$_});
- }
-}
-
-#- Desc => check if this theme is available in the current resolution else
-#- change the current resolution or display a ask_warn box
-#- Args => ø
-#- return=> (bool)
-sub thm_in_this_res {
- my ($check_res) = @_;
- (-f $thm_path.$theme{name}."/images/bootsplash-".$theme{res}{res}.".jpg") ? return 1 : $check_res == 1 ? return which_res_exist() : return 0;
-}
-
-sub which_res_exist() {
- chdir($thm_path.$theme{name}."/images/");
- my $is_ok = 0;
- foreach (@{$first{widget}{combo}{res}}) {
- next if !-f "bootsplash-$_.jpg";
- $is_ok = 1;
- $first{widgets}{combo}{res}->entry->set_text($_);
- last;
- }
- $is_ok == 1 or $in->ask_warn(N("Notice"), N("This theme does not yet have a bootsplash in %s!", $theme{res}{res})) and return 0;
- return 1;
-}
-
-#- Desc => retrieve all installed theme
-#- Args => ø
-#- Return=> @arr of available theme
-sub giv_exist_thm() {
- chdir($thm_path);
- my @thms_dirs;
- foreach (glob("*")) {
- -d $_ && m/^[^.]/
- and push @thms_dirs, $_;
- }
- return @thms_dirs;
-}
-
-#- Desc => show only the right frame
-#- Args => action(str)
-#- Return=> (bool)
-sub show_act {
-# my ($action) = @_;
-# foreach (@action_frame){
-# if($_ == $action){
-# $_->{frame}->show_all ;
-# }else{
-# $_->{frame}->hide;
-# }
-# }
-}
-
-#- Desc => just add tooltips
-#- Args => name of widget(str) and frame to work on it (\%hash)
-sub tool_tip {
- my ($name, $ref) = @_;
- foreach (keys %{$ref->{widget}}) {
- $_ eq 'tooltip' and next;
- if ($ref->{widget}{$_}{$name}) {
- ! $adj{$name.'_tip'} and $adj{$name.'_tip'} = Gtk2::Tooltips->new;
- $adj{$name.'_tip'}->set_tip($ref->{widgets}{$_}{$name}, $ref->{widget}{tooltip}{$name}, '');
- }
- }
-}
-
-
-#- Desc => just prepare widgets for a fram hash
-#- Args => $box(a Vbox widget to contain all widgets), \%frame (hash with complete definition of the frame)
-#- Return=> all hash{widgets} are created and packed in $box
-sub mk_frame {
- my ($ref) = @_;
- my @buttons;
- my $u = create_packtable({ col_spacings => 10, row_spacings => 5 },
- map {
- my @widgets;
- my $pos = $_;
-
- #- look for label
- if ($ref->{widget}{label}{$pos}) {
- my $w = $ref->{widgets}{label}{$pos} = Gtk2::Label->new($ref->{widget}{label}{$pos});
- push @widgets, $w;
- }
-
- #- look for scale
- if ($ref->{widget}{scale}{$pos}) {
- my $w = $ref->{widgets}{scale}{$pos} = Gtk2::HScale->new($adj{$pos} = Gtk2::Adjustment->new(0, 0, $scale_size{$pos}, 1, 10, 0));
- $ref->{widgets}{scale}{$pos}->set_digits(0);
- push @widgets, $w;
- }
- $adj{$pos} and $adj{$pos}->set_value($theme{boot_conf}{$pos});
-
- #- look for combo
- my @popdown;
- if ($ref->{widget}{combo}{$pos}) {
- @popdown = @{$ref->{widget}{combo}{$pos}};
- my $w = $ref->{widgets}{combo}{$pos} = $ref->{widget}{extras}{$pos}{noneditable} ? Gtk2::ComboBox->new_text : Gtk2::Combo->new;
- $w->set_popdown_strings(@popdown);
- $w->set_active(0) if $w->isa('Gtk2::ComboBox');
- push @widgets, $w;
- }
-
- #- look for checkbox
- if ($ref->{widget}{check}{$pos}) {
- my $w = $ref->{widgets}{check}{$pos} = Gtk2::CheckButton->new($ref->{widget}{check}{$pos});
- $ref->{widgets}{check}{$pos}->set_active(1);
- push @widgets, $w;
- }
-
- #- look for button
- if ($ref->{widget}{button}{$pos}) {
- my $w = $ref->{widgets}{button}{$pos} = Gtk2::Button->new($ref->{widget}{button}{$pos});
- @widgets ?
- push @widgets, $w
- : push @buttons, $w;
- }
-
- #- look for tooltips
- $ref->{widget}{tooltip}{$pos} and tool_tip($pos, \%$ref);
- if_(@widgets, \@widgets);
- } @{$ref->{pos}}
- );
-
- gtkpack__(Gtk2::VBox->new,
- gtkset_border_width($u, 3),
- @buttons);
-}
-
-#- Desc => take a decimal value between 0 to 255 and return the corresponding hexadecimal value
-sub dec2hex {
- my ($dec) = @_;
- my @dec_hex = (0..9, 'A', 'B', 'C', 'D', 'E', 'F');
- my $int;
- my $float;
- $dec = $dec/16;
- $int = int($dec);
- $float = $dec_hex[int(($dec-$int)*16)];
- $int = $dec_hex[$int];
-
- return "$int$float";
-}
-
-#- Desc => prepare and set all signal_connect for boot_frame widget
-sub make_boot_frame() {
- $boot_conf_frame{frame}->add(mk_frame(\%boot_conf_frame));
-
- #- open a color choose box
- $boot_conf_frame{widgets}{button}{pc}->signal_connect(clicked => sub {
- my $color = gtkshow(Gtk2::ColorSelectionDialog->new(N("ProgressBar color selection")));
- my @rgb = map { hex($_)/255 } ($1, $2, $3) if $theme{boot_conf}{pc} =~ m/0x(.{2})(.{2})(.{2})/;
- $color->colorsel->set_current_color(gtkcolor(@rgb));
- $color->cancel_button->signal_connect(clicked => sub { $color->destroy });
- $color->ok_button->signal_connect(clicked => sub {
- my $colour = $color->colorsel->get_current_color;
- @rgb = map { dec2hex($_*255) } ($colour->red, $colour->green, $colour->blue);
- $theme{boot_conf}{pc} = "0x$rgb[0]$rgb[1]$rgb[2]";
- $color->destroy;
- });
- });
- #- quit button
- $boot_conf_frame{widgets}{button}{kill}->signal_connect(clicked => \&CloseAppWindow);
- $boot_conf_frame{widgets}{button}{save}->signal_connect(clicked => \&write_boot_thm);
- #- return to first screen
- #$boot_conf_frame{widgets}{button}{annul}->signal_connect(clicked => sub { show_act( \%first ) } );
- #- made a preview
- $boot_conf_frame{widgets}{button}{prev}->signal_connect(clicked => sub {
- unless (-f $img_file) {
- $in->ask_warn(N("Notice"), N("You must choose an image file first!"));
- return 0;
- }
- #- calculation of the 2 angle of text box and progress bar
- set_thm_values();
- my $_w = $in->wait_message('', N("Generating preview..."));
- my $txt_tl_xx = $theme{boot_conf}{tx}*$font_size{w};
- my $txt_tl_yy = $theme{boot_conf}{ty}*$font_size{h};
- my $txt_width = $theme{boot_conf}{tw}*$font_size{w};
- my $txt_height = $theme{boot_conf}{th}*$font_size{h};
- my $prog_tl_xx = $theme{boot_conf}{px};
- my $prog_tl_yy = $theme{boot_conf}{py};
- my $prog_width = $theme{boot_conf}{pw};
- my $prog_height = $theme{boot_conf}{ph};
- show_prev($txt_tl_xx, $txt_tl_yy, $txt_width, $txt_height, $prog_tl_xx, $prog_tl_yy, $prog_width, $prog_height);
- });
- $boot_conf_frame{frame}->show_all;
-# - check scales values are possibly correct
- #&set_scale_values;
-
- foreach my $k (keys %{$theme{boot_conf}}) {
- $k =~ m/[tp][hwyx]/
- and $adj{$k}->signal_connect(value_changed => \&check_boot_scales);
- }
-}
-
-#- Desc => set theme values from user entry (scales widgets)
-sub set_thm_values() {
- foreach (keys %{$theme{boot_conf}}) {
- m/[tp][hwyx]/
- and $theme{boot_conf}{$_} = int($adj{$_}->get_value);
- }
-}
-
-
-#- Desc => destroy properly all widget of preview window
-#- Desc => create a new window with a preview of splash screen
-#- Args => $img_file (str) full path to preview file
-sub show_prev {
- my ($txt_tl_xx, $txt_tl_yy, $txt_width, $txt_height, $prog_tl_xx, $prog_tl_yy, $prog_width, $prog_height) = @_;
- $prev_window ||= Gtk2::Window->new('toplevel');
- $prev_window->set_title(
- #-PO: First %s is theme name, second %s (in parenthesis) is resolution
- N("%s BootSplash (%s) preview", $theme{name}, $theme{res}{res}));
- my $prev_pic;
- eval { $prev_pic = gtkcreate_pixbuf($img_file) };
- if (my $err = $@) {
- err_dialog(N("Error"),
- #-PO: Do not alter the <span ..> and </span> tags
- N("The image \"%s\" cannot be load due to the following issue:\n\n<span foreground=\"Red\">%s</span>", $img_file, $err),
- { use_markup => 1 }
- );
- return;
- }
-
- $prev_pic->scale_simple($theme{res}{w}, $theme{res}{h}, 'hyper');
- $prev_window->add(Gtk2::Image->new_from_pixbuf($prev_pic));
- $prev_window->signal_connect(delete_event => sub {
- $prev_window->destroy; undef($prev_window);
- undef($prev_pic);
- });
- $prev_window->show_all;
-}
-
-#- Desc => define the max size of boot's scales
-sub set_scale_size() {
- %scale_size = ('tx' => ($theme{res}{w} / $font_size{w}),
- 'ty' => ($theme{res}{h} / $font_size{h}),
- 'tw' => ($theme{res}{w} / $font_size{w}),
- 'th' => ($theme{res}{h} / $font_size{h}),
- 'px' => $theme{res}{w},
- 'py' => $theme{res}{h},
- 'pw' => $theme{res}{w},
- 'ph' => $theme{res}{h},
- );
-}
-
-#- Desc => verify that boot's scales widgets are correctly set
-#- Args => $obj (str) is the scale to check value
-
-sub check_boot_scales {
- my ($obj) = @_;
- my $tw = $adj{tw}->get_value;
- my $tx = $adj{tx}->get_value;
- my $th = $adj{th}->get_value;
- my $ty = $adj{ty}->get_value;
- my $pw = $adj{pw}->get_value;
- my $ph = $adj{ph}->get_value;
- my $px = $adj{px}->get_value;
- my $py = $adj{py}->get_value;
- my $max_xx = $scale_size{tw};
- my $max_yy = $scale_size{th};
- my $max_xres = $theme{res}{w};
- my $max_yres = $theme{res}{h};
-
- $obj eq 'tw' and $max_xx < $tw + $tx and $adj{tx}->set_value($max_xx - $tw);
- $obj eq 'tx' and $max_xx < $tw + $tx and $adj{tw}->set_value($max_xx - $tx);
- $obj eq 'th' and $max_yy < $th + $ty and $adj{ty}->set_value($max_yy - $th);
- $obj eq 'ty' and $max_yy < $th + $ty and $adj{th}->set_value($max_yy - $ty);
- $obj eq 'pw' and $max_xres < $pw + $px and $adj{px}->set_value($max_xres - $pw);
- $obj eq 'px' and $max_xres < $pw + $px and $adj{pw}->set_value($max_xres - $px);
- $obj eq 'ph' and $max_yres < $ph + $py and $adj{py}->set_value($max_yres - $ph);
- $obj eq 'py' and $max_yres < $ph + $py and $adj{ph}->set_value($max_yres - $py);
-
-}
diff --git a/perl-install/standalone/draksplash2 b/perl-install/standalone/draksplash2
deleted file mode 100644
index 38bb464d3..000000000
--- a/perl-install/standalone/draksplash2
+++ /dev/null
@@ -1,351 +0,0 @@
-#!/usr/bin/perl
-
-#- convert in.png -colors 128 -treedepth 6 -dither out.gif
-
-use strict;
-
-use lib '/usr/lib/libDrakX';
-use Getopt::Long;
-use ugtk2 qw(:all);
-use Gtk2::Gdk::Keysyms;
-use MDK::Common;
-use Image::Magick;
-
-
-my $kernel_size = 1500; #- in KiB
-my $initrd_size = 130; #- in KiB
-
-my $lilo_block_size = 50; #- in KiB
-my $isolinux_block_size = 64; #- in KiB
-
-my @modes = (
- { Vesa => 0x101, X => 640, Y => 480 },
- { Vesa => 0x103, X => 800, Y => 600 },
- { Vesa => 0x105, X => 1024, Y => 768 },
- { Vesa => 0x107, X => 1280, Y => 1024 },
-);
-
-my (%image_size, $kernel_and_initrd_size);
-my ($progress_rect, $progress_color) = ([], {});
-my ($timer_pos, $timer_bg, $timer_fg) = ({}, {}, {});
-my ($entry_rect, $entry_selected_color, $entry_color) = ([], {}, {});
-my $isolinux_mode;
-
-my $magick = Image::Magick->new;
-
-my ($current_rect, $current_point);
-my ($image_area, $image_pixbuf);
-
-sub move_point {
- my ($up_down, $direction) = @_;
- my $wanted = $current_point->{$direction} + $up_down;
- if (0 <= $wanted && $wanted < $image_size{$direction}) {
- $current_point->{$direction} += $up_down;
- }
- $image_area->queue_draw;
-}
-sub create_image_area() {
- $image_area = Gtk2::DrawingArea->new;
- $image_area->can_focus(1);
- $image_area->add_events('button-press-mask');
- $image_area->signal_connect(button_press_event => \&image_button_pressed);
- $image_area->signal_connect(expose_event => \&image_expose);
- gtkmodify_font($image_area, 'Monospace 12');
-
- my $keys = {
- $Gtk2::Gdk::Keysyms{Down} => sub { move_point( ($_[0] ? 5 : 1), 'Y') },
- $Gtk2::Gdk::Keysyms{Up} => sub { move_point(-($_[0] ? 5 : 1), 'Y') },
- $Gtk2::Gdk::Keysyms{Left} => sub { move_point(-($_[0] ? 5 : 1), 'X') },
- $Gtk2::Gdk::Keysyms{Right} => sub { move_point( ($_[0] ? 5 : 1), 'X') },
- $Gtk2::Gdk::Keysyms{q} => sub { Gtk2->main_quit },
- $Gtk2::Gdk::Keysyms{Escape} => sub { Gtk2->main_quit },
- };
-
- $image_area->signal_connect(key_press_event => sub {
- my (undef, $event) = @_;
-
- if (my $f = $keys->{$event->keyval}) {
- $f->(member('control-mask', @{$event->state}));
- }
- 1;
- });
-
- $image_area->grab_focus;
- $image_area->show;
- $image_area;
-}
-sub image_expose {
- my ($widget) = @_;
- my $window = $widget->window;
- $window->draw_pixbuf($widget->style->white_gc, $image_pixbuf, 0, 0, 0, 0, -1, -1, 'none', 0, 0);
-
- if (!$isolinux_mode) {
- {
- my $layout = $widget->create_pango_layout('--:--');
- my ($width, $height) = $layout->get_pixel_size;
- $window->draw_rectangle(color_index2gc($window, $timer_bg), 1, $timer_pos->{X}, $timer_pos->{Y}, $width, $height);
- $window->draw_layout(color_index2gc($window, $timer_fg), $timer_pos->{X}, $timer_pos->{Y}, $layout);
- }
- my ($x, $y, $w, $h) = rectangle2xywh($entry_rect);
- my @std_labels = ('linux', 'failsafe', '2.6.3-7mdk', 'X' x ($w / 8));
- for (my $nb = 0; $nb < int($h / 16); $y += 16, $nb++) {
- my $label = shift(@std_labels) || 'label_' . ($nb+1);
- my $gc = color_index2gc($window, !$nb ? $entry_selected_color : $entry_color);
- my $layout = $widget->create_pango_layout($label);
- $window->draw_layout($gc, $x, $y, $layout);
- }
- }
- {
- my ($x, $y, $w, $h) = rectangle2xywh($progress_rect);
- my $w2 = $w - $w % nb_steps();
- if ($current_rect) {
- $window->draw_rectangle(color_index2gc($window, $progress_color), 1, $x, $y, $w2, $h);
- $window->draw_rectangle($widget->style->black_gc, 0, $x, $y, $w, $h);
- } else {
- $window->draw_rectangle(color_index2gc($window, $progress_color), 1, $x, $y, $w, $h);
- }
- }
- 0;
-}
-sub image_button_pressed {
- my (undef, $event) = @_;
-
- if ($event->button eq '3') {
- create_popup()->popup(undef, undef, undef, undef, '3', $event->time);
- return 1;
- }
-
- my $point = { X => $event->x, Y => $event->y };
- my $chosen_point;
-
- if ($current_rect) {
- if (!@$current_rect) {
- my @corners = ({ X => 0, Y => 0 },
- { X => 0, Y => $image_size{Y} - 1 },
- { X => $image_size{X} - 1, Y => 0 },
- { X => $image_size{X} - 1, Y => $image_size{Y} - 1 });
- @$current_rect = ($corners[farthest($point, @corners)], nearest($point, @corners));
- }
- $current_point = nearest($point, @$current_rect);
- } elsif ($current_point) {
- %$current_point or %$current_point = %$point;
- } else {
- return;
- }
-
- %$current_point = %$point;
- $current_point->{Color} = $magick->Get("index[$point->{X},$point->{Y}]");
-
- $image_area->queue_draw;
- 1;
-}
-
-sub image_set_file {
- my ($file) = @_;
-
- $image_pixbuf = Gtk2::Gdk::Pixbuf->new_from_file($file);
- %image_size = (X => $image_pixbuf->get_width, Y => $image_pixbuf->get_height);
- $image_area->set_size_request($image_size{X}, $image_size{Y});
- $image_area->queue_draw;
-}
-
-sub color_index2gc {
- my ($window, $color) = @_;
- my ($r, $g, $b) = split(',', $magick->Get("colormap[$color->{Color}]"));
- my $gc = Gtk2::Gdk::GC->new($window);
-
- my $gdk_color = Gtk2::Gdk::Color->new($r, $g, $b) or die "bad color for $r,$g,$b";
- $window->get_colormap->rgb_find_color($gdk_color);
- $gc->set_rgb_fg_color($gdk_color);
- $gc;
-}
-
-sub rectangle2xywh {
- my ($rect) = @_;
-
- my $x = min($rect->[0]{X} , $rect->[1]{X});
- my $y = min($rect->[0]{Y} , $rect->[1]{Y});
- my $w = abs($rect->[0]{X} - $rect->[1]{X});
- my $h = abs($rect->[0]{Y} - $rect->[1]{Y});
- ($x, $y, $w, $h);
-}
-
-sub distance {
- my ($p1, $p2) = @_;
- sqr($p1->{X} - $p2->{X}) + sqr($p1->{Y} - $p2->{Y});
-}
-
-sub farthest {
- my ($point, @others) = @_;
- my $i = 0;
- my $dist = 0;
- my $farthest;
- foreach (@others) {
- my $d = distance($point, $_);
- if ($d >= $dist) {
- $dist = $d;
- $farthest = $_;
- }
- }
- $farthest;
-}
-
-sub nearest {
- my ($point, @others) = @_;
- my $i = 0;
- my $dist;
- my $nearest;
- foreach (@others) {
- my $d = distance($point, $_);
- if (! defined $dist || $d < $dist) {
- $dist = $d;
- $nearest = $_;
- }
- }
- $nearest;
-}
-
-sub create_popup() {
- my %l = my @l = (
- 'Progress bar position' => sub { $current_rect = $progress_rect },
- 'Progress bar color' => sub { $current_point = $progress_color },
- '' => sub {},
- $isolinux_mode ? (
- 'switch to lilo mode' => sub { $isolinux_mode = 0 },
- ) : (
- 'Timer position' => sub { $current_point = $timer_pos },
- 'Timer text color' => sub { $current_point = $timer_fg },
- 'Timer background' => sub { $current_point = $timer_bg },
- '' => sub {},
- 'Entry position' => sub { $current_rect = $entry_rect },
- 'Entry text selected color' => sub { $current_point = $entry_selected_color },
- 'Entry text color' => sub { $current_point = $entry_color },
- '' => sub {},
- 'switch to isolinux mode' => sub { $isolinux_mode = 1 },
- ),
-
- );
-
- my $popup = Gtk2::Menu->new;
- foreach (group_by2(@l)) {
- my ($descr, $f) = @$_;
- gtkappend($popup,
- gtksignal_connect(Gtk2::MenuItem->new_with_label($descr),
- activate => sub {
- $current_rect = $current_point = undef;
- $f->();
- }));
- }
- $popup
-}
-sub nb_steps() {
- $kernel_and_initrd_size / ($isolinux_mode ? $isolinux_block_size : $lilo_block_size);
-}
-
-sub read_parameters {
- my ($file) = @_;
- my %h = getVarsFromSh($file);
-
- $entry_rect->[0]{X} = $h{'entry_x'};
- $entry_rect->[0]{Y} = $h{'entry_y'};
- $entry_rect->[1]{X} = $h{'entry_x'} + $h{'entry_w'};
- $entry_rect->[1]{Y} = $h{'entry_y'} + $h{'entry_h'};
- $entry_color->{Color} = $h{'entry_bg'} - 64;
- $entry_selected_color->{Color} = $h{'entry_fg'} - 64;
-
- $timer_pos->{X} = $h{'timer_x'};
- $timer_pos->{Y} = $h{'timer_y'};
- $timer_bg->{Color} = $h{'timer_bg'} - 64;
- $timer_fg->{Color} = $h{'timer_fg'} - 64;
-
- $progress_color->{Color} = $h{'progress_c'} - 64;
- $progress_rect->[0]{X} = $h{'progress_x'};
- $progress_rect->[0]{Y} = $h{'progress_y'};
- $progress_rect->[1]{X} = $h{'progress_x'} + $h{'progress_real_w'};
- $progress_rect->[1]{Y} = $h{'progress_y'} + $h{'progress_h'};
-
- $isolinux_mode = $h{'isolinux_mode'};
-}
-
-sub save_parameters {
- my ($file) = @_;
- my %h;
-
- $h{'mode'} = (find { $image_size{X} eq $_->{X} } @modes)->{Vesa};
- $h{'clear_h'} = $image_size{X};
- $h{'clear_w'} = $image_size{Y};
-
- if (!$isolinux_mode) {
- ($h{'entry_x'}, $h{'entry_y'}, $h{'entry_w'}, $h{'entry_h'}) = rectangle2xywh($entry_rect);
- $h{'entry_w_chr'} = int($h{'entry_w'} / 8);
- $h{'entry_h_chr'} = int($h{'entry_h'} / 16);
- $h{'entry_bg'} = $entry_color->{Color} + 64;
- $h{'entry_fg'} = $entry_selected_color->{Color} + 64;
-
- $h{'timer_x'} = $timer_pos->{X};
- $h{'timer_y'} = $timer_pos->{Y};
- $h{'timer_bg'} = $timer_bg->{Color} + 64;
- $h{'timer_fg'} = $timer_fg->{Color} + 64;
- }
-
- $h{'progress_c'} = $progress_color->{Color} + 64;
- ($h{'progress_x'}, $h{'progress_y'}, $h{'progress_real_w'}, $h{'progress_h'}) = rectangle2xywh($progress_rect);
- $h{'progress_w'} = int($h{'progress_real_w'} / nb_steps());
-
- $h{'isolinux_mode'} = $isolinux_mode;
-
- output($file, map { "$_=$h{$_}\n" } sort keys %h);
-}
-
-# MAIN #########################################################################
-my $usage = <<EOF;
-usage: $0 [--kernel <kernel> --initrd <initrd>] [--size <size in KiB>] <image>
-(kernel and initrd are used to compute the size of data to load)
-EOF
-
-GetOptions('kernel=s' => \ (my $kernel),
- 'initrd=s' => \ (my $initrd),
- 'size=s' => \$kernel_and_initrd_size,
- 'isolinux' => \ (my $force_isolinux_mode),
- ) or die $usage;
-
-my ($file) = @ARGV;
-@ARGV == 1 && -e $file or die $usage;
-
-if ($kernel_and_initrd_size) {
- $kernel and die "give kernel and initrd or size, not both\n";
-} else {
- if ($kernel) {
- $initrd or die "give both kernel and initrd\n";
- $kernel_size = (-s $kernel) / 1024 or die "bad file $kernel: $!\n";
- $initrd_size = (-s $initrd) / 1024 or die "bad file $initrd: $!\n";
- }
- $kernel_and_initrd_size = $kernel_size + $initrd_size;
-}
-
-my $err;
-$err = $magick->Read($file) and die $err;
-
-my $bmp_file_name = $file;
-$bmp_file_name =~ s/\.\w\w\w?$//;
-$bmp_file_name .= '.bmp';
-
-if ($file ne $bmp_file_name || $magick->Get('colors') > 128) {
- warn "writing $bmp_file_name\n";
- $err = $magick->Quantize(colors => 128, dither => 'True', treedepth => 6) and die $err;
- $err = $magick->Write(filename => "bmp3:$bmp_file_name", compression => 'None') and die $err;
-}
-read_parameters("$bmp_file_name.parameters");
-$isolinux_mode ||= $force_isolinux_mode;
-
-my $window_widget = Gtk2::Window->new('toplevel');
-$window_widget->signal_connect(destroy => sub { Gtk2->main_quit });
-gtkadd($window_widget,
- gtkpack(Gtk2::VBox->new(0,0), create_image_area()));
-image_set_file($bmp_file_name);
-
-$window_widget->show;
-$image_area->window->set_cursor(Gtk2::Gdk::Cursor->new('crosshair'));
-Gtk2->main;
-
-save_parameters("$bmp_file_name.parameters");
diff --git a/perl-install/standalone/drakupdate_fstab b/perl-install/standalone/drakupdate_fstab
deleted file mode 100755
index fde9fa585..000000000
--- a/perl-install/standalone/drakupdate_fstab
+++ /dev/null
@@ -1,201 +0,0 @@
-#!/usr/bin/perl
-
-# drakupdate_fstab
-# Copyright (C) 2002-2004 Mandrakesoft (pixel@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-
-use detect_devices;
-use security::level;
-use common;
-use fsedit;
-use lang;
-use any;
-use fs;
-
-$::isStandalone = 1; #- not using standalone.pm which generates too many logs for drakupdate_fstab purpose
-
-log::l("drakupdate_fstab called with @ARGV\n");
-
-my ($no_flag, $debug, $removed);
-
-my %args = (
- '--auto' => \$::auto,
- '--debug' => \$debug,
- '--no-flag' => \$no_flag,
- '--test' => \$::testing,
- );
-
-each_index {
- if ($args{$_}) {
- ${$args{$_}} = 1;
- splice @ARGV, $::i - $removed, 1;
- $removed++;
- }
-} @ARGV;
-
-my ($raw_action, $device_name) = @ARGV;
-my ($action) = $raw_action =~ /^--(add|del)/;
-
-@ARGV == 2 && $action or die "usage: drakupdate_fstab [--test] [--auto] [--no-flag] [--add | --del] <device>\n";
-
-main($action, $device_name);
-
-
-sub check_hard_drives {
- my ($name) = @_;
-
- #- do not do anything if there are many partitions
- #- otherwise we may add main extended partitions
- if (my ($path, $prefix) = $name =~ m!^(.*)/(\w+)\d+$!) {
- my @parts = grep { /^\Q$prefix\E\d+$/ } all($path);
- @parts <= 1;
- } else {
- 1;
- }
-}
-
-sub device_name_to_entry {
- my ($name) = @_;
- $name =~ s|/dev/||;
- $name =~ /fd[01]/ && !$::auto and return { device => $name };
- my @l = detect_devices::get();
- if ($debug) {
- require Data::Dumper;
- output("/tmp/drakdump_devices-$action", Data::Dumper->Dump([ \@l ], [ qw($l) ]));
- }
-
- my $e;
- if (my ($devfs_prefix, $nb) = $name =~ m,(.*)/(?:cd|disc|part(\d+))$,) {
- $e = find { $_->{devfs_prefix} eq $devfs_prefix } @l;
- $e->{part_number} = $nb;
- $e->{devfs_prefix} ||= $devfs_prefix;
- $e->{devfs_device} = $e->{devfs_prefix} . '/part' . $nb;
- if ($e->{devfs_device} eq $name) {
- $e->{prefer_devfs_name} = 1;
- } else {
- $e->{devfs_device} = $e->{device} = $name;
- }
- } else {
- unless ($e = find { $name eq $_->{device} } @l) {
- my ($prefix) = $name =~ m/^(.*?)\d*$/;
- $e = find { $prefix eq ($_->{prefix} || $_->{device}) } @l;
- $e->{device} = $name;
- }
- }
-
- $e->{media_type} = 'fd' if $name =~ /fd[01]/;
- $e;
-}
-
-sub set_options {
- my ($part, $useSupermount, $o_sync) = @_;
-
- $part->{is_removable} = 1; #- force removable flag
- fs::mount_options::set_default($part,
- useSupermount => $useSupermount,
- security => security::level::get(),
- lang::fs_options(lang::read()));
-
- my ($options, $unknown) = fs::mount_options::unpack($part);
- $options->{sync} = $o_sync if defined($o_sync);
- $options->{kudzu} = 1 if !$no_flag;
- fs::mount_options::pack($part, $options, $unknown);
-}
-
-sub set_mount_point {
- my ($part, $fstab) = @_;
-
- my $mntpoint = detect_devices::suggest_mount_point($part) or return;
- $mntpoint = "/mnt/$mntpoint";
-
- foreach ('', 2 .. 10) {
- next if fs::get::mntpoint2part("$mntpoint$_", $fstab);
- $part->{mntpoint} = "$mntpoint$_";
- return 1;
- }
- 0;
-}
-
-sub main {
- my ($action, $device_name) = @_;
-
- if ($::auto) {
- check_hard_drives($device_name) or return;
- }
-
- my $part = device_name_to_entry($device_name);
- my $fstab_file = '/etc/fstab';
- if (!$part) {
- print STDERR "Can't find device $device_name\n" if $::testing;
- return;
- } elsif ($::testing) {
- cp_af('/etc/fstab', $fstab_file = '/tmp/fstab');
- }
-
- my $fstab = [ fs::read_fstab('', '/etc/fstab', 'keep_freq_passno', 'keep_devfs_name', 'verbatim_credentials') ];
- my ($existing_fstab_entries, $fstab_) = partition { fsedit::is_same_hd($_, $part) } @$fstab;
-
- if ($debug) {
- require Data::Dumper;
- output("/tmp/drakdump_entries-$action", Data::Dumper->Dump([ \@ARGV, $part, $fstab, $fstab_, $existing_fstab_entries ],
- [ qw($ARGV $part $fstab $fstab_ $existing_fstab_entries) ]));
- }
- if ($action eq 'add') {
- if (@$existing_fstab_entries) {
- print STDERR "Already in fstab\n" if $::testing;
- return;
- }
- my %dynamic = getVarsFromSh('/etc/sysconfig/dynamic');
- my $useSupermount = $dynamic{SUPERMOUNT} eq 'yes' ? 'magicdev' : '';
- set_options($part, $useSupermount, to_bool($dynamic{SYNC} ne 'no'));
- set_mount_point($part, $fstab) or return;
-
- my ($line) = fs::prepare_write_fstab([$part]);
- if ($line) {
- append_to_file($fstab_file, $line);
- system("mount $part->{mntpoint}") if !$::testing && $device_name =~ /^fd\d+/;
- }
-
- if ($::auto) {
- print $part->{mntpoint}, " ", $useSupermount ? 'supermount' : 'user', "\n";
- }
- } else {
- if (!@$existing_fstab_entries) {
- print STDERR "Not found in fstab\n" if $::testing;
- return;
- }
- foreach (@$existing_fstab_entries) {
- if (!$no_flag && $_->{options} !~ /\bkudzu\b/) {
- print STDERR "Not a 'kudzu'-flagged entry\n" if $::testing;
- return;
- }
- }
-
- my ($s) = fs::prepare_write_fstab($fstab_, '', 'keep_smb_credentials');
- output($fstab_file, $s);
-
- if ($::auto) {
- print "$_->{mntpoint}\n" foreach @$existing_fstab_entries;
- }
- }
-
- if ($::testing) {
- print "fstab would have changed:\n";
- system("diff -u /etc/fstab $fstab_file");
- }
-}
diff --git a/perl-install/standalone/drakups b/perl-install/standalone/drakups
deleted file mode 100755
index ee6aeedb1..000000000
--- a/perl-install/standalone/drakups
+++ /dev/null
@@ -1,412 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-use common;
-use mouse;
-use detect_devices;
-use ugtk2 qw(:create :dialogs :helpers :wrappers);
-use interactive;
-use Libconf qw(:functions);
-use Libconf::Glueconf::NUT::Ups_conf;
-
-# config files:
-my %files = (devices => "/etc/ups/ups.conf",
- access => "/etc/ups/upsd.conf",
- users => "/etc/ups/upsd.users",
- );
-
-
-my ($struct, $users); # NUT configuration
-my ($w, $in); # GUI
-my %indexes;
-
-
-sub writeconf() {
- info_dialog(N("Warning"), "Write support for users is incomplete\n\nIt lacks some support for some extra fields that would be lost else");
- log::explanations("Updating NUT configuration accordingly");
- $struct->writeConf($files{devices});
-
- if ($users) {
- log::explanations("Updating NUT users configuration accordingly");
- $users->writeConf($files{users});
- }
-
- require services;
- services::restart("upsd");
-}
-
-sub read_nut_config() {
- $struct = Libconf::Glueconf::NUT::Ups_conf->new($files{devices})
-}
-
-sub readDriversList() {
- my (%ups, @ups);
- local $_;
- foreach (cat_(first(glob("/usr/share/doc/nut-*/docs/driver.list")))) {
- /^#/ and next;
- if (my ($vendor, $model, $extra, $driver) = /^"(.*)"\s+"(.*)"\s+"(.*)"\s+"(.*)"/) {
- $ups{$vendor}{$model} = {
- driver => $driver,
- extra => $extra,
- };
- push @ups, "$vendor|$model ($extra)";
- }
- }
- \%ups, \@ups;
-}
-
-my %models;
-
-sub add_device_wizard {
- my ($in, $config) = @_;
- my ($ups_models, $model_list) = readDriversList();
-
- use wizards;
- my ($ups, $vendor, $model, $name, $driver, $port, @new_devices);
- my $w = wizards->new;
- my $wiz;
- my %methods = (
- # network => N("Connected through the network"), # need SNMP probe
- # serial => N("Connected through a serial port"),
- # usb => N("Connected through an usb cable"),
- auto => N("Connected through a serial port or an usb cable"),
- manual => N("Manual configuration"),
- );
- my $method = $methods{auto};
- $wiz = {
- #defaultimage => "logdrake.png", # FIXME
- name => N("Add an UPS device"),
- pages => {
- welcome => {
- name => N("Welcome to the UPS configuration utility.
-
-Here, you'll add a new UPS to your system.\n"),
- no_back => 1,
- next => 'method'
- },
- method => {
- name => N("We're going to add an UPS device.
-
-Do you want to autodetect UPS devices connected to this machine or to manually select them?"),
- data => [ { label => N("Autodetection"), val => \$method, type => "list",
- list => [ values %methods ] } ],
- post => sub { +{ reverse %methods }->{$method} },
- },
- auto => {
- end => 1,
- pre => sub {
- local $::isWizard;
- my $_wait = $in->wait_message(N("Please wait"), N("Detection in progress"));
- # UPS autoconfig:
- detect_devices::probeSerialDevices() if !$::testing;
- @new_devices = ();
-
- foreach my $ups_device (detect_devices::getUPS()) {
- my $str = $ups_device->{name} || $ups_device->{DESCRIPTION};
- $str =~ s/ /_/g;
- $name = $str;
-
- if (!exists $struct->{$str}) {
- $port = $struct->{$str}{port} = $ups_device->{port} || $ups_device->{DEVICE};
- $driver = $struct->{$str}{driver} = $ups_device->{driver};
- push @new_devices, $str;
- }
- }
- },
- name => sub {
- if (@new_devices) {
- N("Congratulations") . "\n\n" .
- N("The wizard successfully added the following UPS devices:") . join("\n\n-", @new_devices)
- } else {
- N("No new UPS devices was found");
- }
- },
- },
- manual => {
- name => N("UPS driver configuration") . "\n\n" . N("Please select your UPS model."),
- data => [ { label => N("Manufacturer / Model:"), val => \$ups, list => $model_list,
- type => 'combo', sort => 1, separator => '|' }, ],
- post => sub {
- ($vendor, $model) = ($1, $2) if $ups =~ /(.*)\|(.*) \(/;
- ($name, $driver, $port) = ("myups", $ups_models->{$vendor}{$model}{driver}, "");
- ($driver) = split(/\s+/, $driver);
- "driver";
- },
- },
- driver => {
- name => sub {
- N("UPS driver configuration") . "\n\n" . N("We are configuring the \"%s\" UPS from \"%s\".
-Please fill in its name, its driver and its port.", $model, $vendor);
- },
- data => sub {
- [
- { label => N("Name:"), val => \$name, help => N("The name of your ups") },
- { label => N("Driver:"), val => \$driver, help => N("The driver that manages your ups") },
- { label => N("Port:"), val => \$port, format => \&mouse::serial_port2text, type => "combo",
- list => [ &mouse::serial_ports() ], not_edit => 0,
- help => N("The port on which is connected your ups") },
- ];
- },
- next => "end",
- },
- end => {
- name => sub {
- N("Congratulations") . "\n\n" . N("The wizard successfully configured the new \"%s\" UPS device.",
- $model . "|" . $vendor);
- },
- end => 1,
- no_back => 1,
- next => 0
- },
- },
- };
- $w->process($wiz, $in);
-
- $config->{$name}{driver} = $driver;
- $config->{$name}{port} = $port;
- # refresh the GUI when needed:
- $models{ups}->append_set(1 => $name, 2 => $driver, 3 => $port) if $models{ups};
-
- log::explanations(qq(Configuring "$name" UPS));
-}
-
-my (@acls, @rules);
-
-sub load_access_conf() {
- foreach (cat_($files{access})) {
- s/#.*//;
- if (/^\s*ACL\s*(\S*)\s*(\S*)/) {
- my ($ip, $mask) = split('/', $2);
- push @acls, [ $1, $ip, $mask ];
- } elsif (/^\s*ACCESS\s*(\S*)\s*(\S*)\s*(\S*)/) {
- push @rules, [ $1, $2, $3 ];
- }
- }
-}
-
-
-
-#------------------------------------------------------------------
-# misc gui data
-
-sub edit_row {
- my ($model, $iter) = @_;
- # create new item if needed (that is when adding a new one) at end of list
- $iter ||= $model->append;
- my $dialog = Gtk2::Dialog->new;
- $dialog->set_transient_for($w->{rwindow}) unless $::isEmbedded;
- $dialog->set_modal(1);
-
- gtkpack_($dialog->vbox,
- #map {
- #}
- );
-
- gtkadd($dialog->action_area,
- gtksignal_connect(Gtk2::Button->new(N("Ok")), clicked => sub {
- # create new item if needed (that is when adding a new one) at end of list
- $iter ||= $model->append;
- # $model->set($iter, 1 => $file->get_text); # FILL ME
- $dialog->destroy;
- # $modified++;
- }),
- gtksignal_connect(Gtk2::Button->new(N("Cancel")), clicked => sub { $dialog->destroy }),
- );
-
- $dialog->show_all;
-
-}
-
-
-sub add_callback {
- my ($model, $_list, $_getindex) = @_;
- edit_row($model);
-}
-
-sub edit_callback {
- my ($model, $list) = @_;
- my ($iter) = $list->get_selection->get_selected;
- return unless $iter;
- edit_row($model, $iter);
-}
-
-sub del_callback {
- my ($model, $list) = @_;
- my (undef, $iter) = $list->get_selection->get_selected;
- my $removed_idx = $list->get($iter, 0); # 1st column is index
- #@rules = grep { $_->{index} ne $removed_idx } @rules;
- #$tree->remove($iter);
- #sensitive_buttons(0);
- #$modified++;
-}
-
-my @pages = (
- { name => N("UPS devices"),
- columns => [ N("Name"), N("Driver"), N("Port") ], # N("Manufacturer"), N("Model"),
- callbacks => {
- add => sub {
- eval { add_device_wizard($in, $struct) };
- my $err = $@;
- die $err if $err && $err !~ /wizcancel/;
- $::WizardWindow->destroy if defined $::WizardWindow;
- undef $::WizardWindow;
- },
- edit => sub {},
- remove => sub {},
- },
- load => sub {
- read_nut_config();
- map { [ $_, @{$struct->{$_}}{qw(driver port)} ] } keys %$struct;
- },
- id => "ups",
- },
- { name => N("UPS users"),
- columns => [ N("Name") ],
- callbacks => {
- add => sub {
- my ($name) = @_;
- $users->{$name} = {};
- },
- edit => sub {},
- remove => sub {},
- },
- load => sub {
- $users = Libconf::Glueconf::NUT::Ups_conf->new($files{users});
- map { [ $_ ] } keys %$users;
- },
- id => "users",
- },
- { name => N("Access Control Lists"),
- columns => [ N("Name"), N("IP address"), N("IP mask") ],
- callbacks => {
- add => sub {},
- edit => sub {},
- remove => sub {},
- },
- load => sub {
- load_access_conf();
- @acls;
- },
- id => "acls",
- },
- { name => N("Rules"),
- columns => [ N("Action"), N("Level"), N("ACL name"), N("Password") ],
- callbacks => {
- N("Add") => sub {},
- N("Edit") => sub {},
- N("Remove") => sub {},
- },
-
- load => sub { @rules }, # already loaded when we loaded acls
- id => "rules",
- },
- );
-
-
-#------------------------------------------------------------------
-# initialize:
-
-#$in = 'interactive'->vnew('su'); # require_root_capability();
-$in = 'interactive'->vnew;
-
-$ugtk2::wm_icon = "drakups";
-
-$in->do_pkgs->ensure_is_installed('nut-server', '/etc/rc.d/init.d/upsd') if !$::testing;
-
-if (member('--wizard', @ARGV)) {
- read_nut_config();
- add_device_wizard($in, $struct);
- writeconf();
- $in->exit($@ ? 1 : 0);
-}
-
-$w = ugtk2->new(N("DrakUPS"));
-if (!$::isEmbedded) {
- $::main_window = $w->{rwindow};
- $w->{window}->set_size_request(500, 550);
- $w->{rwindow}->set_title(N("DrakUPS"));
-}
-
-#------------------------------------------------------------------
-# main window:
-
-my $_msg = N("Welcome to the UPS configuration tools");
-
-$w->{window}->add(gtkpack_(Gtk2::VBox->new,
- if_(!$::isEmbedded, 0, Gtk2::Banner->new('drakups', N("DrakUPS"))),
- 1, my $nb = Gtk2::Notebook->new,
- 0, create_okcancel(my $oc =
- {
- ok_clicked => sub {
- #$_->{save}->() foreach @pages;
- writeconf();
- $w->exit;
- },
- cancel_clicked => sub { $w->exit },
- },
- ),
- ),
- );
-
-#------------------------------------------------------------------
-# build the notebook
-
-my %labels = (
- add => N("Add"),
- edit => N("Edit"),
- remove => N("Remove"),
- );
-
-foreach my $i (@pages) {
- my $model = $models{$i->{id}} = Gtk2::ListStore->new("Glib::Int", ("Glib::String") x listlength(@{$i->{columns}}));
- my (%buttons, $list);
- $indexes{$i->{name}} = 0;
- my $idx = \$indexes{$i->{name}};
- my $getindex = sub { $$idx++ };
- $nb->append_page(gtkpack_(Gtk2::VBox->new,
- 1, create_scrolled_window($list = Gtk2::TreeView->new_with_model($model),
- [ 'automatic', 'automatic' ]),
- 0, gtkpack(Gtk2::HButtonBox->new,
- (map {
- my ($id, $label, $sub) = @$_;
- gtksignal_connect($buttons{$id} = Gtk2::Button->new($label), clicked => sub {
- $sub->($model, $list, $getindex);
- })
- } ([ 'add', N("Add"), $i->{callbacks}{add} || \&add_callback ],
- [ 'edit', N("Edit"), \&edit_callback ],
- [ 'remove', N("Remove"), \&del_callback ],
- )
- )
- #(map {
- # gtksignal_connect(Gtk2::Button->new($_), clicked => $i->{callbacks}{$_}),
- #} keys %{$i->{callbacks}})
- ),
- ),
- Gtk2::Label->new($i->{name}),
- );
- #$i->{list} = $list;
- each_index {
- $list->append_column(Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i + 1));
- } @{$i->{columns}};
- my @u = $i->{load}->();
- foreach my $line (@u) {
- $model->append_set(0 => $getindex->(), map_index { $::i + 1 => $_ } @$line);
- }
- my $set_sensitive = sub {
- my ($bool) = @_;
- $buttons{$_}->set_sensitive($bool) foreach qw(remove edit);
- };
- $set_sensitive->(0);
- $list->get_selection->signal_connect('changed' => sub {
- my ($select) = @_;
- my (undef, $iter) = $select->get_selected;
- $set_sensitive->(defined $iter);
- });
-}
-
-#------------------------------------------------------------------
-# let's start the show:
-$w->{rwindow}->show_all;
-$w->main;
diff --git a/perl-install/standalone/drakvpn b/perl-install/standalone/drakvpn
deleted file mode 100644
index a374d36bb..000000000
--- a/perl-install/standalone/drakvpn
+++ /dev/null
@@ -1,1150 +0,0 @@
-#!/usr/bin/perl
-
-#
-# author Florin Grad (florin@mandrakesoft.com)
-#
-# Copyright 2004 Mandrakesoft
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License version 2, as
-# published by the Free Software Foundation.
-#
-# 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use detect_devices;
-use interactive;
-use network::network;
-use log;
-use c;
-use network::netconnect;
-use network::shorewall;
-use network::ipsec;
-use Data::Dumper;
-
-$::isInstall and die "Not supported during install.\n";
-
-
-local $_ = join '', @ARGV;
-
-$::Wizard_pix_up = "drakvpn.png";
-$ugtk2::wm_icon = "drakvpn";
-
-my $direct = /-direct/;
-
-my ($kernel_version) = c::kernel_version() =~ /(...)/;
-log::l("[drakvpn] kernel_version $kernel_version");
-
-$kernel_version >= 2.4 or fatal_quit(N("Sorry, we support only 2.4 and above kernels."));
-
-my $tunnels_file = "/etc/shorewall/tunnels";
-my $ipsec_conf = "";
-my $racoon_conf = "/etc/racoon/racoon.conf";
-my $proc_version = "";
-my $ipsec_package = "";
-
-my $in = interactive->vnew('su');
-my $shorewall = network::shorewall::read($in, 'silent');
-my @section_names;
-
-if ($kernel_version > 2.5) {
- $ipsec_conf = "/etc/ipsec.conf";
-} else {
- $ipsec_conf = "/etc/freeswan/ipsec.conf";
-};
-my $ipsec = network::ipsec::read_ipsec_conf($ipsec_conf,$kernel_version);
-my $racoon = network::ipsec::read_racoon_conf($racoon_conf);
-
-#print network::ipsec::display_ipsec_conf($ipsec_conf,$ipsec,$kernel_version);
-
-$::Wizard_title = N("DrakVPN");
-
-$in->isa('interactive::gtk') and $::isWizard = 1;
-
-my $wait_configuring;
-
-sub fatal_quit ($) {
- log::l("[drakvpn] FATAL: $_[0]");
- undef $wait_configuring;
- $in->ask_warn('', $_[0]);
- quit_global($in, -1);
-}
-
-begin:
-
-#- **********************************
-#- * 0th step: verify if we are already set up
-
-if ($shorewall && any { !/^\s*(?:#|\n)/ } cat_($tunnels_file)) {
- $::Wizard_no_previous = 1;
-
- if (!$shorewall->{disabled}) {
- my $r = $in->ask_from_list_(N("The VPN connection is enabled."),
-N("The setup of a VPN connection has already been done.
-
-It's currently enabled.
-
-What would you like to do?"),
- [ N_("disable"), N_("reconfigure"), N_("dismiss") ]) or quit_global($in, 0);
- # FIXME: reconfigure isn't handled
- if ($r eq "disable") {
- if (!$::testing) {
- my $_wait_disabl = $in->wait_message('', N("Disabling VPN..."));
- network::ipsec::stop_daemons();
- }
- foreach ($ipsec_conf, $tunnels_file) {
- if (-f $_) { rename($_, "$_.drakvpndisable") or die "Could not rename $_ to $_.drakvpndisable" };
- }
- network::ipsec::sys("/etc/init.d/shorewall restart >/dev/null");
- log::l("[drakvpn] Disabled");
- $::Wizard_finished = 1;
- $in->ask_okcancel('', N("The VPN connection is now disabled."));
- quit_global($in, 0);
- }
- if ($r eq "dismiss") {
- quit_global($in, 0);
- }
- } else {
- my $r = $in->ask_from_list_(N("VPN connection currently disabled"),
-N("The setup of a VPN connection has already been done.
-
-It's currently disabled.
-
-What would you like to do?"),
- [ N_("enable"), N_("reconfigure"), N_("dismiss") ]);
- # FIXME: reconfigure isn't handled
- if ($r eq "enable") {
- foreach ($ipsec_conf, $tunnels_file) {
- rename($_, "$_.old") if -f $_;
- rename("$_.drakvpndisable", $_) or die "Could not find configuration. Please reconfigure.";
- };
- {
- my $_wait_enabl = $in->wait_message('', N("Enabling VPN..."));
- network::ipsec::start_daemons();
- }
- log::l("[drakvpn] Enabled");
- }
- $::Wizard_finished = 1;
- $in->ask_okcancel('', N("The VPN connection is now enabled."));
- quit_global($in, 0);
- if ($r eq "dismiss") {
- quit_global($in, 0);
- }
- }
- }
-
-#- **********************************
-#- * 1st step: detect/setup
-step_ask_confirm:
-
-$::Wizard_no_previous = 1;
-
-$direct or $in->ask_okcancel(N("Simple VPN setup."),
-N("You are about to configure your computer to use a VPN connection.
-
-With this feature, computers on your local private network and computers
-on some other remote private networks, can share resources, through
-their respective firewalls, over the Internet, in a secure manner.
-
-The communication over the Internet is encrypted. The local and remote
-computers look as if they were on the same network.
-
-Make sure you have configured your Network/Internet access using
-drakconnect before going any further."), 1) or goto begin;
-
-undef $::Wizard_no_previous;
-
-if ($kernel_version < 2.5) {
- system("/sbin/modprobe ipsec") if -e "/sbin/modprobe";
- $proc_version = cat_("/proc/net/ipsec_version") if -e "/proc/net/ipsec_version";
- if ($proc_version =~ /super/i) {
- $ipsec_package = "super-freeswan";
- } else {
- $ipsec_package = "freeswan";
- }
-} else {
- $ipsec_package = "ipsec-tools";
- $proc_version = "ipsec native";
-}
-
-$direct or $in->ask_okcancel(N("Simple VPN setup."),
-N("VPN connection.
-
-This program is based on the following projects:
- - FreeSwan: \t\t\thttp://www.freeswan.org/
- - Super-FreeSwan: \t\thttp://www.freeswan.ca/
- - ipsec-tools: \t\t\thttp://ipsec-tools.sourceforge.net/
- - ipsec-howto: \t\thttp://www.ipsec-howto.org
- - the docs and man pages coming with the %s package
-
-Please read AT LEAST the ipsec-howto docs
-before going any further.",$ipsec_package)) or goto begin;
-
-$direct or $in->ask_okcancel(N("Kernel module."),
-N("The kernel needs to have ipsec support.
-
-You're running a %s kernel version.
-
-This kernel has '%s' support.", $kernel_version, $proc_version)) or goto begin;
-
-step_detectsetup:
-
-#my @configured_devices = map { /ifcfg-(\S+)/ } glob('/etc/sysconfig/network-scripts/ifcfg*');
-
-my %aliased_devices;
-/^\s*alias\s+(eth[0-9])\s+(\S+)/ and $aliased_devices{$1} = $2 foreach cat_("/etc/modules.conf");
-
-my $card_netconnect = network::netconnect::get_net_device() || "eth0";
-defined $card_netconnect and log::l("[drakvpn] Information from netconnect: ignore card $card_netconnect");
-
- $in->ask_from('',
- N("Please enter the name of the interface connected to the internet.
-
-Examples:
- ppp+ for modem or DSL connections,
- eth0, or eth1 for cable connection,
- ippp+ for a isdn connection.
-"),
- [ { label => N("Net Device"), val => \$card_netconnect, list => [ detect_devices::getNet() ], not_edit => 0 } ])
- or goto step_ask_confirm;
-
-#- **********************************
-#- * 2nd step: configure
-
-#$wait_configuring = $in->wait_message(N("Configuring..."),
-# N("Configuring scripts, installing software, starting servers..."));
-
-#- if the kernel has super-freeswan support, remove the freeswan package
-#- and vice-versa
-#- if you're using e kernel 2.5 and above with native ipsec support, remove
-#- both freeswan and super-freeswan packages
-
-if (!$::testing && $ipsec_package =~ /super/i && $kernel_version < 2.5) {
- log::l("[drakvpn] removing the freeswan package");
- $in->do_pkgs->remove("freeswan") if -e "/etc/freeswan/ipsec.d/policies/clear";
- log::l("[drakvpn] removing the ipsec-tools package");
- $in->do_pkgs->remove("ipsec-tools") if -e "/sbin/setkey";
- $in->do_pkgs->remove("libipsec-tools0") if -e "/lib/libipsec.so.0";
-} elsif (!$::testing && $kernel_version < 2.5) {
- log::l("[drakvpn] removing the $ipsec_package package");
- $in->do_pkgs->remove("super-freeswan") if -e "/usr/lib/ipsec/auto.advroute";
- log::l("[drakvpn] removing the ipsec-tools package");
- $in->do_pkgs->remove("ipsec-tools") if -e "/sbin/setkey";
- $in->do_pkgs->remove("libipsec-tools0") if -e "/sbin/setkey";
-} else {
- log::l("[drakvpn] removing the freeswan AND the super-freeswan packages");
- $in->do_pkgs->remove("freeswan") if -e "/etc/freeswan/ipsec.d/policies/clear";
- $in->do_pkgs->remove("super-freeswan-doc") if -e "/usr/sbin/ipsec";
- $in->do_pkgs->remove("super-freeswan") if -e "/usr/lib/ipsec/auto.advroute";
-};
-
-
-#- install and setup the RPM packages, if needed
-
-my %rpm2file;
-log::l("[drakvpn] install the $ipsec_package and the shorewall rpm packages");
-if (!$::testing && $ipsec_package =~ /ipsec-tools/i) {
- %rpm2file = ($ipsec_package => '/sbin/setkey',
- shorewall => '/sbin/shorewall');
-} else {
- %rpm2file = ($ipsec_package => '/usr/sbin/ipsec',
- shorewall => '/sbin/shorewall');
-};
-
-#- first: try to install all in one step, if needed
-if (! ($ipsec_package =~ /super/i && -e "/usr/lib/ipsec/auto.advroute" ||
- $ipsec_package =~ /^freeswan/i && -e "/etc/freeswan/ipsec.d/policies/clear" ||
- $ipsec_package =~ /ipsec-tools/i && -e "/sbin/setkey")) {
-
- my @needed_to_install = grep { !-e $rpm2file{$_} } keys %rpm2file;
- @needed_to_install and $in->do_pkgs->install(@needed_to_install) if !$::testing;
- #- second: try one by one if failure detected
- if (!$::testing && any { !-e $rpm2file{$_} } keys %rpm2file) {
- foreach (keys %rpm2file) {
- -e $rpm2file{$_} or $in->do_pkgs->install($_);
- -e $rpm2file{$_} or fatal_quit(N("Problems installing package %s", $_));
- }
- }
-}
-
-undef $wait_configuring;
-
-#- configure the $ipsec_conf file
-#- Add, Remove config|conn entries
-
-step_configuration:
-
-my $c;
-
-my %messages = (ipsec => N("Security Policies"), racoon => N("IKE daemon racoon"));
-
-if ($kernel_version > 2.5) {
- $in->ask_from(N("Configuration file"),
-N("Configuration step!
-
-You need to define the Security Policies and then to
-configure the automatic key exchange (IKE) daemon.
-The KAME IKE daemon we're using is called 'racoon'.
-
-What would you like to configure?\n"),
- [ { val => \$c, type => "list", list => [ keys %messages ], format => sub { $messages{$_[0]} } } ]) or goto step_detectsetup;
-
-} else {
-$in->ask_okcancel(N("Configuration file"),
-N("Next, we will configure the %s file.\n
-
-Simply click on Next.\n", $ipsec_conf)) or goto step_detectsetup;
-
- $c = "configure";
-};
-
-#-------------------------------------------------------------------
-#---------------------- configure ipsec_conf -----------------------
-#-------------------------------------------------------------------
-
-if ($c eq "ipsec" || $c eq "configure") {
-
-step_configure_ipsec_conf:
-
-@section_names = network::ipsec::get_section_names_ipsec_conf($ipsec,$kernel_version) if $ipsec;
-
-my $choice = $section_names[0] if $section_names[0];
-my $d = $in->ask_from_list(N("%s entries", $ipsec_conf),
-N("The %s file contents
-is divided into sections.\n
-You can now:\n
- - display, add, edit, or remove sections, then
- - commit the changes
-
-What would you like to do?\n", $ipsec_conf),
- [ N_("_:display here is a verb\nDisplay"), N_("Add"), N_("Edit"), N_("Remove"), N_("Commit") ]) or goto step_configuration;
-
-my $existing_section = "";
-
-#- display $ipsec_conf -------------------------
-
-step_display_ipsec_conf:
-
-if ($d eq "display $ipsec_conf" || $d eq "_:display here is a verb\nDisplay") {
- my $ipsec_exists = 0;
- foreach my $key (keys %$ipsec) {
- $ipsec_exists = 1 if $ipsec->{$key};
- };
- if ($ipsec_exists) {
- $in->ask_okcancel(N("_:display here is a verb\nDisplay configuration"),
- network::ipsec::display_ipsec_conf($ipsec,$kernel_version));
- goto step_configure_ipsec_conf;
- } else {
-$in->ask_okcancel(N("_:display here is a verb\nDisplay configuration"),
-N("The %s file does not exist.\n
-This must be a new configuration.\n
-You'll have to go back and choose 'add'.\n", $ipsec_conf));
- goto step_configure_ipsec_conf;
- }
-
-#- add ---------------------
-
-} elsif ($d eq "Add") {
-
-step_add_section:
-
-if ($kernel_version < 2.5) {
-
-#- add ---- kernel 2.4 part -------------------------------
-
-my $e = $in->ask_from_list_(N("ipsec.conf entries"),
-N("The %s file contains different sections.\n
-Here is its skeleton: 'config setup'
- 'conn default'
- 'normal1'
- 'normal2' \n
-You can now add one of these sections.\n
-Choose the section you would like to add.\n", $ipsec_conf),
- [ N_("config setup"), N_("conn %default"), N_("normal conn"), N_("dismiss") ]) or goto step_configure_ipsec_conf;
- if ($e eq "config setup") {
-
- $existing_section = network::ipsec::already_existing_section_ipsec_conf("config setup", $ipsec, $kernel_version);
-
- if ($existing_section eq "already existing") {
-$in->ask_okcancel(N("Exists!"),
-N("A section with this name already exists.
-The section names have to be unique.\n
-You'll have to go back and add another section
-or change its name.\n"));
- goto step_add_section;
-};
-
- my $config_setup = {
- 1 => [ "config", "setup" ],
- 2 => [ "interfaces", "%defaultroute" ],
- 3 => [ "klipsdebug", "none" ],
- 4 => [ "plutodebug", "none" ],
- 5 => [ "plutoload", "%search" ],
- 6 => [ "plutostart", "%search" ],
- 7 => [ "uniqueids", "yes" ],
- };
- $in->ask_from('',
-N("This section has to be on top of your
-%s file.\n
-Make sure all other sections follow this config
-setup section.\n
-Choose continue or previous when you are done.\n", $ipsec_conf),
- [ { label => N("interfaces"), val => \$config_setup->{2}[1], type => 'entry' },
- { label => N("klipsdebug"), val => \$config_setup->{3}[1], type => 'entry' },
- { label => N("plutodebug"), val => \$config_setup->{4}[1], type => 'entry' },
- { label => N("plutoload"), val => \$config_setup->{5}[1], type => 'entry' },
- { label => N("plutostart"), val => \$config_setup->{6}[1], type => 'entry' },
- { label => N("uniqueids"), val => \$config_setup->{7}[1], type => 'entry' },
- ]
-) or goto step_configure_ipsec_conf;
-
- network::ipsec::add_section_ipsec_conf($config_setup, $ipsec);
-
- goto step_configure_ipsec_conf;
-
- } elsif ($e eq "conn %default") {
-
- $existing_section = network::ipsec::already_existing_section_ipsec_conf("conn %default", $ipsec, $kernel_version);
-
- if ($existing_section eq "already existing") {
-$in->ask_okcancel(N("Exists!"),
-N("A section with this name already exists.
-The section names have to be unique.\n
-You'll have to go back and add another section
-or change its name.\n"));
- goto step_add_section;
-};
-
- my $conn_default = {
- 1 => [ "conn", "%default" ],
- 2 => [ "pfs", "yes" ],
- 3 => [ "keyingtries", "1" ],
- 4 => [ "compress", "yes" ],
- 5 => [ "disablearrivalcheck", "no" ],
- 6 => [ "left", "" ],
- 7 => [ "leftcert", "" ],
- 8 => [ "leftrsasigkey", "%cert" ],
- 9 => [ "leftsubnet", "" ],
- 10 => [ "leftnexthop", "" ],
- };
- $in->ask_from('',
-N("This is the first section after the config
-setup one.\n
-Here you define the default settings.
-All the other sections will follow this one.
-The left settings are optional. If don't define
-them here, globally, you can define them in each
-section.\n",),
- [ { label => N("PFS"), val => \$conn_default->{2}[1], type => 'entry' },
- { label => N("keyingtries"), val => \$conn_default->{3}[1], type => 'entry' },
- { label => N("compress"), val => \$conn_default->{4}[1], type => 'entry' },
- { label => N("disablearrivalcheck"), val => \$conn_default->{5}[1], type => 'entry' },
- { label => N("left"), val => \$conn_default->{6}[1], type => 'entry' },
- { label => N("leftcert"), val => \$conn_default->{7}[1], type => 'entry' },
- { label => N("leftrsasigkey"), val => \$conn_default->{8}[1], type => 'entry' },
- { label => N("leftsubnet"), val => \$conn_default->{9}[1], type => 'entry' },
- { label => N("leftnexthop"), val => \$conn_default->{10}[1], type => 'entry' },
- ]
-) or goto step_configure_ipsec_conf;
-
- network::ipsec::add_section_ipsec_conf($conn_default, $ipsec);
-
- goto step_configure_ipsec_conf;
-
- } elsif ($e eq "normal conn") {
-
-
- my $normal_conn = {
- 1 => [ "conn", "my-connection" ],
- 2 => [ "authby", "rsasig" ],
- 3 => [ "auto", "start" ],
- 4 => [ "left", "" ],
- 5 => [ "leftcert", "" ],
- 6 => [ "leftrsasigkey", "%cert" ],
- 7 => [ "leftsubnet", "" ],
- 8 => [ "leftnexthop", "" ],
- 9 => [ "right", "" ],
- 10 => [ "rightcert", "" ],
- 11 => [ "rightrsasigkey", "%cert" ],
- 12 => [ "rightsubnet", "" ],
- 13 => [ "rightnexthop", "" ],
- };
-
-step_add_normal_conn:
- $in->ask_from('',
-N("Your %s file has several sections, or connections.\n
-You can now add a new section.
-Choose continue when you are done to write the data.\n", $ipsec_conf),
- [ { label => N("section name"), val => \$normal_conn->{1}[1], type => 'entry' },
- { label => N("authby"), val => \$normal_conn->{2}[1], type => 'entry' },
- { label => N("auto"), val => \$normal_conn->{3}[1], type => 'entry' },
- { label => N("left"), val => \$normal_conn->{4}[1], type => 'entry' },
- { label => N("leftcert"), val => \$normal_conn->{5}[1], type => 'entry' },
- { label => N("leftrsasigkey"), val => \$normal_conn->{6}[1], type => 'entry' },
- { label => N("leftsubnet"), val => \$normal_conn->{7}[1], type => 'entry' },
- { label => N("leftnexthop"), val => \$normal_conn->{8}[1], type => 'entry' },
- { label => N("right"), val => \$normal_conn->{9}[1], type => 'entry' },
- { label => N("rightcert"), val => \$normal_conn->{10}[1], type => 'entry' },
- { label => N("rightrsasigkey"), val => \$normal_conn->{11}[1], type => 'entry' },
- { label => N("rightsubnet"), val => \$normal_conn->{12}[1], type => 'entry' },
- { label => N("rightnexthop"), val => \$normal_conn->{13}[1], type => 'entry' },
- ]
-) or goto step_configure_ipsec_conf;
-
- $existing_section = network::ipsec::already_existing_section_ipsec_conf($normal_conn->{1}[0] . " " . $normal_conn->{1}[1], $ipsec, $kernel_version);
-
- if ($existing_section eq "already existing") {
-$in->ask_okcancel(N("Exists!"),
-N("A section with this name already exists.
-The section names have to be unique.\n
-You'll have to go back and add another section
-or change the name of the section.\n"));
- goto step_add_normal_conn;
-};
-
- network::ipsec::add_section_ipsec_conf($normal_conn, $ipsec);
-
- goto step_configure_ipsec_conf;
-
- }
-
-} else {
-
-#- add ---- kernel 2.6 part -------------------------------
-
- my $section = { command => 'spdadd',
- src_range => 'src_network_address',
- dst_range => 'dest_network_address',
- upperspec => 'any',
- flag => '-P',
- direction => 'in or out',
- ipsec => 'ipsec',
- protocol => 'esp',
- mode => 'tunnel',
- src_dest => 'source-destination',
- level => 'require' };
-
-step_add_section_ipsec_conf_k26:
-
- ask_info3('',
-N("Add a Security Policy.\n
-You can now add a Security Policy.\n
-Choose continue when you are done to write the data.\n"), $section) or goto step_configure_ipsec_conf;
-
-# $existing_section = network::ipsec::already_existing_section_ipsec_conf($section->{src_dest}, $ipsec, $kernel_version);
-#
-# if ($existing_section eq "already existing") {
-#$in->ask_okcancel(N("Exists!"),
-#N("A section with this name already exists.
-#The section names have to be unique.\n
-#You'll have to go back and add another section
-#or change the name of the section.\n"));
-# goto step_add_section_ipsec_conf_k26;
-#};
-
- if (!$ipsec->{1}) {
- put_in_hash($ipsec, { max(keys %$ipsec) + 1 => "#!/sbin/setkey -f" });
- put_in_hash($ipsec, { max(keys %$ipsec) + 1 => "flush;" });
- put_in_hash($ipsec, { max(keys %$ipsec) + 1 => "spdflush;" });
- };
-
- network::ipsec::add_section_ipsec_conf($section, $ipsec);
-
- @section_names = network::ipsec::get_section_names_ipsec_conf($ipsec,$kernel_version);
-
- goto step_configure_ipsec_conf;
-};
-
-#- edit ---------------------
-
-} elsif ($d eq "Edit") {
-
-step_edit_ipsec_conf:
-$in->ask_from(N("Edit section"),
-N("Your %s file has several sections or connections.\n
-You can choose here below the one you want to edit
-and then click on next.\n", $ipsec_conf),
- [ { val => \$choice, list => \@section_names, label => N("Section names"), sort => 0, not_edit => 0 } ])
- or goto step_configure_ipsec_conf;
-
-my $number = network::ipsec::matched_section_key_number_ipsec_conf($choice,$ipsec,$kernel_version);
-
-#- edit ---- kernel 2.4 part -------------------------------
-
-if ($kernel_version < 2.5) {
-if ($choice =~ /^version|block|private|clear|packet/) {
-
-$in->ask_okcancel(N("Can't edit!"),
-N("You cannot edit this section.\n
-This section is mandatory for Freeswan 2.X.
-One has to specify version 2.0 on the top
-of the %s file, and eventually, disable or
-enable the opportunistic encryption.\n",$ipsec_conf));
- goto step_edit_ipsec_conf;
-
-} elsif ($choice =~ /^config setup/) {
- $in->ask_from('',
-N("Your %s file has several sections.\n
-You can now edit the config setup section entries.
-Choose continue when you are done to write the data.\n", $ipsec_conf),
-
-[ network::ipsec::dynamic_list($number, $ipsec) ]
-
-) or goto step_configure_ipsec_conf;
-
- goto step_configure_ipsec_conf;
-} elsif ($choice =~ /^conn %default/) {
- $in->ask_from('',
-N("Your %s file has several sections or connections.\n
-You can now edit the default section entries.
-Choose continue when you are done to write the data.\n", $ipsec_conf),
-
-[ network::ipsec::dynamic_list($number, $ipsec) ]
-
-) or goto step_configure_ipsec_conf;
-
- goto step_configure_ipsec_conf;
-
-} elsif ($choice =~ /^conn/) {
-
- $in->ask_from('',
-N("Your %s file has several sections or connections.\n
-You can now edit the normal section entries.\n
-Choose continue when you are done to write the data.\n", $ipsec_conf),
-
-[ network::ipsec::dynamic_list($number, $ipsec) ]
-
-) or goto step_configure_ipsec_conf;
-
- goto step_configure_ipsec_conf;
-
-} else {
-
- goto step_configure_ipsec_conf;
-
-};
-
-#- edit ---- kernel 2.6 part -------------------------------
-
-} else {
-
- ask_info3('',
-N("Edit a Security Policy.\n
-You can now edit a Security Policy.\n
-Choose continue when you are done to write the data.\n"), $ipsec->{$number}) or goto step_configure_ipsec_conf;
-
-goto step_configure_ipsec_conf;
-
-};
-
-#- remove ---------------------
-
-} elsif ($d eq "Remove") {
-$in->ask_from(N("Remove section"),
-N("Your %s file has several sections or connections.\n
-You can choose here below the one you want to remove
-and then click on next.\n", $ipsec_conf),
- [ { val => \$choice, list => \@section_names, label => N("Section names"), sort => 0, not_edit => 0 } ]);
-
- network::ipsec::remove_section_ipsec_conf($choice,$ipsec,$kernel_version);
-
- @section_names = network::ipsec::get_section_names_ipsec_conf($ipsec,$kernel_version) if $ipsec;
-
- goto step_configure_ipsec_conf;
-
-#- continue and write ---------------------
-
-} elsif ($d eq "Commit") {
- log::l("[drakvpn] Modify the $ipsec_conf file");
- network::ipsec::write_ipsec_conf($ipsec_conf, $ipsec,$kernel_version);
- }
-#-------------------------------------------------------------------
-#---------------------- configure racoon_conf -----------------------
-#-------------------------------------------------------------------
-
-} elsif ($c eq "racoon") {
-
-step_configure_racoon_conf:
-
-@section_names = network::ipsec::get_section_names_racoon_conf($racoon) if $racoon;
-
-my $choice = $section_names[0] if $section_names[0];
-my $d = $in->ask_from_list_(N("%s entries", $racoon_conf),
-N("The racoon.conf file configuration.\n
-The contents of this file is divided into sections.
-You can now:
- - display \t\t (display the file contents)
- - add \t\t (add one section)
- - edit \t\t\t (modify parameters of an existing section)
- - remove \t\t (remove an existing section)
- - commit \t\t (writes the changes to the real file)"),
- [ N_("_:display here is a verb\nDisplay"), N_("Add"), N_("Edit"), N_("Remove"), N_("Commit") ]) or goto step_configuration;
-
-
-#- display $racoon_conf -------------------------
-
-step_display_racoon_conf:
-
-if ($d eq "_:display here is a verb\nDisplay") {
-
- my $racoon_exists = 0;
- foreach my $key (keys %$racoon) {
- $racoon_exists = 1 if $racoon->{$key};
- };
-
- if ($racoon_exists) {
- $in->ask_okcancel(N("_:display here is a verb\nDisplay configuration"),
- network::ipsec::display_racoon_conf($racoon));
- goto step_configure_racoon_conf;
- } else {
-$in->ask_okcancel(N("_:display here is a verb\nDisplay configuration"),
-N("The %s file does not exist\n
-This must be a new configuration.\n
-You'll have to go back and choose configure.\n", $racoon_conf));
- goto step_configure_racoon_conf;
- }
-
-#- add $racoon_conf ------------------------------
-
-} elsif ($d eq "Add") {
-
-step_add_section_racoon:
-
-#my $existing_section = "";
-
-my $e = $in->ask_from_list_(N("racoonf.conf entries"),
-N("The 'add' sections step.\n
-Here below is the racoon.conf file skeleton:
-\t'path'
-\t'remote'
-\t'sainfo' \n
-Choose the section you would like to add.\n"),
- [ N_("path"), N_("remote"), N_("sainfo"), N_("dismiss") ]) or goto step_configure_racoon_conf;
-if ($e eq "path") {
-
- my $path_section = {
- 1 => [ 'path', 'path_type', '"/etc/racoon/certs"' ],
- };
-
- $in->ask_from('',
-N("The 'add path' section step.\n
-The path sections have to be on top of your racoon.conf file.\n
-Put your mouse over the certificate entry to obtain online help."),
- [ { label => N("path type"),
- val => \$path_section->{1}[1],
- list => [ 'certificate', 'pre_shared_key', 'include' ],
- help =>
-N("path include path: specifies a path to include
-a file. See File Inclusion.
- Example: path include '/etc/racoon'
-
-path pre_shared_key file: specifies a file containing
-pre-shared key(s) for various ID(s). See Pre-shared key File.
- Example: path pre_shared_key '/etc/racoon/psk.txt' ;
-
-path certificate path: racoon(8) will search this directory
-if a certificate or certificate request is received.
- Example: path certificate '/etc/cert' ;
-
-File Inclusion: include file
-other configuration files can be included.
- Example: include \"remote.conf\" ;
-
-Pre-shared key File: Pre-shared key file defines a pair
-of the identifier and the shared secret key which are used at
-Pre-shared key authentication method in phase 1."),
-},
- { label => N("real file"), val => \$path_section->{1}[2], type => 'entry' },
- ]
-) or goto step_configure_racoon_conf;
-
-network::ipsec::add_section_racoon_conf($path_section, $racoon);
-} elsif ($e eq "remote") {
- my $main_remote_section = { 1 => [ 'remote', 'address' ],
- 2 => [ 'exchange_mode', 'aggressive,main' ],
- 3 => [ 'generate_policy', 'on' ],
- 4 => [ 'passive', 'on' ],
- 5 => [ 'certificate_type', 'x509', '"my_certificate.pem"', '"my_private_key.pem"' ],
- 6 => [ 'peers_certfile', '"remote.public"' ],
- 7 => [ 'verify_cert', 'on' ],
- 8 => [ 'my_identifier', 'asn1dn' ],
- 9 => [ 'peers_identifier', 'asn1dn' ]
- };
- my $proposal_remote_section = { 1 => [ 'proposal' ],
- 2 => [ 'encryption_algorithm', '3des' ],
- 3 => [ 'hash_algorithm', 'md5' ],
- 4 => [ 'authentication_method', 'rsasig' ],
- 5 => [ 'dh_group', 'modp1024' ]
- };
- ask_info2('',
-N("Make sure you already have the path sections
-on the top of your racoon.conf file.
-
-You can now choose the remote settings.
-Choose continue or previous when you are done.\n"), $main_remote_section, $proposal_remote_section) or goto step_configure_racoon_conf;
-
-network::ipsec::add_section_racoon_conf($main_remote_section, $racoon);
-network::ipsec::add_section_racoon_conf($proposal_remote_section, $racoon);
-} elsif ($e eq "sainfo") {
- my $sainfo_section = { 1 => [ 'sainfo', 'address', '192.168.100.2', 'any', 'address', '10.0.0.2', 'any' ],
- 2 => [ 'pfs_group', '1' ],
- 3 => [ 'lifetime', 'time', '30', 'sec' ],
- 4 => [ 'encryption_algorithm', '3des' ],
- 5 => [ 'authentication_algorithm', 'hmac_sha1' ],
- 6 => [ 'compression_algorithm', 'deflate' ],
- };
- ask_info('',
-N("Make sure you already have the path sections
-on the top of your %s file.
-
-You can now choose the sainfo settings.
-Choose continue or previous when you are done.\n", $racoon_conf), $sainfo_section) or goto step_configure_racoon_conf;
-
-network::ipsec::add_section_racoon_conf($sainfo_section, $racoon);
-}
-
-@section_names = network::ipsec::get_section_names_racoon_conf($racoon) if $racoon;
-
-goto step_configure_racoon_conf;
-
-#- edit $racoon_conf -----------------------------
-
-} elsif ($d eq "Edit") {
-$in->ask_from(N("Edit section"),
-N("Your %s file has several sections or connections.
-
-You can choose here in the list below the one you want
-to edit and then click on next.\n", $racoon_conf),
- [ { val => \$choice, list => \@section_names, label => N("Section names"), sort => 0, not_edit => 0 } ])
- or goto step_configure_racoon_conf;
-
-my $number = network::ipsec::matched_section_key_number_racoon_conf($choice,$racoon);
-
-if ($choice =~ /^remote/) {
- ask_info2('',
-N("Your %s file has several sections.\n
-
-You can now edit the remote section entries.
-
-Choose continue when you are done to write the data.\n", $racoon_conf), $racoon->{$number}, $racoon->{$number+2})
- or goto step_configure_racoon_conf;
-
-} elsif ($choice =~ /^sainfo/) {
- ask_info('',
-N("Your %s file has several sections.
-
-You can now edit the sainfo section entries.
-
-Choose continue when you are done to write the data.", $racoon_conf), $racoon->{$number}) or goto step_configure_racoon_conf;
-
-} elsif ($choice =~ /^path/) {
- $in->ask_from('',
-N("This section has to be on top of your
-%s file.\n
-Make sure all other sections follow these path
-sections.\n
-You can now edit the path entries.
-
-Choose continue or previous when you are done.\n", $racoon_conf),
- [ { label => N("path_type"), val => \$racoon->{$number}{1}[1], list => [ 'certificate', 'pre_shared_key', 'include' ] },
- { label => N("real file"), val => \$racoon->{$number}{1}[2], type => 'entry' },
- ]
-) or goto step_configure_racoon_conf;
-}
-
-goto step_configure_racoon_conf;
-
-#- remove $racoon_conf ---------------------------
-
-} elsif ($d eq "Remove") {
-$in->ask_from(N("Remove section"),
-N("Your %s file has several sections or connections.\n
-You can choose here below the one you want to remove
-and then click on next.\n", $racoon_conf),
- [ { val => \$choice, list => \@section_names, label => N("Section names"), sort => 0, not_edit => 0 } ]);
-
-my $number = network::ipsec::matched_section_key_number_racoon_conf($choice,$racoon);
-network::ipsec::remove_section_racoon_conf($choice,$racoon,$number);
- @section_names = network::ipsec::get_section_names_racoon_conf($racoon) if $racoon;
-
- goto step_configure_racoon_conf;
-
-#- write $racoon_conf and continue ---------------
-} elsif ($d eq "Commit") {
- log::l("[drakvpn] Modify the $racoon_conf file");
- network::ipsec::write_racoon_conf($racoon_conf, $racoon);
-}
-}
-
-#- start the daemons
-network::ipsec::start_daemons();
-
-#- bye-bye message
-
-undef $wait_configuring;
-
-$::Wizard_no_previous = 1;
-$::Wizard_finished = 1;
-
-$in->ask_okcancel(N("Congratulations!"),
-N("Everything has been configured.\n
-You may now share resources through the Internet,
-in a secure way, using a VPN connection.
-
-You should make sure that that the tunnels shorewall
-section is configured."));
-
-log::l("[drakvpn] Installation complete, exiting");
-quit_global($in, 0);
-
-sub quit_global {
- my ($in, $exitcode) = @_;
- $in->exit($exitcode);
- goto begin
-}
-
-
-sub ask_info {
- my ($title, $text, $data) = @_;
- $in->ask_from($title, $text,
- [ { label => N("Sainfo source address"), val => \$data->{1}[2], type => 'entry',
- help => N("sainfo (source_id destination_id | anonymous) { statements }
-defines the parameters of the IKE phase 2
-(IPsec-SA establishment).
-
-source_id and destination_id are constructed like:
-
- address address [/ prefix] [[port]] ul_proto
-
-Examples: \n
-sainfo anonymous (accepts connections from anywhere)
- leave blank this entry if you want anonymous
-
-sainfo address 203.178.141.209 any address 203.178.141.218 any
- 203.178.141.209 is the source address
-
-sainfo address 172.16.1.0/24 any address 172.16.2.0/24 any
- 172.16.1.0/24 is the source address") },
- { label => N("Sainfo source protocol"), val => \$data->{1}[3], type => 'entry',
- help => N("sainfo (source_id destination_id | anonymous) { statements }
-defines the parameters of the IKE phase 2
-(IPsec-SA establishment).
-
-source_id and destination_id are constructed like:
-
- address address [/ prefix] [[port]] ul_proto
-
-Examples: \n
-sainfo anonymous (accepts connections from anywhere)
- leave blank this entry if you want anonymous
-
-sainfo address 203.178.141.209 any address 203.178.141.218 any
- the first 'any' allows any protocol for the source") },
- { label => N("Sainfo destination address"), val => \$data->{1}[5], type => 'entry',
- help => N("sainfo (source_id destination_id | anonymous) { statements }
-defines the parameters of the IKE phase 2
-(IPsec-SA establishment).
-
-source_id and destination_id are constructed like:
-
- address address [/ prefix] [[port]] ul_proto
-
-Examples: \n
-sainfo anonymous (accepts connections from anywhere)
- leave blank this entry if you want anonymous
-
-sainfo address 203.178.141.209 any address 203.178.141.218 any
- 203.178.141.218 is the destination address
-
-sainfo address 172.16.1.0/24 any address 172.16.2.0/24 any
- 172.16.2.0/24 is the destination address") },
- { label => N("Sainfo destination protocol"), val => \$data->{1}[6], type => 'entry',
- help => N("sainfo (source_id destination_id | anonymous) { statements }
-defines the parameters of the IKE phase 2
-(IPsec-SA establishment).
-
-source_id and destination_id are constructed like:
-
- address address [/ prefix] [[port]] ul_proto
-
-Examples: \n
-sainfo anonymous (accepts connections from anywhere)
- leave blank this entry if you want anonymous
-
-sainfo address 203.178.141.209 any address 203.178.141.218 any
- the last 'any' allows any protocol for the destination") },
- { label => N("PFS group"), val => \$data->{2}[1],
- list => [ qw(modp768 modp1024 modp1536 1 2 5) ],
- help => N("define the group of Diffie-Hellman exponentiations.
-If you do not require PFS then you can omit this directive.
-Any proposal will be accepted if you do not specify one.
-group is one of the following: modp768, modp1024, modp1536.
-Or you can define 1, 2, or 5 as the DH group number.") },
- { label => N("Lifetime number"), val => \$data->{3}[2], type => 'entry',
- help => N("define a lifetime of a certain time which will be pro-
-posed in the phase 1 negotiations. Any proposal will be
-accepted, and the attribute(s) will not be proposed to
-the peer if you do not specify it(them). They can be
-individually specified in each proposal.
-
-Examples: \n
- lifetime time 1 min; # sec,min,hour
- lifetime time 1 min; # sec,min,hour
- lifetime time 30 sec;
- lifetime time 30 sec;
- lifetime time 60 sec;
- lifetime time 12 hour;
-
-So, here, the lifetime numbers are 1, 1, 30, 30, 60 and 12.
-") },
- { label => N("Lifetime unit"), val => \$data->{3}[3],
- list => [ qw(sec min hour) ],
- help => N("define a lifetime of a certain time which will be pro-
-posed in the phase 1 negotiations. Any proposal will be
-accepted, and the attribute(s) will not be proposed to
-the peer if you do not specify it(them). They can be
-individually specified in each proposal.
-
-Examples: \n
- lifetime time 1 min; # sec,min,hour
- lifetime time 1 min; # sec,min,hour
- lifetime time 30 sec;
- lifetime time 30 sec;
- lifetime time 60 sec;
- lifetime time 12 hour;
-
-So, here, the lifetime units are 'min', 'min', 'sec', 'sec', 'sec' and 'hour'.
-") },
- { label => N("Encryption algorithm"), val => \$data->{4}[1],
- list => [ qw(des 3des des_iv64 des_iv32 rc5 rc4 idea 3idea cast128 blowfish null_enc twofish rijndae) ] },
- { label => N("Authentication algorithm"), val => \$data->{5}[1],
- list => [ qw(des 3des des_iv64 des_iv32 hmac_md5 hmac_sha1 non_auth) ] },
- { label => N("Compression algorithm"), val => \$data->{6}[1],
- list => [ N_("deflate") ], format => \&translate, allow_empty_list => 1 }
-
-]) }
-
-sub ask_info2 {
- my ($title, $text, $main_remote_section, $proposal_remote_section) = @_;
- $in->ask_from($title, $text,,
- [ { label => N("Remote"), val => \$main_remote_section->{1}[1], type => 'entry',
- help => N("remote (address | anonymous) [[port]] { statements }
-specifies the parameters for IKE phase 1 for each remote node.
-The default port is 500. If anonymous is specified, the state-
-ments apply to all peers which do not match any other remote
-directive.\n
-Examples: \n
-remote anonymous
-remote ::1 [8000]") },
- { label => N("Exchange mode"), val => \$main_remote_section->{2}[1],
- list => [ qw(main,agressive agressive,main) ],
- help => N("defines the exchange mode for phase 1 when racoon is the
-initiator. Also it means the acceptable exchange mode
-when racoon is responder. More than one mode can be
-specified by separating them with a comma. All of the
-modes are acceptable. The first exchange mode is what
-racoon uses when it is the initiator.\n") },
- { label => N("Generate policy"), val => \$main_remote_section->{3}[1],
- list => [ N_("off"), N_("on") ], format => \&translate,
- help => N("This directive is for the responder. Therefore you
-should set passive on in order that racoon(8) only
-becomes a responder. If the responder does not have any
-policy in SPD during phase 2 negotiation, and the direc-
-tive is set on, then racoon(8) will choice the first pro-
-posal in the SA payload from the initiator, and generate
-policy entries from the proposal. It is useful to nego-
-tiate with the client which is allocated IP address
-dynamically. Note that inappropriate policy might be
-installed into the responder's SPD by the initiator. So
-that other communication might fail if such policies
-installed due to some policy mismatches between the ini-
-tiator and the responder. This directive is ignored in
-the initiator case. The default value is off.") },
- { label => N("Passive"), val => \$main_remote_section->{4}[1],
- list => [ N_("off"), N_("on") ], format => \&translate,
- help => N("If you do not want to initiate the negotiation, set this
-to on. The default value is off. It is useful for a
-server.") },
- { label => N("Certificate type"), val => \$main_remote_section->{5}[1],
- list => [ 'x509' ], allow_empty_list => 1 },
- { label => N("My certfile"), val => \$main_remote_section->{5}[2], type => 'entry',
- help => N("Name of the certificate") },
- { label => N("My private key"), val => \$main_remote_section->{5}[3], type => 'entry',
- help => N("Name of the private key") },
- { label => N("Peers certfile"), val => \$main_remote_section->{6}[1], type => 'entry',
- help => N("Name of the peers certificate") },
- { label => N("Verify cert"), val => \$main_remote_section->{7}[1],
- list => [ N_("off"), N_("on") ], format => \&translate,
- help => N("If you do not want to verify the peer's certificate for
-some reason, set this to off. The default is on.") },
- { label => N("My identifier"), val => \$main_remote_section->{8}[1], type => 'entry',
- help => N("specifies the identifier sent to the remote host and the
-type to use in the phase 1 negotiation. address, FQDN,
-user_fqdn, keyid and asn1dn can be used as an idtype.
-they are used like:
- my_identifier address [address];
- the type is the IP address. This is the default
- type if you do not specify an identifier to use.
- my_identifier user_fqdn string;
- the type is a USER_FQDN (user fully-qualified
- domain name).
- my_identifier FQDN string;
- the type is a FQDN (fully-qualified domain name).
- my_identifier keyid file;
- the type is a KEY_ID.
- my_identifier asn1dn [string];
- the type is an ASN.1 distinguished name. If
- string is omitted, racoon(8) will get DN from
- Subject field in the certificate.\n
-Examples: \n
-my_identifier user_fqdn \"myemail\@mydomain.com\"") },
- { label => N("Peers identifier"), val => \$main_remote_section->{9}[1], type => 'entry' },
- { label => N("Proposal"), val => \$proposal_remote_section->{1}[0], list => [ 'proposal' ], allow_empty_list => 1 },
- { label => N("Encryption algorithm"), val => \$proposal_remote_section->{2}[1], list => [ qw(des 3des blowfish cast128) ],
- help => N("specify the encryption algorithm used for the
-phase 1 negotiation. This directive must be defined.
-algorithm is one of the following:
-
-DES, 3DES, blowfish, cast128 for oakley.
-
-For other transforms, this statement should not be used.") },
- { label => N("Hash algorithm"), val => \$proposal_remote_section->{3}[1], type => 'entry' },
- { label => N("Authentication method"), val => \$proposal_remote_section->{4}[1], type => 'entry' },
- { label => N("DH group"), val => \$proposal_remote_section->{5}[1], list => [ qw(modp768 modp1024 modp1536 1 2 5) ], },
- ]);
-}
-
-sub ask_info3 {
- my ($title, $text, $section) = @_;
- $in->ask_from($title, $text,,
- [ { label => N("Command"), val => \$section->{command}, list => [ 'spdadd' ], allow_empty_list => 1 },
- { label => N("Source IP range"), val => \$section->{src_range}, type => 'entry' },
- { label => N("Destination IP range"), val => \$section->{dst_range}, type => 'entry' },
- { label => N("Upper-layer protocol"), val => \$section->{upperspec}, list => [ N_("any") ],
- format => \&translate, allow_empty_list => 1 },
- { label => N("Flag"), val => \$section->{flag}, list => [ '-P' ], allow_empty_list => 1 },
- { label => N("Direction"), val => \$section->{direction}, list => [ 'in', 'out' ] },
- { label => N("IPsec policy"), val => \$section->{ipsec}, list => [ N_("ipsec"), N_("discard"), N_("none") ],
- format => \&translate },
- { label => N("Protocol"), val => \$section->{protocol}, list => [ 'esp', 'ah', 'ipcomp' ] },
- { label => N("Mode"), val => \$section->{mode}, list => [ N_("tunnel"), N_("transport"), N_("any") ],
- format => \&translate },
- { label => N("Source/destination"), val => \$section->{src_dest}, type => 'entry' },
- { label => N("Level"), val => \$section->{level}, list => [ N_("require"), N_("default"), N_("use"), N_("unique") ],
- format => \&translate },
- ]);
-}
-
diff --git a/perl-install/standalone/drakxservices b/perl-install/standalone/drakxservices
deleted file mode 100755
index 91317d1f4..000000000
--- a/perl-install/standalone/drakxservices
+++ /dev/null
@@ -1,18 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use interactive;
-use services;
-use log;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/service-mdk.png";
-my $in = 'interactive'->vnew('su');
-begin:
-my $l = services::ask($in);
-services::doit($in, $l) if $l;
-$in->exit(0);
diff --git a/perl-install/standalone/drakxtv b/perl-install/standalone/drakxtv
deleted file mode 100755
index 709c13309..000000000
--- a/perl-install/standalone/drakxtv
+++ /dev/null
@@ -1,151 +0,0 @@
-#!/usr/bin/perl
-# DrakxTV
-# $Id$
-
-# Copyright (C) 2002-2004 Mandrakesoft (tvignaud@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-
-use common;
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use detect_devices;
-use lang;
-use log;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/tv-mdk.png";
-
-my $in = 'interactive'->vnew;
-
-sub scan4channels() {
- # xawtv has been installed by DrakX when/if it's detected a tv
- # card.
-
- $in->do_pkgs->ensure_binary_is_installed('xawtv', 'scantv');
-
- my ($ftable_id, $norm);
- # this table must be checked on each xawtv release:
- my %freqtables =
- ("us-bcast" => N("USA (broadcast)"), "us-cable" => N("USA (cable)"), "us-cable-hrc" => N("USA (cable-hrc)"), "canada-cable" => N("Canada (cable)"),
- "japan-bcast" => N("Japan (broadcast)"), "japan-cable" => N("Japan (cable)"), "china-bcast" => N("China (broadcast)"),
- "europe-west" => N("West Europe"), "europe-east" => N("East Europe"), "italy" => N("Italy"), "ireland" => N("Ireland"), "france" => N("France [SECAM]"),
- "newzealand" => N("Newzealand"), "australia" => N("Australia"),
- "southafrica" => N("South Africa"),
- "argentina" => N("Argentina"),
- "australia-optus" => N("Australian Optus cable TV"),
- -1 => N("All")
- );
- # Info: HRC means "Harmonically Related Carrier"
-
- my %countries =
- (
- "AR" => [ "argentina" ],
- "AU" => [ "australia" ],
- "FR" => [ "france", "SECAM" ],
- "CA" => [ "canada-cable", "NTSC" ],
- "IE" => [ "ireland" ],
- "IT" => [ "italy" ],
- "JP" => [ "japan-bcast", "NTSC-JP" ],
- "NZ" => [ "newzealand" ],
- "AT|BE|CH|DE|ES|GB|SE" => [ "europe-west" ],
- "US" => [ "us-bcast", "NTSC" ],
- "ZA" => [ "southafrica" ],
- "CN|TW" => [ "china-bcast" ]
- );
-
- my $tbl;
- my $locale = lang::read($>);
- $locale->{country} =~ /$_/ and $tbl = $countries{$_} foreach keys %countries;
- if ($tbl) {
- $ftable_id = $tbl->[0];
- $norm = $tbl->[1] if $tbl->[1];
- }
- # default to pal since most people use that
- $norm ||= "PAL";
- log::l("[drakxtv] guess country=>$locale->{country}, norm=>$norm, area=>$ftable_id");
- my %users = map { $_->[6] || $_->[0] => $_->[7] } grep { $_->[2] == 0 || 500 <= $_->[2] } list_passwd();
- my $user;
-
- if ($in->ask_from("TVdrake", N("Please,\ntype in your tv norm and country"),
- [
- { label => N("TV norm:"), val => \$norm, list => [ "NTSC", "NTSC-JP", "PAL", "PAL-M", "PAL-N", "PAL-NC", "SECAM" ], type => 'combo' },
- { label => N("Area:"), val => \$ftable_id, list => [keys %freqtables], format => sub { $freqtables{$_[0]} }, sort => 1 },
- { label => N("User:"), val => \$user, list => [ keys %users ], sort => 1 },
- ]
- )) {
- my $_wait = $in->wait_message(N("Please wait"),
- N("Scanning for TV channels in progress..."));
- # we provide scantv a bogus table (france) which will
- # will be ignored since "All" is selected (because of -a)
- $ftable_id = "france -a " if $ftable_id eq -1;
- # Note that this'll be broken if/when we implement interactive::qt
- my $use_X = $in->isa('interactive::gtk') && -x "/usr/X11R6/bin/xvt";
- my $home = $users{$user}; #ENV{HOME};
- my $is_bttv_loaded = cat_("/proc/modules");
- # workaround non loaded bttv
- run_program::run('/sbin/modprobe', 'bttv') if $< == 0 && $is_bttv_loaded !~ /bttv/;
- my $i = system(($use_X ? "xvt -T '" . N("Scanning for TV channels") . " ...' -e " : "") .
- "scantv -n $norm -C /dev/v4l/vbi$::i -c /dev/v4l/video$::i -f $ftable_id -o $home/.xawtv" .
- ($use_X ? "" : " &>$home/tmp/scantv.log;"));
- if ($i) {
- $in->ask_warn(N("Error"), N("There was an error while scanning for TV channels"));
- } else {
- log::explanations("created file $home/.xawtv");
- $in->ask_warn(N("Have a nice day!"),
- N("Now, you can run xawtv (under X Window!) !\n")) unless $use_X;
- }
- }
-}
-
-my @devices = detect_devices::getTVcards();
-push @devices, { driver => 'bttv', description => 'dummy' } if $::testing && !@devices;
-if (@devices) {
- my $not_canceled = 1;
- my $modules_conf;
- # TODO: That need some work for multiples TV cards
- each_index {
- if (($< == 0 || $::testing) && (grep { detect_devices::isTVcard($_) } @devices)) {
- require harddrake::v4l;
- require modules;
-
- $modules_conf ||= modules::any_conf->read;
- $not_canceled &&= harddrake::v4l::config($in, $modules_conf, $_->{driver});
- $modules_conf->write;
- }
- scan4channels() if $not_canceled;
- } @devices
-} else {
- $in->ask_warn(N("No TV Card detected!"), formatAlaTeX(
- #-PO: keep the double empty lines between sections, this is formatted a la LaTeX
- N("No TV Card has been detected on your machine. Please verify that a Linux-supported Video/TV Card is correctly plugged in.
-
-
-You can visit our hardware database at:
-
-
-http://www.linux-mandrake.com/en/hardware.php3")));
-}
-$in->exit(0) if defined $in;
-
-
-# TODO:
-# - offer to sort channels after
-# - use Video-Capture-V4l-0.221 ?
-# - configure kwintv and zapping ? => they've already wizards :-(
-# - install xawtv if needed through consolhelper
diff --git a/perl-install/standalone/fileshareset b/perl-install/standalone/fileshareset
deleted file mode 100755
index 6d321c7ac..000000000
--- a/perl-install/standalone/fileshareset
+++ /dev/null
@@ -1,384 +0,0 @@
-#!/usr/bin/perl -T
-use strict;
-
-########################################
-# config files
-$nfs_exports::default_options = '*(ro,all_squash,sync)';
-$nfs_exports::conf_file = '/etc/exports';
-$smb_exports::conf_file = '/etc/samba/smb.conf';
-my $authorisation_file = '/etc/security/fileshare.conf';
-my $authorisation_group = 'fileshare';
-
-
-########################################
-# fileshare utility $Id$
-# Copyright (C) 2001-2004 Mandrakesoft (pixel@mandrakesoft.com)
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
-########################################
-my $uid = $<;
-my $username = getpwuid($uid);
-
-########################################
-# errors
-my $usage =
-"usage: fileshareset --add <dir>
- fileshareset --remove <dir>";
-my $non_authorised =
-qq(You are not authorised to use fileshare'ing
-To grant you the rights:
-- put "RESTRICT=no" in $authorisation_file
-- or put user "$username" in group "$authorisation_group");
-my $no_export_method = "can't export anything: no nfs, no smb";
-
-my %exit_codes = reverse(
- 1 => $non_authorised,
- 2 => $usage,
-
-# when adding
- 3 => "already exported",
- 4 => "invalid mount point",
-
-# when removing
- 5 => "not exported",
-
- 6 => $no_export_method,
-
- 255 => "various",
-);
-
-################################################################################
-# correct PATH needed to call /etc/init.d/... ? seems not, but...
-%ENV = ();#(PATH => '/bin:/sbin:/usr/bin:/usr/sbin');
-
-my $modify = $0 =~ /fileshareset/;
-
-authorisation::check($modify);
-
-my @exports = (
- -e $nfs_exports::conf_file ? nfs_exports::read() : (),
- -e $smb_exports::conf_file ? smb_exports::read() : (),
- );
-@exports or error($no_export_method);
-
-if ($modify) {
- my ($cmd, $dir) = @ARGV;
- $< = $>;
- @ARGV == 2 && ($cmd eq '--add' || $cmd eq '--remove') or error($usage);
-
- verify_mntpoint($dir);
-
- if ($cmd eq '--add') {
- my @errs = map { eval { $_->add($dir) }; $@ } @exports;
- grep { !$_ } @errs or error("already exported");
- } else {
- my @errs = map { eval { $_->remove($dir) }; $@ } @exports;
- grep { !$_ } @errs or error("not exported");
- }
- foreach my $export (@exports) {
- $export->write;
- $export->update_server;
- }
-}
-my @mntpoints = grep { $_ } uniq(map { map { $_->{mntpoint} } @$_ } @exports);
-print "$_\n" foreach grep { own($_) } @mntpoints;
-
-
-sub own { $uid == 0 || (stat($_[0]))[4] == $uid }
-
-sub verify_mntpoint {
- local ($_) = @_;
- my $ok = 1;
- $ok &&= m|^/|;
- $ok &&= !m|\Q/../|;
- $ok &&= !m|[\0\n\r]|;
- $ok &&= -d $_;
- $ok &&= own($_);
- $ok or error("invalid mount point");
-}
-
-sub error {
- my ($string) = @_;
- print STDERR "$string\n";
- exit($exit_codes{$string} || 255);
-}
-sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
-sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
-
-
-################################################################################
-package authorisation;
-
-my $F_lock;
-sub read_conf {
- my ($exclusive_lock) = @_;
- open $F_lock, $authorisation_file; # don't care if it's missing
- flock($F_lock, $exclusive_lock ? 2 : 1) or die "can't lock";
- my %conf;
- foreach (<$F_lock>) {
- s/#.*//; # remove comments
- s/^\s+//;
- s/\s+$//;
- /^$/ and next;
- my ($cmd, $value) = split('=', $_, 2);
- $conf{$cmd} = $value || warn qq(suspicious line "$_" in $authorisation_file\n);
- }
- # no close $F_lock, keep it locked
- \%conf
-}
-
-sub check {
- my ($exclusive_lock) = @_;
- my $conf = read_conf($exclusive_lock);
-
- if (lc($conf->{RESTRICT}) eq 'no') {
- # ok, access granted for everybody
- } else {
- my @l;
- while (@l = getgrent) {
- last if $l[0] eq $authorisation_group;
- }
- ::member($username, split(' ', $l[3])) or ::error($non_authorised);
- }
-}
-
-################################################################################
-package exports;
-
-sub find {
- my ($exports, $mntpoint) = @_;
- foreach (@$exports) {
- $_->{mntpoint} eq $mntpoint and return $_;
- }
- undef;
-}
-
-sub add {
- my ($exports, $mntpoint) = @_;
- foreach (@$exports) {
- $_->{mntpoint} eq $mntpoint and die 'add';
- }
- push @$exports, my $e = { mntpoint => $mntpoint };
- $e;
-}
-
-sub remove {
- my ($exports, $mntpoint) = @_;
- my @l = grep { $_->{mntpoint} ne $mntpoint } @$exports;
- @l < @$exports or die 'remove';
- @$exports = @l;
-}
-
-
-################################################################################
-package nfs_exports;
-
-use vars qw(@ISA $conf_file $default_options);
-BEGIN { @ISA = 'exports' }
-
-sub read() {
- my $file = $conf_file;
- open(my $F, $file) or return [];
-
- my ($prev_raw, $prev_line, @l);
- my $line_nb = 0;
- foreach my $raw (<$F>) {
- $line_nb++;
- local $_ = $raw;
- $raw .= "\n" if !/\n/;
-
- s/#.*//; # remove comments
-
- s/^\s+//;
- s/\s+$//; # remove unuseful spaces to help regexps
-
- if (/^$/) {
- # blank lines ignored
- $prev_raw .= $raw;
- next;
- }
-
- if (/\\$/) {
- # line continue across lines
- chop; # remove the backslash
- $prev_line .= "$_ ";
- $prev_raw .= $raw;
- next;
- }
- my $line = $prev_line . $_;
- my $raw_line = $prev_raw . $raw;
- ($prev_line, $prev_raw) = ('', '');
-
- my ($mntpoint, $options) = $line =~ /("[^"]*"|\S+)\s+(.*)/ or die "$file:$line_nb: bad line $line\n";
-
- # You can also specify spaces or any other unusual characters in the
- # export path name using a backslash followed by the character code as
- # 3 octal digits.
- $mntpoint =~ s/\\(\d{3})/chr(oct $1)/ge;
-
- # not accepting weird characters that would break the output
- $mntpoint =~ m/[\0\n\r]/ and die "i won't handle this";
- push @l, { mntpoint => $mntpoint, option => $options, raw => $raw_line };
- }
- bless \@l, 'nfs_exports';
-}
-
-sub write {
- my ($nfs_exports) = @_;
- foreach (@$nfs_exports) {
- if (!exists $_->{options}) {
- $_->{options} = $default_options;
- }
- if (!exists $_->{raw}) {
- my $mntpoint = $_->{mntpoint} =~ /\s/ ? qq("$_->{mntpoint}") : $_->{mntpoint};
- $_->{raw} = sprintf("%s %s\n", $mntpoint, $_->{options});
- }
- }
- open(my $F, ">$conf_file") or die "can't write $conf_file";
- print $F $_->{raw} foreach @$nfs_exports;
-}
-
-sub update_server() {
- if (fork()) {
- system('/usr/sbin/exportfs', '-r');
- if (system('/sbin/pidof rpc.mountd >/dev/null') != 0 ||
- system('/sbin/pidof nfsd >/dev/null') != 0) {
- # trying to start the server...
- system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status >/dev/null') != 0;
- system('/etc/init.d/nfs', $_) foreach 'stop', 'start';
- }
- exit 0;
- }
-}
-
-################################################################################
-package smb_exports;
-
-use vars qw(@ISA $conf_file);
-BEGIN { @ISA = 'exports' }
-
-sub read() {
- my ($s, @l);
- open(my $F, $conf_file);
- local $_;
- while (<$F>) {
- if (/^\s*\[.*\]/ || eof $F) {
- #- first line in the category
- my ($label) = $s =~ /^\s*\[(.*)\]/;
- my ($mntpoint) = $s =~ /^\s*path\s*=\s*(.*)/m;
- push @l, { mntpoint => $mntpoint, raw => $s, label => $label };
- $s = '';
- }
- $s .= $_;
- }
- bless \@l, 'smb_exports';
-}
-
-sub write {
- my ($smb_exports) = @_;
- foreach (@$smb_exports) {
- if (!exists $_->{raw}) {
- $_->{raw} = <<EOF;
-
-[$_->{label}]
- path = $_->{mntpoint}
- comment = $_->{mntpoint}
- public = yes
- guest ok = yes
- writable = no
- wide links = no
-EOF
- }
- }
- open(my $F, ">$conf_file") or die "can't write $conf_file";
- print $F $_->{raw} foreach @$smb_exports;
-}
-
-sub add {
- my ($exports, $mntpoint) = @_;
- my $e = $exports->exports::add($mntpoint);
- $e->{label} = name_mangle($mntpoint, map { $_->{label} } @$exports);
-}
-
-sub name_mangle {
- my ($input, @others) = @_;
-
- local $_ = $input;
-
- # 1. first only keep legal characters. "/" is also kept for the moment
- tr|a-z|A-Z|;
- s|[^A-Z0-9#\-_!/]|_|g; # "$" is allowed except at the end, remove it in any case
-
- # 2. removing non-interesting parts
- s|^/||;
- s|^home/||;
- s|_*/_*|/|g;
- s|_+|_|g;
-
- # 3. if size is too small (!), make it bigger
- $_ .= "_" while length($_) < 3;
-
- # 4. if size is too big, shorten it
- while (length > 12) {
- my ($s) = m|.*?/(.*)|;
- if (length($s) > 8 && !grep { /\Q$s/ } @others) {
- # dropping leading directories when the resulting is still long and meaningful
- $_ = $s;
- } else {
- s|(.*)[0-9#\-_!/]|$1|
- # inspired by "Christian Brolin" "Long names are doom" on comp.lang.functional
- || s|(.+)[AEIOU]|$1|# allButFirstVowels
- || s|(.*)(.)\2|$1$2| # adjacentDuplicates
- || s|(.*).|$1|; # booh, :'-(
- }
- }
-
- # 5. remove "/"s still there
- s|/|_|g;
-
- # 6. resolving conflicts
- my $l = join("|", map { quotemeta } @others);
- my $conflicts = qr|^($l)$|;
- if (/$conflicts/) {
- A: while (1) {
- for (my $nb = 1; length("$_$nb") <= 12; $nb++) {
- if ("$_$nb" !~ /$conflicts/) {
- $_ = "$_$nb";
- last A;
- }
- }
- $_ or die "can't find a unique name";
- # can't find a unique name, dropping the last letter
- s|(.*).|$1|;
- }
- }
-
- # 7. done
- $_;
-}
-
-sub update_server() {
- if (fork()) {
- system('/usr/bin/killall -HUP smbd 2>/dev/null');
- if (system('/sbin/pidof smbd >/dev/null') != 0 ||
- system('/sbin/pidof nmbd >/dev/null') != 0) {
- # trying to start the server...
- system('/etc/init.d/smb', $_) foreach 'stop', 'start';
- }
- exit 0;
- }
-}
diff --git a/perl-install/standalone/harddrake2 b/perl-install/standalone/harddrake2
deleted file mode 100755
index 4e26beed9..000000000
--- a/perl-install/standalone/harddrake2
+++ /dev/null
@@ -1,529 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use diagnostics;
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-use common;
-
-use ugtk2 qw(:create :helpers :wrappers);
-use interactive;
-use harddrake::data; #- needs to stay after use-ugtk2 as long as this module defines globals containing some N()
-use POSIX qw(:sys_wait_h);
-
-
-# { field => [ short_translation, full_description] }
-my %fields =
- (
- generic =>
- {
- "alternative_drivers" => [ N("Alternative drivers"),
- N("the list of alternative drivers for this sound card") ],
- "bus" =>
- [ N("Bus"),
- N("this is the physical bus on which the device is plugged (eg: PCI, USB, ...)") ],
- "bus_id" =>
- [ N("Bus identification"),
- N("- PCI and USB devices: this lists the vendor, device, subvendor and subdevice PCI/USB ids") ],
- "bus_location" =>
- [ N("Location on the bus"),
- N("- pci devices: this gives the PCI slot, device and function of this card
-- eide devices: the device is either a slave or a master device
-- scsi devices: the scsi bus and the scsi device ids") ],
- "capacity" => [ N("Drive capacity"), N("special capacities of the driver (burning ability and or DVD support)") ],
- "description" => [ N("Description"), N("this field describes the device") ],
- "device" => [ N("Old device file"),
- N("old static device name used in dev package") ],
- "devfs_device" => [ N("New devfs device"),
- N("new dynamic device name generated by core kernel devfs") ],
- "driver" => [
- #-PO: here "module" is the "jargon term" for a kernel driver
- N("Module"), N("the module of the GNU/Linux kernel that handles the device") ],
- "extended_partitions" => [ N("Extended partitions"), N("the number of extended partitions") ],
- "geometry" => [ N("Geometry"), N("Cylinder/head/sectors geometry of the disk") ],
- "host" => [ N("Disk controller"), N("the disk controller on the host side") ],
- "media_type" => [ N("Media class"), N("class of hardware device") ],
- "Model" => [ N("Model"), N("hard disk model") ],
- "port" => [ N("Port"), N("network printer port") ],
- "primary_partitions" => [ N("Primary partitions"), N("the number of the primary partitions") ],
- "Vendor" => [ N("Vendor"), N("the vendor name of the device") ],
- "pci_bus" => [ N("Bus PCI #"), N("the PCI bus on which the device is plugged") ],
- "pci_device" => [ N("PCI device #"), N("PCI device number") ],
- "pci_function" => [ N("PCI function #"), N("PCI function number") ],
- "vendor" => [ N("Vendor ID"), N("this is the standard numerical identifier of the vendor") ],
- "id" => [ N("Device ID"), N("this is the numerical identifier of the device") ],
- "subvendor" => [ N("Sub vendor ID"), N("this is the minor numerical identifier of the vendor") ],
- "subid" => [ N("Sub device ID"), N("this is the minor numerical identifier of the device") ],
- "usb_pci_device" =>, [ N("Device USB ID"), N("..") ],
- },
- CPU =>
- {
- "bogomips" => [ N("Bogomips"), N("the GNU/Linux kernel needs to run a calculation loop at boot time to initialize a timer counter. Its result is stored as bogomips as a way to \"benchmark\" the cpu.") ],
- "cache size" => [ N("Cache size"), N("size of the (second level) cpu cache") ],
- "coma_bug" => [
- #-PO: here "comas" is the medical coma, not the lexical coma!!
- N("Coma bug"), N("whether this cpu has the Cyrix 6x86 Coma bug") ],
- "cpu family" => [ N("Cpuid family"), N("family of the cpu (eg: 6 for i686 class)") ],
- "cpuid level" => [ N("Cpuid level"), N("information level that can be obtained through the cpuid instruction") ],
- "cpu MHz" => [ N("Frequency (MHz)"), N("the CPU frequency in MHz (Megahertz which in first approximation may be coarsely assimilated to number of instructions the cpu is able to execute per second)") ],
- "flags" => [ N("Flags"), N("CPU flags reported by the kernel") ],
- "fdiv_bug" => [ N("Fdiv bug"),
- N("Early Intel Pentium chips manufactured have a bug in their floating point processor which did not achieve the required precision when performing a Floating point DIVision (FDIV)") ],
- "fpu" => [ N("Is FPU present"), N("yes means the processor has an arithmetic coprocessor") ],
- "fpu_exception" => [ N("Whether the FPU has an irq vector"), N("yes means the arithmetic coprocessor has an exception vector attached") ],
- "f00f_bug" => [ N("F00f bug"), N("early pentiums were buggy and freezed when decoding the F00F bytecode") ],
- "hlt_bug" => [ N("Halt bug"),
- N("Some of the early i486DX-100 chips cannot reliably return to operating mode after the \"halt\" instruction is used") ],
- "level" => [ N("Level"), N("sub generation of the cpu") ],
- "model" => [ N("Model"), N("generation of the cpu (eg: 8 for Pentium III, ...)") ],
- "model name" => [ N("Model name"), N("official vendor name of the cpu") ],
- "name" => [ N("Name"), N("the name of the CPU") ],
- "processor" => [ N("Processor ID"), N("the number of the processor") ],
- "stepping" => [ N("Model stepping"), N("stepping of the cpu (sub model (generation) number)") ],
- "vendor_id" => [ N("Vendor"), N("the vendor name of the processor") ],
- "wp" => [ N("Write protection"), N("the WP flag in the CR0 register of the cpu enforce write protection at the memory page level, thus enabling the processor to prevent unchecked kernel accesses to user memory (aka this is a bug guard)") ],
- },
- FLOPPY =>
- {
- info => [ N("Floppy format"), N("format of floppies supported by the drive") ],
- },
- HARDDISK =>
- {
- channel => [ N("Channel"), N("EIDE/SCSI channel") ],
- info => [ N("Disk identifier"), N("usually the disk serial number") ],
- lun => [ N("Logical unit number"), N("the SCSI target number (LUN). SCSI devices connected to a host are uniquely identified by a
-channel number, a target id and a logical unit number") ],
- },
- MEMORY =>
- {
- 'Installed Size' => [ N("Installed size"), N("Installed size of the memory bank") ],
- 'Enabled Size' => [ N("Enabled Size"), N("Enabled size of the memory bank") ],
- 'name' => [ N("Type"), N("tyme of the memory device") ],
- 'Current Speed' => [ N("Speed"), N("Speed of the memory bank") ],
- 'Bank Connections' => [ N("Bank connections"), '' ],
- 'Socket Designation' => [ N("Name"), N("Socket designation of the memory bank") ],
- },
- MOUSE =>
- {
- "device" => [ N("Device file"), N("the device file used to communicate with the kernel driver for the mouse") ],
- EMULATEWHEEL => [ N("Emulated wheel"), N("whether the wheel is emulated or not") ],
- MOUSETYPE => [ N("Type"), N("the type of the mouse") ],
- name => [ N("Name"), N("the name of the mouse") ],
- nbuttons => [ N("Number of buttons"), N("the number of buttons the mouse has") ],
- type => [ N("Bus"), N("the type of bus on which the mouse is connected") ],
- XMOUSETYPE => [ N("Mouse protocol used by X11"), N("the protocol that the graphical desktop use with the mouse") ],
- }
- );
-
-my %groups = (
- generic =>
- {
- N("Identification") => [ qw(Vendor model description info media_type) ],
- N("Connection") => [ qw(bus pci_bus pci_device pci_function vendor id subvendor subid) ],
- },
- AUDIO =>
- {
- N("Driver") => [ qw(driver alternative_drivers) ],
- },
- CPU =>
- {
- N("Identification") => [ qw(processor vendor_id), "model name", "cpu family", qw(model level stepping) ],
- N("Performances") => [ "cpu MHz", "cache size", "bogomips" ],
- N("Bugs") => [ qw(fdiv_bug coma_bug f00f_bug hlt_bug) ],
- N("FPU") => [ qw(fpu fpu_exception) ],
- },
- HARDDISK =>
- {
- N("Identification") => [ qw(Vendor Model description info media_type) ],
- N("Connection") => [ qw(bus channel lun) ],
- N("Bus identification") => [ qw(vendor id subvendor subid) ],
- N("Device") => [ qw(device devfs_device) ],
- N("Partitions") => [ qw(primary_partitions extended_partitions) ],
- },
- MOUSE =>
- {
- N("Identification") => [ qw(name type MOUSETYPE XMOUSETYPE) ],
- N("Features") => [ qw(EMULATEWHEEL nbuttons) ],
- },
- );
-
-foreach my $class (qw(BURNER CDROM DVDROM)) {
- $groups{$class} = $groups{HARDDISK};
- $fields{$class} = $fields{HARDDISK};
-}
-
-
-my ($in, $pid, $w);
-
-my (%options, %check_boxes);
-my $conffile = "/etc/sysconfig/harddrake2/ui.conf";
-
-my ($current_device, $current_class, $current_configurator);
-
-my %sysh = distrib();
-my $distro_name = $sysh{system};
-
-my %menus = (
- 'options' =>
- #-PO: please keep all "/" characters !!!
- N("/_Options"),
- 'help' => N("/_Help")
- );
-
-my %menu_options = (
- 'PRINTERS_DETECTION' => [ $menus{options}, N("/Autodetect _printers") ],
- 'MODEMS_DETECTION' => [ $menus{options}, N("/Autodetect _modems") ],
- 'JAZZ_DETECTION' => [ $menus{options}, N("/Autodetect _jaz drives") ],
- );
-
-
-my @menu_items =
- (
- [ N("/_File"), undef, undef, undef, '<Branch>' ],
- [ N("/_File") . N("/_Quit"), N("<control>Q"), \&quit_global, undef, '<StockItem>', 'gtk-quit' ],
- [ join('', @{$menu_options{PRINTERS_DETECTION}}), undef,
- sub { $options{PRINTERS_DETECTION} = $check_boxes{PRINTERS_DETECTION}->get_active }, undef, '<CheckItem>' ],
- [ join('', @{$menu_options{MODEMS_DETECTION}}), undef,
- sub { $options{MODEMS_DETECTION} = $check_boxes{MODEMS_DETECTION}->get_active }, undef, '<CheckItem>' ],
- [ join('', @{$menu_options{JAZZ_DETECTION}}), undef,
- sub { $options{JAZZ_DETECTION} = $check_boxes{JAZZ_DETECTION}->get_active }, undef, '<CheckItem>' ],
- [ $menus{help}, undef, undef, undef, '<Branch>' ],
- if_(-x "/usr/sbin/drakhelp_inst",
- [ $menus{help} . N("/_Help"), undef, sub { unless (fork()) { exec("drakhelp --id harddrake") } }, undef, '<Item>' ],
- ),
- [ $menus{help} . N("/_Fields description"), undef, sub {
- if ($current_device) {
- create_dialog(N("Harddrake help"),
- N("Description of the fields:\n\n")
- . join("\n\n", map {
- my $info = lookup_field($_);
- if_($info->[0], formatAlaTeX(qq(<span foreground="royalblue3">$info->[0]:</span> $info->[1])))
- } sort keys %$current_device),
- { use_markup => 1, if_(!$::isEmbedded, transient => $w->{window}), height => 400, scroll => 1 })
-
- } else {
- create_dialog(N("Select a device!"), N("Once you've selected a device, you'll be able to see the device information in fields displayed on the right frame (\"Information\")"), { if_(!$::isEmbedded, transient => $w->{window}) })
- }
- },
- undef, '<Item>'
- ],
- if_(!-e "/etc/sysconfig/oem",
- [ $menus{help} . N("/_Report Bug"), undef, sub { unless (fork()) { exec("drakbug --report harddrake2 &") } }, undef, '<Item>' ],
- ),
- [ $menus{help} . N("/_About..."), undef, sub {
- create_dialog(N("About Harddrake"),
-#-PO: Do not alter the <span ..> and </span> tags
- N("This is HardDrake, a %s hardware configuration tool.\n<span foreground=\"royalblue3\">Version:</span> %s
-<span foreground=\"royalblue3\">Author:</span> Thierry Vignaud &lt;tvignaud\@mandrakesoft.com&gt;\n\n", $distro_name, $harddrake::data::version) . "\n" .
- formatAlaTeX($::license), { use_markup => 1, if_(!$::isEmbedded, transient => $w->{window}) });
- }, undef, '<Item>'
- ]
- );
-
-$ugtk2::wm_icon = "harddrake";
-$in = 'interactive'->vnew('su'); #require_root_capability();
-
-my $wait = $in->wait_message(N("Please wait"), N("Detection in progress"));
-gtkflush();
-
-%options = getVarsFromSh($conffile);
-
-# Build the gui
-add_icon_path('/usr/share/pixmaps/harddrake2/');
-$w = ugtk2->new(N("Harddrake2"));
-local $::main_window; # fake diagnostics pragma
-my ($menubar, $factory, $opt_menu, $help_menu);
-if ($::isEmbedded) {
- ($menubar, $factory) = create_factory_popup_menu($::Plug, @menu_items);
- $opt_menu = $factory->get_widget("<main>" . strip_first_underscore($menus{options}));
- $help_menu = $factory->get_widget("<main>" . strip_first_underscore($menus{help}));
-} else {
- $::main_window = $w->{rwindow};
- ($menubar, $factory) = create_factory_menu($w->{rwindow}, @menu_items);
- $w->{window}->set_size_request(805, 550);
-}
-
-my $tree_model = Gtk2::TreeStore->new("Gtk2::Gdk::Pixbuf", "Glib::String", "Glib::Int");
-$w->{window}->add(gtkpack_(0, Gtk2::VBox->new(0, 0),
- if_(!$::isEmbedded, 0, $menubar),
- 1, create_hpaned(gtkadd(Gtk2::Frame->new(N("Detected hardware")),
- create_scrolled_window(gtkset_size_request(my $tree = Gtk2::TreeView->new_with_model($tree_model), $::isEmbedded ? 250 : 350, -1), ['automatic', 'automatic'])),
- gtkpack_(0, Gtk2::VBox->new(0, 0),
- 1, gtkadd(my $frame = Gtk2::Frame->new(N("Information")),
- create_scrolled_window(my $text = Gtk2::TextView->new)),
- 0, my $module_cfg_button = gtksignal_connect(Gtk2::Button->new(N("Configure module")),
- clicked => sub {
- local $SIG{CHLD} = undef;
- require modules::interactive;
- modules::interactive::config_window($in, $current_device);
- gtkset_mousecursor_normal();
- }),
- 0, my $config_button = gtksignal_connect(Gtk2::Button->new(N("Run config tool")),
- # we've a configurator, let's add a button for it and show it
- clicked => sub {
- return 1 if defined $pid;
- if ($pid = fork()) {
- } else {
- exec($current_configurator) or die "$current_configurator missing\n";
- }
- })
- ),
- ),
- if_($::isEmbedded,
- 0,
- gtkpack(Gtk2::HBox->new,
- gtkpack(create_hbox('start'),
- gtksignal_connect(Gtk2::Button->new(N("Help")), event => popup_menu($help_menu), $menubar),
- gtksignal_connect(Gtk2::Button->new(N("Options")), event => popup_menu($opt_menu), $menubar),
- ),
- gtkpack(create_hbox('end'),
- gtksignal_connect(Gtk2::Button->new(N("Quit")), clicked => \&quit_global),
- ),
- ),
- )
- )
- );
-
-$text->set_wrap_mode('word');
-$frame->set_size_request(300, 450) unless $::isEmbedded;
-# $tree->set_column_auto_resize(0, 1);
-my (@data, @configurators);
-$tree->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererPixbuf->new, 'pixbuf' => 0));
-$tree->append_column(my $textcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 1));
-$tree->set_headers_visible(0);
-$tree->get_selection->signal_connect('changed' => sub {
- my ($select) = @_;
- my ($model, $iter) = $select->get_selected;
- if ($model) {
- my $idx = $model->get($iter, 2);
- ($current_device, $current_class) = @{$data[$idx]};
-
- if ($idx ne -1) {
- use Gtk2::Pango;
- my %device_fields = map {
- # The U+200E character is to force LTR display, as what what follows the colon is always in LTR (device names, paths, etc),
- # this ensures proper displaying of names like /dev/fd0 (otherwise it gets 'dev/fd0/').
- # it must come *after* the space, as the space must follow the colon following the direction of writting.
- my $field = lookup_field($_);
- if_($_ && $field->[0], $_ =>
- [
- [ $field->[0] . ": \x{200e}", { 'foreground' => 'royalblue3', 'weight' => Gtk2::Pango->PANGO_WEIGHT_BOLD } ],
- [ ($current_device->{$_} =~ /^(unknown)/ ? N("unknown") :
- $current_device->{$_} =~ /^(Unknown)/ ? N("Unknown") :
- $current_device->{$_} eq 'yes' ? N("Yes") :
- $current_device->{$_} eq 'no' ? N("No") :
- $current_device->{$_}) . "\n\n", if_($_ eq 'driver' && $current_device->{$_} =~ /^unknown|^Bad:/, { foreground => 'indian red' }) ]
- ])
- } sort keys %$current_device;
- my %groups = map { if_(ref $groups{$_}, %{$groups{$_}}) } 'generic', $current_class;
- my ($grouped, $ungrouped) = partition {
- my $field = $_;
- member($field, map { @$_ } values %groups);
- } keys %device_fields;
- my @formated;
- foreach my $group (N("Identification"), grep { $_ ne N("Identification") } keys %groups) {
- my @fields = @{$groups{$group}};
- # have we at least a member in that group?
- next unless any { member($_, @fields) } @$grouped;
-
- push @formated, titleFormat($group);
- push @formated, map { if_(ref $_, @$_) } @device_fields{@fields};
- };
- push @formated, if_(@formated && @$ungrouped, titleFormat(N("Misc"))), map { @{$device_fields{$_}} } @$ungrouped;
- gtktext_insert($text, \@formated);
-
- foreach (keys %$current_device) {
- print qq(Warning: skip "$_" field => "$current_device->{$_}"\n\n) unless (lookup_field($_))[0];
- };
-
- # if we've valid driver, let's offer to configure it, else hide buttons
- show_hide(defined($current_device->{driver}) && $current_device->{driver} !~ /^unknown|^Bad|^Card|^Hsf|^Removable:|\|/, $module_cfg_button);
-
- $current_configurator = $configurators[$idx];
- show_hide($current_configurator && -x first(split /\s+/, $current_configurator), $config_button); # strip arguments for -x test
- return 1;
- }
- }
- $text->get_buffer->set_text(N("Click on a device in the left tree in order to display its information here."));
- undef $current_device;
- $config_button->hide;
- $module_cfg_button->hide;
-});
-
-my $index = 0;
-
-my @classes;
-
-# Fill the graphic devices tree with a "tree branch" widget per device category
-foreach my $hw_class (@harddrake::data::tree) {
- my ($Ident, $title, $icon, $configurator, $detector) = @$hw_class{qw(class string icon configurator detector)};
- next if ref($detector) ne "CODE"; #skip class witouth detector
- # blacklist agp controllers b/c string is not yet translated:
- next if $Ident eq 'AGP';
- next if $Ident =~ /(MODEM|PRINTER)/ && $::testing;
- next if $Ident =~ /JAZZ/ && !$options{JAZZ_DETECTION};
- next if $Ident =~ /MODEM/ && !$options{MODEMS_DETECTION};
- next if $Ident =~ /PRINTER/ && !$options{PRINTERS_DETECTION};
-
- my @devices = &$detector;
- next unless @devices; # Skip empty class (no devices)
- push @classes, [ $Ident, $title, $icon, $configurator, @devices ];
-}
-
-# Fill the graphic devices tree with a "tree branch" widget per device category
-foreach (@classes) {
- my ($Ident, $title, $icon, $configurator, @devices) = @$_;
-
- my $parent_iter = $tree_model->append_set(undef, [ 0 => gtkcreate_pixbuf($icon), 1 => $title, 2 => -1 ]);
-
- my $all_hds;
- $all_hds = fsedit::get_hds() if $Ident eq "HARDDISK";
-
- # Fill the graphic tree with a "tree leaf" widget per device
- foreach (@devices) {
- # we really should test for $title there:
- if ($_->{bus} && $_->{bus} eq "PCI") {
- # do not display unknown driver for system bridges that're managed by kernel core:
- delete $_->{driver} if $_->{driver} eq "unknown" && ($Ident =~ /^ATA_STORAGE|BRIDGE|SMB_CONTROLLER$/ || $_->{description} =~ /3Com.*5610/);
- }
- rename_field($_, 'usb_description', 'description');
- # split description into manufacturer/description
- ($_->{Vendor}, $_->{description}) = split(/\|/, $_->{description}) if $_->{description};
-
- if ($_->{val}) { # Scanner ?
- my $val = $_->{val};
- ($_->{Vendor}, $_->{description}) = split(/\|/, $val->{DESCRIPTION});
- }
- # EIDE detection incoherency:
- if ($_->{bus} && $_->{bus} eq 'ide') {
- $_->{channel} = $_->{channel} ? N("secondary") : N("primary");
- delete $_->{info} if $_->{Vendor};
- }
- if (defined $_->{capacity}) {
- my ($burner, $dvd) = (N("burner"), N("DVD"));
- $_->{capacity} =~ s/burner/$burner/;
- $_->{capacity} =~ s/DVD/$dvd/;
- }
- $configurator .= harddrake::data::set_removable_configurator($Ident, $_);
- if ($Ident eq "AUDIO") {
- require harddrake::sound;
- my $alter = harddrake::sound::get_alternative($_->{driver});
- if (my $alternative_drivers = $alter->[0] ne 'unknown' && join(', ', @$alter)) {
- $_->{alternative_drivers} = $alternative_drivers;
- }
- }
- if ($Ident eq "HARDDISK") {
- my $hd = $_;
- my $info = find { $_->{device} eq $hd->{device} } @{$all_hds->{hds}};
- $hd->{geometry} = join('/', map { $info->{geom}{$_} } qw(cylinders heads sectors)) . " (CHS)";
- $hd->{primary_partitions} = @{$info->{primary}{normal}};
- $hd->{extended_partitions} = @{$info->{extended}};
- $hd->{primary_partitions} .= " (" . join(', ', map { $_->{device} }@{$info->{primary}{normal}}) . ")" if $hd->{primary_partitions};
- if ($hd->{extended_partitions}) {
- $hd->{extended_partitions} .= " (" . join(', ', map { $_->{normal}{device} }@{$info->{extended}}) . ")";
- } else {
- delete $hd->{extended_partitions} if $hd->{extended_partitions} eq '0';
- }
- }
- $_->{EMULATEWHEEL} = bool2yesno($_->{EMULATEWHEEL}) if $Ident eq "MOUSE";
- rename_field($_, 'usb_bus', 'bus');
- rename_field($_, 'usb_driver', 'driver');
- rename_field($_, 'usb_id', 'id');
- rename_field($_, 'usb_media_type', 'media_type');
- rename_field($_, 'usb_pci_bus', 'bus');
- rename_field($_, 'usb_vendor', 'vendor');
- rename_field($_, 'vendor_name', 'Vendor');
-
- foreach my $i (qw(auxmouse devfs_prefix unsafe val wacom)) { delete $_->{$i} };
-
- my $custom_id = harddrake::data::custom_id($_, $title);
- foreach my $field (qw(devfs_device device)) {
- $_->{$field} = "/dev/$_->{$field}" if $_->{$field};
- }
- $tree_model->append_set($parent_iter, [ 1 => $custom_id, 2 => $index++ ]);
- push @data, [ $_, $Ident ];
- push @configurators, $configurator;
- }
- $tree->expand_row($tree_model->get_path($parent_iter), 1) unless $title eq N("Unknown/Others");
-}
-
-$SIG{CHLD} = sub {
- undef $pid;
- # reap zombies
- my $child_pid;
- do { $child_pid = waitpid(-1, POSIX::WNOHANG) } until $child_pid > 0;
-};
-
-$w->{rwindow}->signal_connect(delete_event => \&quit_global);
-$w->{rwindow}->set_position('center') unless $::isEmbedded;
-
-foreach (keys %menu_options) {
- my $title = strip_first_underscore(@{$menu_options{$_}});
- $options{$_} = 0 unless defined($options{$_}); # force detection by default
- $check_boxes{$_} = $factory->get_widget("<main>" . $title);
- $check_boxes{$_}->set_active($options{$_}); # restore saved values
-}
-
-$textcolumn->set_min_width(350);
-#$textcolumn->set_minmax_width(400);
-$textcolumn->set_sizing('GTK_TREE_VIEW_COLUMN_AUTOSIZE');#GROW_ONLY
-#$tree->columns_autosize();
-$tree->signal_connect(realize => sub { $tree->get_selection->select_path(Gtk2::TreePath->new_first) });
-$w->{rwindow}->show_all;
-undef $wait;
-gtkset_mousecursor_normal();
-$_->hide foreach $module_cfg_button, $config_button; # hide buttons while no device
-$w->main;
-
-
-sub quit_global() {
- kill(15, $pid) if $pid;
- setVarsInSh($conffile, \%options) if !$::testing;
- ugtk2->exit(0);
-}
-
-sub show_hide {
- my ($bool, $button) = @_;
- if ($bool) { $button->show } else { $button->hide }
-}
-
-
-sub strip_first_underscore {
- join '', map { s/_//; $_ } @_;
-}
-
-sub lookup_field {
- my ($field) = @_;
- my $class = find { defined $fields{$_} && defined $fields{$_}{$field} } ($current_class, 'generic');
- $fields{$class}{$field};
-}
-
-sub titleFormat {
- my ($title) = @_;
- [ $title . "\n", { 'weight' => Gtk2::Pango->PANGO_WEIGHT_BOLD, scale => Gtk2::Pango->PANGO_SCALE_LARGE } ];
-}
-
-sub rename_field {
- my ($dev, $field, $new_field) = @_;
- if ($dev->{$field}) {
- if ($dev->{$new_field}) {
- $dev->{$new_field} .= " ($dev->{$field})";
- } else {
- $dev->{$new_field} = $dev->{$field};
- }
- delete $dev->{$field};
- }
-}
-
-sub popup_menu {
- my ($menu) = @_;
- sub { my (undef, $event) = @_;
- if ($event->type eq 'button-press') {
- $menu->popup(undef, undef, undef, undef, $event->button, $event->time);
- # Tell calling code that we have handled this event; the buck stops here.
- return 1;
- }
- # Tell calling code that we have not handled this event; pass it on.
- return 0;
- }
-}
diff --git a/perl-install/standalone/icons/categ.png b/perl-install/standalone/icons/categ.png
deleted file mode 100644
index b466e0f43..000000000
--- a/perl-install/standalone/icons/categ.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakconnect.png b/perl-install/standalone/icons/drakconnect.png
deleted file mode 100644
index 7ec2f219d..000000000
--- a/perl-install/standalone/icons/drakconnect.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakfirewall.png b/perl-install/standalone/icons/drakfirewall.png
deleted file mode 100644
index 23c27b8be..000000000
--- a/perl-install/standalone/icons/drakfirewall.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakfont.png b/perl-install/standalone/icons/drakfont.png
deleted file mode 100644
index 586a5852c..000000000
--- a/perl-install/standalone/icons/drakfont.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakgw.png b/perl-install/standalone/icons/drakgw.png
deleted file mode 100644
index 475a1ae32..000000000
--- a/perl-install/standalone/icons/drakgw.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakups.png b/perl-install/standalone/icons/drakups.png
deleted file mode 100644
index f731c34f8..000000000
--- a/perl-install/standalone/icons/drakups.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakvpn.png b/perl-install/standalone/icons/drakvpn.png
deleted file mode 100644
index 89cf3ecd5..000000000
--- a/perl-install/standalone/icons/drakvpn.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/eth_card_mini2.png b/perl-install/standalone/icons/eth_card_mini2.png
deleted file mode 100644
index 6efbe637c..000000000
--- a/perl-install/standalone/icons/eth_card_mini2.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/fileopen.xpm b/perl-install/standalone/icons/fileopen.xpm
deleted file mode 100644
index 74049e224..000000000
--- a/perl-install/standalone/icons/fileopen.xpm
+++ /dev/null
@@ -1,34 +0,0 @@
-/* XPM */
-/* Drawn by Mark Donohoe for the K Desktop Environment */
-/* See http://www.kde.org */
-static char*fileopen[]={
-"22 22 6 1",
-"# c #000000",
-"d c #808080",
-"c c #c0c0c0",
-"b c #ffffff",
-"a c #dcdcdc",
-". c None",
-"......................",
-"......................",
-"............####......",
-"...............##.#...",
-"................###...",
-"................###...",
-"...............####...",
-"....####..............",
-"....#aba#######.......",
-"....#babababab#.......",
-"....#aa##########.....",
-"....#ba#aacccccd#.....",
-"....#a#aacacccd#......",
-"....#a#aacccdcd#......",
-"....##aacacccd#.......",
-"....##aacccdcd#.......",
-"....#dddddddd#........",
-"....##########........",
-"......................",
-"......................",
-"......................",
-"......................"};
-
diff --git a/perl-install/standalone/icons/find.xpm b/perl-install/standalone/icons/find.xpm
deleted file mode 100644
index 3145ca7fe..000000000
--- a/perl-install/standalone/icons/find.xpm
+++ /dev/null
@@ -1,34 +0,0 @@
-/* XPM */
-/* Drawn by Mark Donohoe for the K Desktop Environment */
-/* See http://www.kde.org */
-static char*find[]={
-"22 22 6 1",
-"# c #000000",
-"c c #ffffff",
-"b c #dcdcdc",
-"a c #a0a0a4",
-"d c #dcdcdc",
-". c None",
-"......................",
-"......................",
-"......................",
-".......####...........",
-".....a#bccd#a.........",
-".....#ccaacc#a........",
-"....#dcaccccd#........",
-"....#cccccccc#........",
-"....#cccccccc#........",
-"....#dccccccd#........",
-"....a#cccccc#a........",
-".....a#dccd###........",
-"......a####a###.......",
-".......aaaaaa###......",
-"............aa###.....",
-".............aa###....",
-"..............aa###...",
-"...............aa#a...",
-"................aa....",
-"......................",
-"......................",
-"......................"};
-
diff --git a/perl-install/standalone/icons/findf.xpm b/perl-install/standalone/icons/findf.xpm
deleted file mode 100644
index 792007335..000000000
--- a/perl-install/standalone/icons/findf.xpm
+++ /dev/null
@@ -1,31 +0,0 @@
-/* XPM */
-static char * findf_xpm[] = {
-"16 22 6 1",
-" c None",
-". c #000000",
-"+ c #FFFFFF",
-"@ c #0000FF",
-"# c #BEBEFF",
-"$ c #C0C0C0",
-" ",
-" ",
-" ",
-" ........... ",
-".+++++++++++. ",
-".++++++++@#+. ",
-".+++++++++@+. ",
-".++++$...$++. ",
-".+++$.+++.$+. ",
-".+++.+#+#+.+. ",
-".+++.+@@++.+. ",
-".+++.++@#+.+. ",
-".+++$.+++..+. ",
-".@#++$....+.. ",
-".+@+++++++.+. ",
-".++++++++++.+. ",
-".++@#+++++++.+. ",
-" ........... .+.",
-" . ",
-" ",
-" ",
-" "};
diff --git a/perl-install/standalone/icons/ftin.xpm b/perl-install/standalone/icons/ftin.xpm
deleted file mode 100644
index d0326d3ce..000000000
--- a/perl-install/standalone/icons/ftin.xpm
+++ /dev/null
@@ -1,30 +0,0 @@
-/* XPM */
-static char * ftin_xpm[] = {
-"15 22 5 1",
-" c None",
-". c #CD0000",
-"+ c #FFFFFF",
-"@ c #C0C0C0",
-"# c #808080",
-" ",
-" ",
-" ",
-" ",
-" ",
-" . . ",
-" ... ",
-" ...++++++++",
-" ...@@@@@@++",
-" .......+++++#",
-" .....@@@++#+",
-" ++...+++++#+#",
-" +@@@.@@@++#+#+",
-"++++++++++#+#+ ",
-"##########+#+ ",
-"++++++++++#+ ",
-"##########+ ",
-"++++++++++ ",
-" ",
-" ",
-" ",
-" "};
diff --git a/perl-install/standalone/icons/ftout.xpm b/perl-install/standalone/icons/ftout.xpm
deleted file mode 100644
index b4e0135b8..000000000
--- a/perl-install/standalone/icons/ftout.xpm
+++ /dev/null
@@ -1,30 +0,0 @@
-/* XPM */
-static char * ftout_xpm[] = {
-"15 22 5 1",
-" c None",
-". c #00008B",
-"+ c #FFFFFF",
-"@ c #C0C0C0",
-"# c #808080",
-" ",
-" ",
-" ",
-" ",
-" ",
-" . ",
-" ... ",
-" .....+++++++",
-" .......@@@@++",
-" ...+++++++#",
-" +...@@@@++#+",
-" ++...+++++#+#",
-" +@@.+.@@++#+#+",
-"++++++++++#+#+ ",
-"##########+#+ ",
-"++++++++++#+ ",
-"##########+ ",
-"++++++++++ ",
-" ",
-" ",
-" ",
-" "};
diff --git a/perl-install/standalone/icons/gmon.png b/perl-install/standalone/icons/gmon.png
deleted file mode 100644
index 182adca81..000000000
--- a/perl-install/standalone/icons/gmon.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/cd.png b/perl-install/standalone/icons/harddrake2/cd.png
deleted file mode 100644
index 60adeb6f0..000000000
--- a/perl-install/standalone/icons/harddrake2/cd.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/cpu.png b/perl-install/standalone/icons/harddrake2/cpu.png
deleted file mode 100644
index 404fd1bd6..000000000
--- a/perl-install/standalone/icons/harddrake2/cpu.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/floppy.png b/perl-install/standalone/icons/harddrake2/floppy.png
deleted file mode 100644
index 044647aba..000000000
--- a/perl-install/standalone/icons/harddrake2/floppy.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/harddisk.png b/perl-install/standalone/icons/harddrake2/harddisk.png
deleted file mode 100644
index 7e8d7017f..000000000
--- a/perl-install/standalone/icons/harddrake2/harddisk.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/harddrake.png b/perl-install/standalone/icons/harddrake2/harddrake.png
deleted file mode 100644
index 285a5db02..000000000
--- a/perl-install/standalone/icons/harddrake2/harddrake.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/hw_mouse.png b/perl-install/standalone/icons/harddrake2/hw_mouse.png
deleted file mode 100644
index 3c0d31df2..000000000
--- a/perl-install/standalone/icons/harddrake2/hw_mouse.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/hw_network.png b/perl-install/standalone/icons/harddrake2/hw_network.png
deleted file mode 100644
index d731c873f..000000000
--- a/perl-install/standalone/icons/harddrake2/hw_network.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/hw_printer.png b/perl-install/standalone/icons/harddrake2/hw_printer.png
deleted file mode 100644
index 99e3e825c..000000000
--- a/perl-install/standalone/icons/harddrake2/hw_printer.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/ide_hd.png b/perl-install/standalone/icons/harddrake2/ide_hd.png
deleted file mode 100644
index 7e8d7017f..000000000
--- a/perl-install/standalone/icons/harddrake2/ide_hd.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/isdn.png b/perl-install/standalone/icons/harddrake2/isdn.png
deleted file mode 100644
index 4bd8d7c8c..000000000
--- a/perl-install/standalone/icons/harddrake2/isdn.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/joystick.png b/perl-install/standalone/icons/harddrake2/joystick.png
deleted file mode 100644
index b1c1691cc..000000000
--- a/perl-install/standalone/icons/harddrake2/joystick.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/keyboard.png b/perl-install/standalone/icons/harddrake2/keyboard.png
deleted file mode 100644
index 84192aeee..000000000
--- a/perl-install/standalone/icons/harddrake2/keyboard.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/memory.png b/perl-install/standalone/icons/harddrake2/memory.png
deleted file mode 100644
index 0088a2e46..000000000
--- a/perl-install/standalone/icons/harddrake2/memory.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu16.png b/perl-install/standalone/icons/harddrake2/menu/harddrake-menu16.png
deleted file mode 100644
index 285a5db02..000000000
--- a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu16.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu32.png b/perl-install/standalone/icons/harddrake2/menu/harddrake-menu32.png
deleted file mode 100644
index ceb1c7dca..000000000
--- a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu32.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu48.png b/perl-install/standalone/icons/harddrake2/menu/harddrake-menu48.png
deleted file mode 100644
index e21b44956..000000000
--- a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu48.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/modem.png b/perl-install/standalone/icons/harddrake2/modem.png
deleted file mode 100644
index a482d6025..000000000
--- a/perl-install/standalone/icons/harddrake2/modem.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/multimedia.png b/perl-install/standalone/icons/harddrake2/multimedia.png
deleted file mode 100644
index 9b4979d41..000000000
--- a/perl-install/standalone/icons/harddrake2/multimedia.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/scanner.png b/perl-install/standalone/icons/harddrake2/scanner.png
deleted file mode 100644
index 627540c70..000000000
--- a/perl-install/standalone/icons/harddrake2/scanner.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/scsi.png b/perl-install/standalone/icons/harddrake2/scsi.png
deleted file mode 100644
index 16bcfee25..000000000
--- a/perl-install/standalone/icons/harddrake2/scsi.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/scsi_hd.png b/perl-install/standalone/icons/harddrake2/scsi_hd.png
deleted file mode 100644
index 7e8d7017f..000000000
--- a/perl-install/standalone/icons/harddrake2/scsi_hd.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/sound.png b/perl-install/standalone/icons/harddrake2/sound.png
deleted file mode 100644
index 4ca431868..000000000
--- a/perl-install/standalone/icons/harddrake2/sound.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/tape.png b/perl-install/standalone/icons/harddrake2/tape.png
deleted file mode 100644
index 1b84ebcde..000000000
--- a/perl-install/standalone/icons/harddrake2/tape.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/tv.png b/perl-install/standalone/icons/harddrake2/tv.png
deleted file mode 100644
index bfc206a82..000000000
--- a/perl-install/standalone/icons/harddrake2/tv.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/unknown.png b/perl-install/standalone/icons/harddrake2/unknown.png
deleted file mode 100644
index a4dced6c3..000000000
--- a/perl-install/standalone/icons/harddrake2/unknown.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/ups.png b/perl-install/standalone/icons/harddrake2/ups.png
deleted file mode 100644
index 1e2652da4..000000000
--- a/perl-install/standalone/icons/harddrake2/ups.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/usb.png b/perl-install/standalone/icons/harddrake2/usb.png
deleted file mode 100644
index b13505124..000000000
--- a/perl-install/standalone/icons/harddrake2/usb.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/video.png b/perl-install/standalone/icons/harddrake2/video.png
deleted file mode 100644
index afba5e124..000000000
--- a/perl-install/standalone/icons/harddrake2/video.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/webcam.png b/perl-install/standalone/icons/harddrake2/webcam.png
deleted file mode 100644
index 89ba6b246..000000000
--- a/perl-install/standalone/icons/harddrake2/webcam.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/hori.png b/perl-install/standalone/icons/hori.png
deleted file mode 100644
index 595805edf..000000000
--- a/perl-install/standalone/icons/hori.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic-drakfont-48.png b/perl-install/standalone/icons/ic-drakfont-48.png
deleted file mode 100644
index c4473e6b5..000000000
--- a/perl-install/standalone/icons/ic-drakfont-48.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-CD-40.png b/perl-install/standalone/icons/ic82-CD-40.png
deleted file mode 100644
index 5193e7335..000000000
--- a/perl-install/standalone/icons/ic82-CD-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-back-up-16.png b/perl-install/standalone/icons/ic82-back-up-16.png
deleted file mode 100644
index 20188e863..000000000
--- a/perl-install/standalone/icons/ic82-back-up-16.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-back-up-32.png b/perl-install/standalone/icons/ic82-back-up-32.png
deleted file mode 100644
index 8295f3725..000000000
--- a/perl-install/standalone/icons/ic82-back-up-32.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-back-up-48.png b/perl-install/standalone/icons/ic82-back-up-48.png
deleted file mode 100644
index a974f8716..000000000
--- a/perl-install/standalone/icons/ic82-back-up-48.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-discdurwhat-40.png b/perl-install/standalone/icons/ic82-discdurwhat-40.png
deleted file mode 100644
index 73bef43ac..000000000
--- a/perl-install/standalone/icons/ic82-discdurwhat-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-dossier-32.png b/perl-install/standalone/icons/ic82-dossier-32.png
deleted file mode 100644
index 4502dad27..000000000
--- a/perl-install/standalone/icons/ic82-dossier-32.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-moreoption-40.png b/perl-install/standalone/icons/ic82-moreoption-40.png
deleted file mode 100644
index d15130bea..000000000
--- a/perl-install/standalone/icons/ic82-moreoption-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-network-40.png b/perl-install/standalone/icons/ic82-network-40.png
deleted file mode 100644
index 1d688ca48..000000000
--- a/perl-install/standalone/icons/ic82-network-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-others-40.png b/perl-install/standalone/icons/ic82-others-40.png
deleted file mode 100644
index 6447a7eca..000000000
--- a/perl-install/standalone/icons/ic82-others-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-system-40.png b/perl-install/standalone/icons/ic82-system-40.png
deleted file mode 100644
index 6b35675e8..000000000
--- a/perl-install/standalone/icons/ic82-system-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-users-40.png b/perl-install/standalone/icons/ic82-users-40.png
deleted file mode 100644
index d9ae81534..000000000
--- a/perl-install/standalone/icons/ic82-users-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-when-40.png b/perl-install/standalone/icons/ic82-when-40.png
deleted file mode 100644
index 2846435c8..000000000
--- a/perl-install/standalone/icons/ic82-when-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-where-40.png b/perl-install/standalone/icons/ic82-where-40.png
deleted file mode 100644
index fdd6beb62..000000000
--- a/perl-install/standalone/icons/ic82-where-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/localedrake-16.png b/perl-install/standalone/icons/localedrake-16.png
deleted file mode 100644
index 5cc46f71e..000000000
--- a/perl-install/standalone/icons/localedrake-16.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/localedrake-32.png b/perl-install/standalone/icons/localedrake-32.png
deleted file mode 100644
index 145781168..000000000
--- a/perl-install/standalone/icons/localedrake-32.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/localedrake-48.png b/perl-install/standalone/icons/localedrake-48.png
deleted file mode 100644
index df32f35d6..000000000
--- a/perl-install/standalone/icons/localedrake-48.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/logdrake.png b/perl-install/standalone/icons/logdrake.png
deleted file mode 100644
index 2068f8e74..000000000
--- a/perl-install/standalone/icons/logdrake.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/mdk_logo.png b/perl-install/standalone/icons/mdk_logo.png
deleted file mode 100644
index fe7bc4b4f..000000000
--- a/perl-install/standalone/icons/mdk_logo.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/net_c.png b/perl-install/standalone/icons/net_c.png
deleted file mode 100644
index 5688f4be1..000000000
--- a/perl-install/standalone/icons/net_c.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/net_d.png b/perl-install/standalone/icons/net_d.png
deleted file mode 100644
index 1bfdd3ef2..000000000
--- a/perl-install/standalone/icons/net_d.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/net_u.png b/perl-install/standalone/icons/net_u.png
deleted file mode 100644
index 5c4a16079..000000000
--- a/perl-install/standalone/icons/net_u.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/non-editable.png b/perl-install/standalone/icons/non-editable.png
deleted file mode 100644
index eaa69bc67..000000000
--- a/perl-install/standalone/icons/non-editable.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/printerdrake.png b/perl-install/standalone/icons/printerdrake.png
deleted file mode 100644
index 87c198972..000000000
--- a/perl-install/standalone/icons/printerdrake.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/reload.xpm b/perl-install/standalone/icons/reload.xpm
deleted file mode 100644
index 658cf36f0..000000000
--- a/perl-install/standalone/icons/reload.xpm
+++ /dev/null
@@ -1,31 +0,0 @@
-/* XPM */
-/* Drawn by Mark Donohoe for the K Desktop Environment */
-/* See http://www.kde.org */
-static char*reload[]={
-"22 22 3 1",
-"# c #808080",
-"a c #000000",
-". c None",
-"......................",
-"......................",
-"......................",
-"......................",
-"........##aaa#........",
-".......#aaaaaaa.......",
-"......#aa#....#a......",
-"......aa#.............",
-".....aaa.......a......",
-"...aaaaaaa....aaa.....",
-"....aaaaa....aaaaa....",
-".....aaa....aaaaaaa...",
-"......a.......aaa.....",
-".............#aa......",
-"......a#....#aa#......",
-".......aaaaaaa#.......",
-"........#aaa##........",
-"......................",
-"......................",
-"......................",
-"......................",
-"......................"};
-
diff --git a/perl-install/standalone/icons/scannerdrake.png b/perl-install/standalone/icons/scannerdrake.png
deleted file mode 100644
index fa9cd1eee..000000000
--- a/perl-install/standalone/icons/scannerdrake.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/smbnfs_default.png b/perl-install/standalone/icons/smbnfs_default.png
deleted file mode 100644
index 769f171c5..000000000
--- a/perl-install/standalone/icons/smbnfs_default.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/smbnfs_has_mntpoint.png b/perl-install/standalone/icons/smbnfs_has_mntpoint.png
deleted file mode 100644
index 213ec9eac..000000000
--- a/perl-install/standalone/icons/smbnfs_has_mntpoint.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/smbnfs_mounted.png b/perl-install/standalone/icons/smbnfs_mounted.png
deleted file mode 100644
index f799b33d1..000000000
--- a/perl-install/standalone/icons/smbnfs_mounted.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/smbnfs_server.png b/perl-install/standalone/icons/smbnfs_server.png
deleted file mode 100644
index 92af7a316..000000000
--- a/perl-install/standalone/icons/smbnfs_server.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/tradi.png b/perl-install/standalone/icons/tradi.png
deleted file mode 100644
index a9b19f468..000000000
--- a/perl-install/standalone/icons/tradi.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/verti.png b/perl-install/standalone/icons/verti.png
deleted file mode 100644
index 6bc84225b..000000000
--- a/perl-install/standalone/icons/verti.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/wiz_default_up.png b/perl-install/standalone/icons/wiz_default_up.png
deleted file mode 100644
index 2359b9bb1..000000000
--- a/perl-install/standalone/icons/wiz_default_up.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/interactive_http/Makefile b/perl-install/standalone/interactive_http/Makefile
deleted file mode 100644
index 5607112c9..000000000
--- a/perl-install/standalone/interactive_http/Makefile
+++ /dev/null
@@ -1,21 +0,0 @@
-NAME=libDrakX
-FNAME=$(NAME)/drakxtools_http
-PREFIX=
-DATADIR=$(PREFIX)/usr/share
-
-all: index.html
-
-index.html: index.html.pl
- perl $^ > $@
-
-install:
- install -D miniserv.init $(PREFIX)/etc/init.d/drakxtools_http
- install -D -m 644 authorised_progs $(PREFIX)/etc/drakxtools_http/authorised_progs
- install -D -m 644 miniserv.conf $(PREFIX)/etc/drakxtools_http/conf
- install -D -m 644 miniserv.pam $(PREFIX)/etc/pam.d/miniserv
- install -D -m 644 miniserv.logrotate $(PREFIX)/etc/logrotate.d/drakxtools-http
-
- install -d $(DATADIR)/$(FNAME)/www
- install -m 644 miniserv.pl miniserv.pem miniserv.users $(DATADIR)/$(FNAME)
- install -m 644 index.html $(DATADIR)/$(FNAME)/www
- install interactive_http.cgi $(DATADIR)/$(FNAME)/www
diff --git a/perl-install/standalone/interactive_http/authorised_progs b/perl-install/standalone/interactive_http/authorised_progs
deleted file mode 100644
index fe95e2768..000000000
--- a/perl-install/standalone/interactive_http/authorised_progs
+++ /dev/null
@@ -1,12 +0,0 @@
-/usr/sbin/XFdrake
-/usr/sbin/adduserdrake
-/usr/sbin/diskdrake
-/usr/sbin/drakautoinst
-/usr/sbin/drakboot
-/usr/sbin/drakgw
-/usr/sbin/drakconnect
-/usr/sbin/drakxservices
-/usr/sbin/keyboarddrake
-/usr/sbin/mousedrake
-/usr/sbin/printerdrake
-/usr/sbin/tinyfirewall
diff --git a/perl-install/standalone/interactive_http/index.html.pl b/perl-install/standalone/interactive_http/index.html.pl
deleted file mode 100644
index afd91459b..000000000
--- a/perl-install/standalone/interactive_http/index.html.pl
+++ /dev/null
@@ -1,14 +0,0 @@
-use MDK::Common;
-
-print '<html>
-';
-foreach (map { chomp_($_) } cat_('authorised_progs')) {
- my $name = basename($_);
- print
-qq(<a href="/interactive_http.cgi?state=new&prog=$_">$name</a>
-<br>
-);
-}
-print '
-</html>
-';
diff --git a/perl-install/standalone/interactive_http/interactive_http.cgi b/perl-install/standalone/interactive_http/interactive_http.cgi
deleted file mode 100755
index 935a4a765..000000000
--- a/perl-install/standalone/interactive_http/interactive_http.cgi
+++ /dev/null
@@ -1,95 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-use CGI;
-use common;
-use c;
-
-my $q = CGI->new;
-$| = 1;
-
-my $script_name = $q->url(-relative => 1);
-
-# name inversed (must be in sync with interactive_http.html)
-my $pipe_r = "/tmp/interactive_http_w";
-my $pipe_w = "/tmp/interactive_http_r";
-
-if ($q->param('state') eq 'new') {
- force_exit_dead_prog();
- mkfifo($pipe_r); mkfifo($pipe_w);
-
- spawn_server($q->param('prog'));
- first_step();
-
-} elsif ($q->param('state') eq 'next_step') {
- next_step();
-} else {
- error("booh...");
-}
-
-sub read_ {
- local *F;
- open F, "<$pipe_r" or error("Failed to connect to the prog");
- my $t;
- print $t while sysread F, $t, 1;
-}
-sub write_ {
- local *F;
- open F, ">$pipe_w" or die;
- my $q = CGI->new;
- $q->save(\*F);
-}
-
-sub first_step { read_() }
-sub next_step { write_(); read_() }
-
-
-sub force_exit_dead_prog {
- -p $pipe_w or return;
- {
- local *F;
- sysopen F, $pipe_w, 1 | c::O_NONBLOCK() or return;
- syswrite F, "force_exit_dead_prog=1\n";
- }
-
- my $cnt = 10;
- while (-p $pipe_w) {
- sleep 1;
- $cnt-- or error("Dead prog failed to exit");
- }
-}
-
-sub spawn_server {
- my ($prog) = @_;
-
- my @authorised_progs = map { chomp_($_) } cat_('/etc/drakxtools_http/authorised_progs');
- member($prog, @authorised_progs) or error("You tried to call a non-authorised program");
-
- fork and return;
-
- $ENV{INTERACTIVE_HTTP} = $script_name;
-
- open STDIN, "</dev/zero";
- open STDOUT, ">/dev/null"; #tmp/log";
- open STDERR, ">&STDOUT";
-
- c::setsid();
- exec $prog or die "prog $prog not found\n";
-}
-
-sub error {
- my $msg = join '', @_;
-
- print $q->header(), $q->start_html();
- print $q->h1(_("Error")), @_;
- print $q->end_html(), "\n";
- exit 0;
-}
-
-sub mkfifo {
- my ($f) = @_;
- -p $f and return;
- unlink $f;
- syscall_('mknod', $f, c::S_IFIFO() | 0600, 0) or die "mkfifo failed";
- chmod 0666, $f;
-}
diff --git a/perl-install/standalone/interactive_http/miniserv.conf b/perl-install/standalone/interactive_http/miniserv.conf
deleted file mode 100644
index 99f6a5172..000000000
--- a/perl-install/standalone/interactive_http/miniserv.conf
+++ /dev/null
@@ -1,13 +0,0 @@
-ssl=1
-log=1
-port=10001
-listen=10001
-forkcgis=1
-realm=Drakxtools Server
-
-addtype_cgi=internal/cgi
-logfile=/var/log/drakxtools_http.log
-pidfile=/var/run/drakxtools_http.pid
-root=/usr/share/libDrakX/drakxtools_http/www
-keyfile=/usr/share/libDrakX/drakxtools_http/miniserv.pem
-userfile=/usr/share/libDrakX/drakxtools_http/miniserv.users
diff --git a/perl-install/standalone/interactive_http/miniserv.init b/perl-install/standalone/interactive_http/miniserv.init
deleted file mode 100644
index c9aaf9aeb..000000000
--- a/perl-install/standalone/interactive_http/miniserv.init
+++ /dev/null
@@ -1,60 +0,0 @@
-#!/bin/sh
-# chkconfig: 235 99 00
-# description: Start or stop the miniserv administration server
-
-# Source function library.
-. /etc/rc.d/init.d/functions
-
-subsys=/var/lock/subsys/drakxtools_http
-name=drakxtools_http
-server=/usr/share/libDrakX/$name/miniserv.pl
-
-start ()
-{
- action "Starting $name: " perl $server /etc/$name/conf
- touch $subsys
- echo $name
-}
-
-stop ()
-{
- action "Shutting down $name: " kill `cat /var/run/$name.pid`
- rm -f $subsys
- echo $name
-}
-
-restart ()
-{
- stop
- start
-}
-
-case "$1" in
-'start')
- start;;
-'stop')
- stop;;
-'status')
- if [ -s /var/run/$name.pid ]; then
- pid=`cat /var/run/$name.pid`
- kill -0 $pid >/dev/null 2>&1
- if [ "$?" = "0" ]; then
- echo "$name (pid $pid) is running"
- else
- echo "$name is stopped"
- fi
- else
- echo "$name is stopped"
- fi
- ;;
-'restart')
- restart;;
-'reload')
- restart;;
-'condrestart')
- [[ -f $subsys ]] && restart;;
-*)
- echo "Usage: $0 {start|stop|restart|status|reload|condrestart}"
- ;;
-esac
-exit 0
diff --git a/perl-install/standalone/interactive_http/miniserv.logrotate b/perl-install/standalone/interactive_http/miniserv.logrotate
deleted file mode 100644
index b1e833f9b..000000000
--- a/perl-install/standalone/interactive_http/miniserv.logrotate
+++ /dev/null
@@ -1,7 +0,0 @@
-# Logrotate file for drakxtools-http RPM
-
-/var/log/drakxtools_http.log {
- weekly
- notifempty
- missingok
-}
diff --git a/perl-install/standalone/interactive_http/miniserv.pam b/perl-install/standalone/interactive_http/miniserv.pam
deleted file mode 100644
index 37eae44e0..000000000
--- a/perl-install/standalone/interactive_http/miniserv.pam
+++ /dev/null
@@ -1,5 +0,0 @@
-#%PAM-1.0
-auth required /lib/security/pam_stack.so service=system-auth
-account required /lib/security/pam_stack.so service=system-auth
-password required /lib/security/pam_stack.so service=system-auth
-session required /lib/security/pam_stack.so service=system-auth
diff --git a/perl-install/standalone/interactive_http/miniserv.pem b/perl-install/standalone/interactive_http/miniserv.pem
deleted file mode 100644
index e11919e37..000000000
--- a/perl-install/standalone/interactive_http/miniserv.pem
+++ /dev/null
@@ -1,18 +0,0 @@
------BEGIN RSA PRIVATE KEY-----
-MIIBOgIBAAJBANaRBV7X6DWUbTm8KBjjHx4CAHVSQCmei8QIwruVPngwOkEhsgzf
-IT1IY6jyY3QM6a4ASl7xokoy5U4QZ8E/q40CAwEAAQJBAIwMLA0zr4UJVCGTBjj4
-RZ84f0QUY3zG10Mk1LXLO/MFlRol+640x/PB76fPKP+Gx+88s8F6lcx7uV+jB0bM
-F6ECIQD3aYxjgxLinAmTjZf5gJDm/5LeEogML7nJ+aXJs8oAFwIhAN4DnKUfjiim
-pOowhaRqy8b9fjXG8L+SG/+KcZDsWzP7AiBO2gXTRVgEfwSSUUNJUo9b/8I4IqHX
-eHJ3C6ip8zIC+wIgdhsVygHvblC4ip0le0IVBdb0vUcH6+GeY2MS5zXVjuECIEP0
-GLnMXcQ02f8rQz0eeBYVHTNXKRMesgo3ZNcpDB2k
------END RSA PRIVATE KEY-----
------BEGIN CERTIFICATE-----
-MIIBNTCB4AIBADANBgkqhkiG9w0BAQQFADAmMRgwFgYDVQQKEw9XZWJtaW4gU29m
-dHdhcmUxCjAIBgNVBAMUASowHhcNOTgwMTAzMTAzNDUwWhcNMDcxMDAzMTAzNDUw
-WjAmMRgwFgYDVQQKEw9XZWJtaW4gU29mdHdhcmUxCjAIBgNVBAMUASowXDANBgkq
-hkiG9w0BAQEFAANLADBIAkEA1pEFXtfoNZRtObwoGOMfHgIAdVJAKZ6LxAjCu5U+
-eDA6QSGyDN8hPUhjqPJjdAzprgBKXvGiSjLlThBnwT+rjQIDAQABMA0GCSqGSIb3
-DQEBBAUAA0EAFCoYeLlWcClpv2sSc7zIchsMR3DKeH/O1ZtfEezzkaonre78HeYV
-wSQvuoVleb7A497TFcSB6+FON6azoVqPyQ==
------END CERTIFICATE-----
diff --git a/perl-install/standalone/interactive_http/miniserv.pl b/perl-install/standalone/interactive_http/miniserv.pl
deleted file mode 100644
index b11ce26e2..000000000
--- a/perl-install/standalone/interactive_http/miniserv.pl
+++ /dev/null
@@ -1,1817 +0,0 @@
-#!/usr/bin/perl
-# A very simple perl web server used by Webmin
-
-# Require basic libraries
-package miniserv;
-use Socket;
-use POSIX;
-use Sys::Hostname;
-
-# Find and read config file
-if (@ARGV != 1) {
- die "Usage: miniserv.pl <config file>";
- }
-if ($ARGV[0] =~ /^\//) {
- $conf = $ARGV[0];
- }
-else {
- chop($pwd = `pwd`);
- $conf = "$pwd/$ARGV[0]";
- }
-open(CONF, $conf) || die "Failed to open config file $conf : $!";
-while(<CONF>) {
- s/\r|\n//g;
- if (/^#/ || !/\S/) { next; }
- /^([^=]+)=(.*)$/;
- $name = $1; $val = $2;
- $name =~ s/^\s+//g; $name =~ s/\s+$//g;
- $val =~ s/^\s+//g; $val =~ s/\s+$//g;
- $config{$name} = $val;
- }
-close(CONF);
-
-# Check is SSL is enabled and available
-if ($config{'ssl'}) {
- eval "use Net::SSLeay";
- if (!$@) {
- $use_ssl = 1;
- # These functions only exist for SSLeay 1.0
- eval "Net::SSLeay::SSLeay_add_ssl_algorithms()";
- eval "Net::SSLeay::load_error_strings()";
- if (defined(&Net::SSLeay::X509_STORE_CTX_get_current_cert) &&
- defined(&Net::SSLeay::CTX_load_verify_locations) &&
- defined(&Net::SSLeay::CTX_set_verify)) {
- $client_certs = 1;
- }
- }
- }
-
-# Check if the syslog module is available to log hacking attempts
-if ($config{'syslog'}) {
- eval "use Sys::Syslog qw(:DEFAULT setlogsock)";
- if (!$@) {
- $use_syslog = 1;
- }
- }
-
-# check if the PAM module is available to authenticate
-eval "use Authen::PAM";
-if (!$@) {
- # check if the PAM authentication can be used by opening a handle
- if (! ref($pamh = new Authen::PAM("miniserv", "root", \&pam_conv_func))) {
- print STDERR "PAM module available, but error during init !\n";
- print STDERR "Disabling PAM functions.\n";
- }
- else {
- $use_pam = 1;
- }
- }
-
-# check if the TCP-wrappers module is available
-if ($config{'libwrap'}) {
- eval "use Authen::Libwrap qw(hosts_ctl STRING_UNKNOWN)";
- if (!$@) {
- $use_libwrap = 1;
- }
- }
-
-# Get miniserv's perl path and location
-$miniserv_path = $0;
-open(SOURCE, $miniserv_path);
-<SOURCE> =~ /^#!(\S+)/; $perl_path = $1;
-close(SOURCE);
-@miniserv_argv = @ARGV;
-
-# Check vital config options
-%vital = ("port", 80,
- "root", "./",
- "server", "MiniServ/0.01",
- "index_docs", "index.html index.htm index.cgi",
- "addtype_html", "text/html",
- "addtype_txt", "text/plain",
- "addtype_gif", "image/gif",
- "addtype_jpg", "image/jpeg",
- "addtype_jpeg", "image/jpeg",
- "realm", "MiniServ",
- "session_login", "/session_login.cgi"
- );
-foreach $v (keys %vital) {
- if (!$config{$v}) {
- if ($vital{$v} eq "") {
- die "Missing config option $v";
- }
- $config{$v} = $vital{$v};
- }
- }
-if (!$config{'sessiondb'}) {
- $config{'pidfile'} =~ /^(.*)\/[^\/]+$/;
- $config{'sessiondb'} = "$1/sessiondb";
- }
-die "Session authentication cannot be used in inetd mode"
- if ($config{'inetd'} && $config{'session'});
-
-# init days and months for http_date
-@weekday = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );
-@month = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun",
- "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
-
-# Change dir to the server root
-chdir($config{'root'});
-$user_homedir = (getpwuid($<))[7];
-
-# Read users file
-if ($config{'userfile'}) {
- open(USERS, $config{'userfile'});
- while(<USERS>) {
- s/\r|\n//g;
- local @user = split(/:/, $_);
- $users{$user[0]} = $user[1];
- $certs{$user[0]} = $user[3] if ($user[3]);
- if ($user[4] =~ /^allow\s+(.*)/) {
- $allow{$user[0]} = [ &to_ipaddress(split(/\s+/, $1)) ];
- }
- elsif ($user[4] =~ /^deny\s+(.*)/) {
- $deny{$user[0]} = [ &to_ipaddress(split(/\s+/, $1)) ];
- }
- }
- close(USERS);
- }
-
-# Setup SSL if possible and if requested
-if ($use_ssl) {
- $ssl_ctx = Net::SSLeay::CTX_new() ||
- die "Failed to create SSL context : $!";
- $client_certs = 0 if (!$config{'ca'} || !%certs);
- if ($client_certs) {
- Net::SSLeay::CTX_load_verify_locations(
- $ssl_ctx, $config{'ca'}, "");
- Net::SSLeay::CTX_set_verify(
- $ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client);
- }
-
- Net::SSLeay::CTX_use_RSAPrivateKey_file(
- $ssl_ctx, $config{'keyfile'},
- &Net::SSLeay::FILETYPE_PEM) || die "Failed to open SSL key";
- Net::SSLeay::CTX_use_certificate_file(
- $ssl_ctx, $config{'keyfile'},
- &Net::SSLeay::FILETYPE_PEM);
- }
-
-# Setup syslog support if possible and if requested
-if ($use_syslog) {
- eval { openlog("miniserv", "cons,pid,ndelay", "daemon") };
- $use_syslog = 0 if ($@);
- }
-
-# Read MIME types file and add extra types
-if ($config{"mimetypes"} ne "") {
- open(MIME, $config{"mimetypes"});
- while(<MIME>) {
- chop; s/#.*$//;
- if (/^(\S+)\s+(.*)$/) {
- $type = $1; @exts = split(/\s+/, $2);
- foreach $ext (@exts) {
- $mime{$ext} = $type;
- }
- }
- }
- close(MIME);
- }
-foreach $k (keys %config) {
- if ($k !~ /^addtype_(.*)$/) { next; }
- $mime{$1} = $config{$k};
- }
-
-# get the time zone
-if ($config{'log'}) {
- local(@gmt, @lct, $days, $hours, $mins);
- @make_date_marr = ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
- "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
- @gmt = gmtime(time());
- @lct = localtime(time());
- $days = $lct[3] - $gmt[3];
- $hours = ($days < -1 ? 24 : 1 < $days ? -24 : $days * 24) +
- $lct[2] - $gmt[2];
- $mins = $hours * 60 + $lct[1] - $gmt[1];
- $timezone = ($mins < 0 ? "-" : "+"); $mins = abs($mins);
- $timezone .= sprintf "%2.2d%2.2d", $mins/60, $mins%60;
- }
-
-if ($config{'inetd'}) {
- # We are being run from inetd - go direct to handling the request
- $SIG{'HUP'} = 'IGNORE';
- $SIG{'TERM'} = 'DEFAULT';
- $SIG{'PIPE'} = 'DEFAULT';
- open(SOCK, "+>&STDIN");
-
- # Check if it is time for the logfile to be cleared
- if ($config{'logclear'}) {
- local $write_logtime = 0;
- local @st = stat("$config{'logfile'}.time");
- if (@st) {
- if ($st[9]+$config{'logtime'}*60*60 < time()){
- # need to clear log
- $write_logtime = 1;
- unlink($config{'logfile'});
- }
- }
- else { $write_logtime = 1; }
- if ($write_logtime) {
- open(LOGTIME, ">$config{'logfile'}.time");
- print LOGTIME time(),"\n";
- close(LOGTIME);
- }
- }
-
- # Initialize SSL for this connection
- if ($use_ssl) {
- $ssl_con = Net::SSLeay::new($ssl_ctx);
- Net::SSLeay::set_fd($ssl_con, fileno(SOCK));
- #Net::SSLeay::use_RSAPrivateKey_file(
- # $ssl_con, $config{'keyfile'},
- # &Net::SSLeay::FILETYPE_PEM);
- #Net::SSLeay::use_certificate_file(
- # $ssl_con, $config{'keyfile'},
- # &Net::SSLeay::FILETYPE_PEM);
- Net::SSLeay::accept($ssl_con) || exit;
- }
-
- # Work out the hostname for this web server
- if (!$config{'host'}) {
- ($myport, $myaddr) =
- unpack_sockaddr_in(getsockname(SOCK));
- $myname = gethostbyaddr($myaddr, AF_INET);
- if ($myname eq "") {
- $myname = inet_ntoa($myaddr);
- }
- $host = $myname;
- }
- else { $host = $config{'host'}; }
- $port = $config{'port'};
-
- while(&handle_request(getpeername(SOCK), getsockname(SOCK))) { }
- close(SOCK);
- exit;
- }
-
-# Open main socket
-$proto = getprotobyname('tcp');
-socket(MAIN, PF_INET, SOCK_STREAM, $proto) ||
- die "Failed to open main socket : $!";
-setsockopt(MAIN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
-$baddr = $config{"bind"} ? inet_aton($config{"bind"}) : INADDR_ANY;
-for($i=0; $i<5; $i++) {
- last if (bind(MAIN, sockaddr_in($config{port}, $baddr)));
- sleep(1);
- }
-die "Failed to bind port $config{port} : $!" if ($i == 5);
-listen(MAIN, SOMAXCONN);
-
-if ($config{'listen'}) {
- # Open the socket that allows other miniserv servers to find this one
- $proto = getprotobyname('udp');
- if (socket(LISTEN, PF_INET, SOCK_DGRAM, $proto)) {
- setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1));
- bind(LISTEN, sockaddr_in($config{'listen'}, INADDR_ANY));
- listen(LISTEN, SOMAXCONN);
- }
- else {
- print STDERR "Failed to open listening socket : $!\n";
- $config{'listen'} = 0;
- }
- }
-
-
-# Split from the controlling terminal
-if (fork()) { exit; }
-setsid();
-
-# write out the PID file
-open(PIDFILE, "> $config{'pidfile'}");
-printf PIDFILE "%d\n", getpid();
-close(PIDFILE);
-
-# Start the log-clearing process, if needed. This checks every minute
-# to see if the log has passed its reset time, and if so clears it
-if ($config{'logclear'}) {
- if (!($logclearer = fork())) {
- while(1) {
- local $write_logtime = 0;
- local @st = stat("$config{'logfile'}.time");
- if (@st) {
- if ($st[9]+$config{'logtime'}*60*60 < time()){
- # need to clear log
- $write_logtime = 1;
- unlink($config{'logfile'});
- }
- }
- else { $write_logtime = 1; }
- if ($write_logtime) {
- open(LOGTIME, ">$config{'logfile'}.time");
- print LOGTIME time(),"\n";
- close(LOGTIME);
- }
- sleep(5*60);
- }
- exit;
- }
- push(@childpids, $logclearer);
- }
-
-# Setup the logout time dbm if needed
-if ($config{'session'}) {
- eval "use SDBM_File";
- dbmopen(%sessiondb, $config{'sessiondb'}, 0700);
- eval { $sessiondb{'1111111111'} = 'foo bar' };
- if ($@) {
- dbmclose(%sessiondb);
- eval "use NDBM_File";
- dbmopen(%sessiondb, $config{'sessiondb'}, 0700);
- }
- }
-
-# Run the main loop
-$SIG{'HUP'} = 'miniserv::trigger_restart';
-$SIG{'TERM'} = 'miniserv::term_handler';
-$SIG{'PIPE'} = 'IGNORE';
-@deny = &to_ipaddress(split(/\s+/, $config{"deny"}));
-@allow = &to_ipaddress(split(/\s+/, $config{"allow"}));
-$p = 0;
-while(1) {
- # wait for a new connection, or a message from a child process
- undef($rmask);
- vec($rmask, fileno(MAIN), 1) = 1;
- if ($config{'passdelay'} || $config{'session'}) {
- for($i=0; $i<@passin; $i++) {
- vec($rmask, fileno($passin[$i]), 1) = 1;
- }
- }
- vec($rmask, fileno(LISTEN), 1) = 1 if ($config{'listen'});
-
- local $sel = select($rmask, undef, undef, 10);
- if ($need_restart) { &restart_miniserv(); }
- local $time_now = time();
-
- # Clean up finished processes
- local($pid);
- do { $pid = waitpid(-1, WNOHANG);
- @childpids = grep { $_ != $pid } @childpids;
- } while($pid > 0);
-
- # run the unblocking procedure to check if enough time has passed to
- # unblock hosts that heve been blocked because of password failures
- if ($config{'blockhost_failures'}) {
- $i = 0;
- while ($i <= $#deny) {
- if ($blockhosttime{$deny[$i]} && $config{'blockhost_time'} != 0 &&
- ($time_now - $blockhosttime{$deny[$i]}) >= $config{'blockhost_time'}) {
- # the host can be unblocked now
- $hostfail{$deny[$i]} = 0;
- splice(@deny, $i, 1);
- }
- $i++;
- }
- }
-
- if ($config{'session'}) {
- # Remove sessions with more than 7 days of inactivity
- foreach $s (keys %sessiondb) {
- local ($user, $ltime) = split(/\s+/, $sessiondb{$s});
- if ($time_now - $ltime > 7*24*60*60) {
- delete($sessiondb{$s});
- }
- }
- }
- next if ($sel <= 0);
- if (vec($rmask, fileno(MAIN), 1)) {
- # got new connection
- $acptaddr = accept(SOCK, MAIN);
- if (!$acptaddr) { next; }
-
- # create pipes
- if ($config{'passdelay'} || $config{'session'}) {
- $PASSINr = "PASSINr$p"; $PASSINw = "PASSINw$p";
- $PASSOUTr = "PASSOUTr$p"; $PASSOUTw = "PASSOUTw$p";
- $p++;
- pipe($PASSINr, $PASSINw);
- pipe($PASSOUTr, $PASSOUTw);
- select($PASSINw); $| = 1; select($PASSINr); $| = 1;
- select($PASSOUTw); $| = 1; select($PASSOUTw); $| = 1;
- }
- select(STDOUT);
-
- # Check username of connecting user
- local ($peerp, $peera) = unpack_sockaddr_in($acptaddr);
- $localauth_user = undef;
- if ($config{'localauth'} && inet_ntoa($peera) eq "127.0.0.1") {
- if (open(TCP, "/proc/net/tcp")) {
- # Get the info direct from the kernel
- while(<TCP>) {
- s/^\s+//;
- local @t = split(/[\s:]+/, $_);
- if ($t[1] eq '0100007F' &&
- $t[2] eq sprintf("%4.4X", $peerp)) {
- $localauth_user = getpwuid($t[11]);
- last;
- }
- }
- close(TCP);
- }
- else {
- # Call lsof for the info
- local $lsofpid = open(LSOF,
- "$config{'localauth'} -i TCP\@127.0.0.1:$peerp |");
- while(<LSOF>) {
- if (/^(\S+)\s+(\d+)\s+(\S+)/ &&
- $2 != $$ && $2 != $lsofpid) {
- $localauth_user = $3;
- }
- }
- close(LSOF);
- }
- }
-
- # fork the subprocess
- if (!($handpid = fork())) {
- # setup signal handlers
- $SIG{'TERM'} = 'DEFAULT';
- $SIG{'PIPE'} = 'DEFAULT';
- #$SIG{'CHLD'} = 'IGNORE';
- $SIG{'HUP'} = 'IGNORE';
-
- # Initialize SSL for this connection
- if ($use_ssl) {
- $ssl_con = Net::SSLeay::new($ssl_ctx);
- Net::SSLeay::set_fd($ssl_con, fileno(SOCK));
- #Net::SSLeay::use_RSAPrivateKey_file(
- # $ssl_con, $config{'keyfile'},
- # &Net::SSLeay::FILETYPE_PEM);
- #Net::SSLeay::use_certificate_file(
- # $ssl_con, $config{'keyfile'},
- # &Net::SSLeay::FILETYPE_PEM);
- Net::SSLeay::accept($ssl_con) || exit;
- }
-
- # close useless pipes
- if ($config{'passdelay'} || $config{'session'}) {
- foreach $p (@passin) { close($p); }
- foreach $p (@passout) { close($p); }
- close($PASSINr); close($PASSOUTw);
- }
- close(MAIN);
-
- # Work out the hostname for this web server
- if (!$config{'host'}) {
- ($myport, $myaddr) =
- unpack_sockaddr_in(getsockname(SOCK));
- $myname = gethostbyaddr($myaddr, AF_INET);
- if ($myname eq "") {
- $myname = inet_ntoa($myaddr);
- }
- $host = $myname;
- }
- else { $host = $config{'host'}; }
- $port = $config{'port'};
-
- local $switched = 0;
- if ($config{'remoteuser'} && $localauth_user && !$<) {
- # Switch to the UID of the remote user
- local @u = getpwnam($localauth_user);
- if (@u) {
- $( = $u[3]; $) = "$u[3] $u[3]";
- $< = $> = $u[2];
- $switched = 1;
- }
- }
- if ($config{'switchuser'} && !$< && !$switched) {
- # Switch to the UID of server user
- local @u = getpwnam($config{'switchuser'});
- if (@u) {
- $( = $u[3]; $) = "$u[3] $u[3]";
- $< = $> = $u[2];
- }
- }
-
- while(&handle_request($acptaddr, getsockname(SOCK))) { }
- shutdown(SOCK, 1);
- close(SOCK);
- close($PASSINw); close($PASSOUTw);
- exit;
- }
- push(@childpids, $handpid);
- if ($config{'passdelay'} || $config{'session'}) {
- close($PASSINw); close($PASSOUTr);
- push(@passin, $PASSINr); push(@passout, $PASSOUTw);
- }
- close(SOCK);
- }
-
- if ($config{'listen'} && vec($rmask, fileno(LISTEN), 1)) {
- # Got UDP packet from another miniserv server
- local $rcvbuf;
- local $from = recv(LISTEN, $rcvbuf, 1024, 0);
- next if (!$from);
- local $fromip = inet_ntoa((unpack_sockaddr_in($from))[1]);
- local $toip = inet_ntoa((unpack_sockaddr_in(
- getsockname(LISTEN)))[1]);
- if ((!@deny || !&ip_match($fromip, $toip, @deny)) &&
- (!@allow || &ip_match($fromip, $toip, @allow))) {
- send(LISTEN, "$config{'host'}:$config{'port'}:".
- "$use_ssl", 0, $from);
- }
- }
-
- # check for password-timeout messages from subprocesses
- for($i=0; $i<@passin; $i++) {
- if (vec($rmask, fileno($passin[$i]), 1)) {
- # this sub-process is asking about a password
- $infd = $passin[$i]; $outfd = $passout[$i];
- $inline = <$infd>;
- if ($inline =~ /^delay\s+(\S+)\s+(\S+)\s+(\d+)/) {
- # Got a delay request from a subprocess.. for
- # valid logins, there is no delay (to prevent
- # denial of service attacks), but for invalid
- # logins the delay increases with each failed
- # attempt.
- if ($3) {
- # login OK.. no delay
- print $outfd "0 0\n";
- $hostfail{$2} = 0;
- }
- else {
- # login failed..
- $hostfail{$2}++;
- # add the host to the block list if necessary
- if ($config{'blockhost_failures'} &&
- $hostfail{$2} >= $config{'blockhost_failures'}) {
- push(@deny, $2);
- $blockhosttime{$2} = $time_now;
- $blocked = 1;
- if ($use_syslog) {
- local $logtext = "Security alert: Host $2 ".
- "blocked after $config{'blockhost_failures'} ".
- "failed logins for user $1";
- syslog("crit", $logtext);
- }
- }
- else {
- $blocked = 0;
- }
- $dl = $userdlay{$1} -
- int(($time_now - $userlast{$1})/50);
- $dl = $dl < 0 ? 0 : $dl+1;
- print $outfd "$dl $blocked\n";
- $userdlay{$1} = $dl;
- }
- $userlast{$1} = $time_now;
- }
- elsif ($inline =~ /^verify\s+(\S+)/) {
- # Verifying a session ID
- local $session_id = $1;
- if (!defined($sessiondb{$session_id})) {
- print $outfd "0 0\n";
- }
- else {
- local ($user, $ltime) = split(/\s+/, $sessiondb{$session_id});
- if ($config{'logouttime'} &&
- $time_now - $ltime > $config{'logouttime'}*60) {
- print $outfd "1 ",$time_now - $ltime,"\n";
- delete($sessiondb{$session_id});
- }
- else {
- print $outfd "2 $user\n";
- $sessiondb{$session_id} = "$user $time_now";
- }
- }
- }
- elsif ($inline =~ /^new\s+(\S+)\s+(\S+)/) {
- # Creating a new session
- $sessiondb{$1} = "$2 $time_now";
- }
- elsif ($inline =~ /^delete\s+(\S+)/) {
- # Logging out a session
- print $outfd $sessiondb{$1} ? 1 : 0,"\n";
- delete($sessiondb{$1});
- }
- else {
- # close pipe
- close($infd); close($outfd);
- $passin[$i] = $passout[$i] = undef;
- }
- }
- }
- @passin = grep { defined($_) } @passin;
- @passout = grep { defined($_) } @passout;
- }
-
-# handle_request(remoteaddress, localaddress)
-# Where the real work is done
-sub handle_request
-{
-$acptip = inet_ntoa((unpack_sockaddr_in($_[0]))[1]);
-$localip = $_[1] ? inet_ntoa((unpack_sockaddr_in($_[1]))[1]) : undef;
-if ($config{'loghost'}) {
- $acpthost = gethostbyaddr(inet_aton($acptip), AF_INET);
- $acpthost = $acptip if (!$acpthost);
- }
-else {
- $acpthost = $acptip;
- }
-$datestr = &http_date(time());
-$ok_code = 200;
-$ok_message = "Document follows";
-
-# Wait at most 60 secs for start of headers (but only for the first time)
-if (!$checked_timeout) {
- local $rmask;
- vec($rmask, fileno(SOCK), 1) = 1;
- local $sel = select($rmask, undef, undef, 60);
- $sel || &http_error(400, "Timeout");
- $checked_timeout++;
- }
-
-# Read the HTTP request and headers
-($reqline = &read_line()) =~ s/\r|\n//g;
-if (!($reqline =~ /^(GET|POST|HEAD)\s+(.*)\s+HTTP\/1\..$/)) {
- &http_error(400, "Bad Request");
- }
-$method = $1; $request_uri = $page = $2;
-%header = ();
-local $lastheader;
-while(1) {
- ($headline = &read_line()) =~ s/\r|\n//g;
- last if ($headline eq "");
- if ($headline =~ /^(\S+):\s+(.*)$/) {
- $header{$lastheader = lc($1)} = $2;
- }
- elsif ($headline =~ /^\s+(.*)$/) {
- $header{$lastheader} .= $headline;
- }
- else {
- &http_error(400, "Bad Header $headline");
- }
- }
-if (defined($header{'host'})) {
- if ($header{'host'} =~ /^([^:]+):([0-9]+)$/) { $host = $1; $port = $2; }
- else { $host = $header{'host'}; }
- }
-undef(%in);
-if ($page =~ /^([^\?]+)\?(.*)$/) {
- # There is some query string information
- $page = $1;
- $querystring = $2;
- if ($querystring !~ /=/) {
- $queryargs = $querystring;
- $queryargs =~ s/\+/ /g;
- $queryargs =~ s/%(..)/pack("c",hex($1))/ge;
- $querystring = "";
- }
- else {
- # Parse query-string parameters
- local @in = split(/\&/, $querystring);
- foreach $i (@in) {
- local ($k, $v) = split(/=/, $i, 2);
- $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
- $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
- $in{$k} = $v;
- }
- }
- }
-$posted_data = undef;
-if ($method eq 'POST' &&
- $header{'content-type'} eq 'application/x-www-form-urlencoded') {
- # Read in posted query string information
- $clen = $header{"content-length"};
- while(length($posted_data) < $clen) {
- $buf = &read_data($clen - length($posted_data));
- if (!length($buf)) {
- &http_error(500, "Failed to read POST request");
- }
- $posted_data .= $buf;
- }
- local @in = split(/\&/, $posted_data);
- foreach $i (@in) {
- local ($k, $v) = split(/=/, $i, 2);
- $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge;
- $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge;
- $in{$k} = $v;
- }
- }
-
-# replace %XX sequences in page
-$page =~ s/%(..)/pack("c",hex($1))/ge;
-
-# check address against access list
-if (@deny && &ip_match($acptip, $localip, @deny) ||
- @allow && !&ip_match($acptip, $localip, @allow)) {
- &http_error(403, "Access denied for $acptip");
- return 0;
- }
-
-if ($use_libwrap) {
- # Check address with TCP-wrappers
- if (!hosts_ctl("miniserv", STRING_UNKNOWN, $acptip, STRING_UNKNOWN)) {
- &http_error(403, "Access denied for $acptip");
- return 0;
- }
- }
-
-# check for the logout flag file, and if existant deny authentication
-if ($config{'logout'} && -r $config{'logout'}.$in{'miniserv_logout_id'}) {
- $deny_authentication++;
- open(LOGOUT, $config{'logout'}.$in{'miniserv_logout_id'});
- chop($count = <LOGOUT>);
- close(LOGOUT);
- $count--;
- if ($count > 0) {
- open(LOGOUT, ">$config{'logout'}$in{'miniserv_logout_id'}");
- print LOGOUT "$count\n";
- close(LOGOUT);
- }
- else {
- unlink($config{'logout'}.$in{'miniserv_logout_id'});
- }
- }
-
-# Check for password if needed
-if (%users) {
- $validated = 0;
- $blocked = 0;
-
- # Session authentication is never used for connections by
- # another miniserv server
- if ($header{'user-agent'} =~ /miniserv/i) {
- $config{'session'} = 0;
- }
-
- # check for SSL authentication
- if ($use_ssl && $verified_client) {
- $peername = Net::SSLeay::X509_NAME_oneline(
- Net::SSLeay::X509_get_subject_name(
- Net::SSLeay::get_peer_certificate(
- $ssl_con)));
- foreach $u (keys %certs) {
- if ($certs{$u} eq $peername) {
- $authuser = $u;
- $validated = 2;
- last;
- }
- }
- }
-
- # Check for normal HTTP authentication
- if (!$validated && !$deny_authentication && !$config{'session'} &&
- $header{authorization} =~ /^basic\s+(\S+)$/i) {
- # authorization given..
- ($authuser, $authpass) = split(/:/, &b64decode($1));
- $validated = &validate_user($authuser, $authpass);
-
- if ($config{'passdelay'} && !$config{'inetd'}) {
- # check with main process for delay
- print $PASSINw "delay $authuser $acptip $validated\n";
- <$PASSOUTr> =~ /(\d+) (\d+)/;
- $blocked = $2;
- sleep($1);
- }
- }
-
- # Check for new session validation
- if ($config{'session'} && !$deny_authentication && $page eq $config{'session_login'}) {
- local $ok = &validate_user($in{'user'}, $in{'pass'});
-
- # check if the test cookie is set
- if ($header{'cookie'} !~ /testing=1/ && $in{'user'}) {
- &http_error(500, "No cookies",
- "Your browser does not support cookies, ".
- "which are required for Webmin to work in ".
- "session authentication mode");
- }
-
- # check with main process for delay
- if ($config{'passdelay'} && $in{'user'}) {
- print $PASSINw "delay $in{'user'} $acptip $ok\n";
- <$PASSOUTr> =~ /(\d+) (\d+)/;
- $blocked = $2;
- sleep($1);
- }
-
- if ($ok) {
- # Logged in OK! Tell the main process about the new SID
- local $sid = time();
- local $mul = 1;
- foreach $c (split(//, crypt($in{'pass'}, substr($$, -2)))) {
- $sid += ord($c) * $mul;
- $mul *= 3;
- }
- print $PASSINw "new $sid $in{'user'}\n";
-
- # Set cookie and redirect
- &write_data("HTTP/1.0 302 Moved Temporarily\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{'server'}\r\n");
- $portstr = $port == 80 && !$use_ssl ? "" :
- $port == 443 && $use_ssl ? "" : ":$port";
- $prot = $use_ssl ? "https" : "http";
- if ($in{'save'}) {
- &write_data("Set-Cookie: sid=$sid; path=/; expires=\"Fri, 1-Jan-2038 00:00:01\"\r\n");
- }
- else {
- &write_data("Set-Cookie: sid=$sid; path=/\r\n");
- }
- &write_data("Location: $prot://$host$portstr$in{'page'}\r\n");
- &write_keep_alive(0);
- &write_data("\r\n");
- &log_request($acpthost, $authuser, $reqline, 302, 0);
- return 0;
- }
- elsif ($in{'logout'} && $header{'cookie'} =~ /sid=(\d+)/) {
- # Logout clicked .. remove the session
- print $PASSINw "delete $1\n";
- local $dummy = <$PASSINr>;
- $logout = 1;
- $already_session_id = undef;
- }
- else {
- # Login failed .. display the form again
- $failed_user = $in{'user'};
- $request_uri = $in{'page'};
- $already_session_id = undef;
- }
- }
-
- # Check for an existing session
- if ($config{'session'} && !$validated) {
- if ($already_session_id) {
- $session_id = $already_session_id;
- $authuser = $already_authuser;
- $validated = 1;
- }
- elsif (!$deny_authentication && $header{'cookie'} =~ /sid=(\d+)/) {
- $session_id = $1;
- print $PASSINw "verify $session_id\n";
- <$PASSOUTr> =~ /(\d+)\s+(\S+)/;
- if ($1 == 2) {
- # Valid session continuation
- $validated = 1;
- $authuser = $2;
- $already_session_id = $session_id;
- $already_authuser = $authuser;
- }
- elsif ($1 == 1) {
- # Session timed out
- $timed_out = $2;
- }
- else {
- # Invalid session ID .. don't set verified
- }
- }
- }
-
- # Check for local authentication
- if ($localauth_user) {
- if (defined($users{$localauth_user})) {
- $validated = 1;
- $authuser = $localauth_user;
- }
- else {
- $localauth_user = undef;
- }
- }
-
- if (!$validated) {
- if ($blocked == 0) {
- # No password given.. ask
- if ($config{'session'}) {
- # Force CGI for session login
- $validated = 1;
- if ($logout) {
- $querystring .= "&logout=1&page=/";
- }
- else {
- $querystring = "page=".&urlize($request_uri);
- }
- $querystring .= "&failed=$failed_user" if ($failed_user);
- $querystring .= "&timed_out=$timed_out" if ($timed_out);
- $queryargs = "";
- $page = $config{'session_login'};
- }
- else {
- # Ask for login with HTTP authentication
- &write_data("HTTP/1.0 401 Unauthorized\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{'server'}\r\n");
- &write_data("WWW-authenticate: Basic ".
- "realm=\"$config{'realm'}\"\r\n");
- &write_keep_alive(0);
- &write_data("Content-type: text/html\r\n");
- &write_data("\r\n");
- &reset_byte_count();
- &write_data("<html>\n");
- &write_data("<head><title>Unauthorized</title></head>\n");
- &write_data("<body><h1>Unauthorized</h1>\n");
- &write_data("A password is required to access this\n");
- &write_data("web server. Please try again. <p>\n");
- &write_data("</body></html>\n");
- &log_request($acpthost, undef, $reqline, 401, &byte_count());
- return 0;
- }
- }
- else {
- # when the host has been blocked, give it an error message
- &http_error(403, "Access denied for $acptip. The host has been blocked "
- ."because of too many authentication failures.");
- }
- }
-
- # Check per-user IP access control
- if ($deny{$authuser} && &ip_match($acptip, $localip, @{$deny{$authuser}}) ||
- $allow{$authuser} && !&ip_match($acptip, $localip, @{$allow{$authuser}})) {
- &http_error(403, "Access denied for $acptip");
- return 0;
- }
- }
-
-# Figure out what kind of page was requested
-rerun:
-$simple = &simplify_path($page, $bogus);
-$simple =~ s/[\000-\037]//g;
-if ($bogus) {
- &http_error(400, "Invalid path");
- }
-undef($full);
-if ($config{'preroot'}) {
- # Look in the template root directory first
- $is_directory = 1;
- $sofar = "";
- $full = $config{"preroot"} . $sofar;
- $scriptname = $simple;
- foreach $b (split(/\//, $simple)) {
- if ($b ne "") { $sofar .= "/$b"; }
- $full = $config{"preroot"} . $sofar;
- @st = stat($full);
- if (!@st) { undef($full); last; }
-
- # Check if this is a directory
- if (-d $full) {
- # It is.. go on parsing
- $is_directory = 1;
- next;
- }
- else { $is_directory = 0; }
-
- # Check if this is a CGI program
- if (&get_type($full) eq "internal/cgi") {
- $pathinfo = substr($simple, length($sofar));
- $pathinfo .= "/" if ($page =~ /\/$/);
- $scriptname = $sofar;
- last;
- }
- }
- if ($full) {
- if ($sofar eq '') {
- $cgi_pwd = $config{'root'};
- }
- else {
- "$config{'root'}$sofar" =~ /^(.*\/)[^\/]+$/;
- $cgi_pwd = $1;
- }
- if ($is_directory) {
- # Check for index files in the directory
- foreach $idx (split(/\s+/, $config{"index_docs"})) {
- $idxfull = "$full/$idx";
- if (-r $idxfull && !(-d $idxfull)) {
- $full = $idxfull;
- $is_directory = 0;
- $scriptname .= "/"
- if ($scriptname ne "/");
- last;
- }
- }
- }
- }
- }
-if (!$full || $is_directory) {
- $sofar = "";
- $full = $config{"root"} . $sofar;
- $scriptname = $simple;
- foreach $b (split(/\//, $simple)) {
- if ($b ne "") { $sofar .= "/$b"; }
- $full = $config{"root"} . $sofar;
- @st = stat($full);
- if (!@st) { &http_error(404, "File not found"); }
-
- # Check if this is a directory
- if (-d $full) {
- # It is.. go on parsing
- next;
- }
-
- # Check if this is a CGI program
- if (&get_type($full) eq "internal/cgi") {
- $pathinfo = substr($simple, length($sofar));
- $pathinfo .= "/" if ($page =~ /\/$/);
- $scriptname = $sofar;
- last;
- }
- }
- $full =~ /^(.*\/)[^\/]+$/; $cgi_pwd = $1;
- }
-
-# check filename against denyfile regexp
-local $denyfile = $config{'denyfile'};
-if ($denyfile && $full =~ /$denyfile/) {
- &http_error(403, "Access denied to $page");
- return 0;
- }
-
-# Reached the end of the path OK.. see what we've got
-if (-d $full) {
- # See if the URL ends with a / as it should
- if ($page !~ /\/$/) {
- # It doesn't.. redirect
- &write_data("HTTP/1.0 302 Moved Temporarily\r\n");
- $portstr = $port == 80 && !$use_ssl ? "" :
- $port == 443 && $use_ssl ? "" : ":$port";
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{server}\r\n");
- $prot = $use_ssl ? "https" : "http";
- &write_data("Location: $prot://$host$portstr$page/\r\n");
- &write_keep_alive(0);
- &write_data("\r\n");
- &log_request($acpthost, $authuser, $reqline, 302, 0);
- return 0;
- }
- # A directory.. check for index files
- foreach $idx (split(/\s+/, $config{"index_docs"})) {
- $idxfull = "$full/$idx";
- if (-r $idxfull && !(-d $idxfull)) {
- $cgi_pwd = $full;
- $full = $idxfull;
- $scriptname .= "/" if ($scriptname ne "/");
- last;
- }
- }
- }
-if (-d $full) {
- # This is definately a directory.. list it
- &write_data("HTTP/1.0 $ok_code $ok_message\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{server}\r\n");
- &write_data("Content-type: text/html\r\n");
- &write_keep_alive(0);
- &write_data("\r\n");
- &reset_byte_count();
- &write_data("<h1>Index of $simple</h1>\n");
- &write_data("<pre>\n");
- &write_data(sprintf "%-35.35s %-20.20s %-10.10s\n",
- "Name", "Last Modified", "Size");
- &write_data("<hr>\n");
- opendir(DIR, $full);
- while($df = readdir(DIR)) {
- if ($df =~ /^\./) { next; }
- (@stbuf = stat("$full/$df")) || next;
- if (-d "$full/$df") { $df .= "/"; }
- @tm = localtime($stbuf[9]);
- $fdate = sprintf "%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d",
- $tm[3],$tm[4]+1,$tm[5]+1900,
- $tm[0],$tm[1],$tm[2];
- $len = length($df); $rest = " "x(35-$len);
- &write_data(sprintf
- "<a href=\"%s\">%-${len}.${len}s</a>$rest %-20.20s %-10.10s\n",
- $df, $df, $fdate, $stbuf[7]);
- }
- closedir(DIR);
- &log_request($acpthost, $authuser, $reqline, $ok_code, &byte_count());
- return 0;
- }
-
-# CGI or normal file
-local $rv;
-if (&get_type($full) eq "internal/cgi") {
- # A CGI program to execute
- $envtz = $ENV{"TZ"};
- $envuser = $ENV{"USER"};
- $envpath = $ENV{"PATH"};
- foreach (keys %ENV) { delete($ENV{$_}); }
- $ENV{"PATH"} = $envpath if ($envpath);
- $ENV{"TZ"} = $envtz if ($envtz);
- $ENV{"USER"} = $envuser if ($envuser);
- $ENV{"HOME"} = $user_homedir;
- $ENV{"SERVER_SOFTWARE"} = $config{"server"};
- $ENV{"SERVER_NAME"} = $host;
- $ENV{"SERVER_ADMIN"} = $config{"email"};
- $ENV{"SERVER_ROOT"} = $config{"root"};
- $ENV{"SERVER_PORT"} = $port;
- $ENV{"REMOTE_HOST"} = $acpthost;
- $ENV{"REMOTE_ADDR"} = $acptip;
- $ENV{"REMOTE_USER"} = $authuser if (defined($authuser));
- $ENV{"SSL_USER"} = $peername if ($validated == 2);
- $ENV{"DOCUMENT_ROOT"} = $config{"root"};
- $ENV{"GATEWAY_INTERFACE"} = "CGI/1.1";
- $ENV{"SERVER_PROTOCOL"} = "HTTP/1.0";
- $ENV{"REQUEST_METHOD"} = $method;
- $ENV{"SCRIPT_NAME"} = $scriptname;
- $ENV{"REQUEST_URI"} = $request_uri;
- $ENV{"PATH_INFO"} = $pathinfo;
- $ENV{"PATH_TRANSLATED"} = "$config{root}/$pathinfo";
- $ENV{"QUERY_STRING"} = $querystring;
- $ENV{"MINISERV_CONFIG"} = $conf;
- $ENV{"HTTPS"} = "ON" if ($use_ssl);
- $ENV{"SESSION_ID"} = $session_id if ($session_id);
- $ENV{"LOCAL_USER"} = $localauth_user if ($localauth_user);
- if (defined($header{"content-length"})) {
- $ENV{"CONTENT_LENGTH"} = $header{"content-length"};
- }
- if (defined($header{"content-type"})) {
- $ENV{"CONTENT_TYPE"} = $header{"content-type"};
- }
- foreach $h (keys %header) {
- ($hname = $h) =~ tr/a-z/A-Z/;
- $hname =~ s/\-/_/g;
- $ENV{"HTTP_$hname"} = $header{$h};
- }
- $ENV{"PWD"} = $cgi_pwd;
- foreach $k (keys %config) {
- if ($k =~ /^env_(\S+)$/) {
- $ENV{$1} = $config{$k};
- }
- }
- delete($ENV{'HTTP_AUTHORIZATION'});
- $ENV{'HTTP_COOKIE'} =~ s/;?\s*sid=(\d+)//;
-
- # Check if the CGI can be handled internally
- open(CGI, $full);
- local $first = <CGI>;
- close(CGI);
- $first =~ s/[#!\r\n]//g;
- $nph_script = ($full =~ /\/nph-([^\/]+)$/);
- if (!$config{'forkcgis'} && $first eq $perl_path && $] >= 5.004) {
- # setup environment for eval
- chdir($ENV{"PWD"});
- @ARGV = split(/\s+/, $queryargs);
- $0 = $full;
- if ($posted_data) {
- # Already read the post input
- $postinput = $posted_data;
- }
- elsif ($method eq "POST") {
- $clen = $header{"content-length"};
- while(length($postinput) < $clen) {
- $buf = &read_data($clen - length($postinput));
- if (!length($buf)) {
- &http_error(500, "Failed to read ".
- "POST request");
- }
- $postinput .= $buf;
- }
- }
- $SIG{'CHLD'} = 'DEFAULT';
- eval {
- # Have SOCK closed if the perl exec's something
- use Fcntl;
- fcntl(SOCK, F_SETFD, FD_CLOEXEC);
- };
- shutdown(SOCK, 0);
-
- if ($config{'log'}) {
- open(MINISERVLOG, ">>$config{'logfile'}");
- chmod(0600, $config{'logfile'});
- }
- $doing_eval = 1;
- eval {
- package main;
- tie(*STDOUT, 'miniserv');
- tie(*STDIN, 'miniserv');
- do $miniserv::full;
- die $@ if ($@);
- };
- $doing_eval = 0;
- if ($@) {
- # Error in perl!
- &http_error(500, "Perl execution failed", $@);
- }
- elsif (!$doneheaders && !$nph_script) {
- &http_error(500, "Missing Headers");
- }
- #close(SOCK);
- $rv = 0;
- }
- else {
- # fork the process that actually executes the CGI
- pipe(CGIINr, CGIINw);
- pipe(CGIOUTr, CGIOUTw);
- pipe(CGIERRr, CGIERRw);
- if (!($cgipid = fork())) {
- chdir($ENV{"PWD"});
- close(SOCK);
- open(STDIN, "<&CGIINr");
- open(STDOUT, ">&CGIOUTw");
- open(STDERR, ">&CGIERRw");
- close(CGIINw); close(CGIOUTr); close(CGIERRr);
- exec($full, split(/\s+/, $queryargs));
- print STDERR "Failed to exec $full : $!\n";
- exit;
- }
- close(CGIINr); close(CGIOUTw); close(CGIERRw);
-
- # send post data
- if ($posted_data) {
- # already read the posted data
- print CGIINw $posted_data;
- }
- elsif ($method eq "POST") {
- $got = 0; $clen = $header{"content-length"};
- while($got < $clen) {
- $buf = &read_data($clen-$got);
- if (!length($buf)) {
- kill('TERM', $cgipid);
- &http_error(500, "Failed to read ".
- "POST request");
- }
- $got += length($buf);
- print CGIINw $buf;
- }
- }
- close(CGIINw);
- shutdown(SOCK, 0);
-
- if (!$nph_script) {
- # read back cgi headers
- select(CGIOUTr); $|=1; select(STDOUT);
- $got_blank = 0;
- while(1) {
- $line = <CGIOUTr>;
- $line =~ s/\r|\n//g;
- if ($line eq "") {
- if ($got_blank || %cgiheader) { last; }
- $got_blank++;
- next;
- }
- ($line =~ /^(\S+):\s+(.*)$/) ||
- &http_error(500, "Bad Header",
- &read_errors(CGIERRr));
- $cgiheader{lc($1)} = $2;
- }
- if ($cgiheader{"location"}) {
- &write_data("HTTP/1.0 302 Moved Temporarily\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{'server'}\r\n");
- &write_keep_alive(0);
- # ignore the rest of the output. This is a hack, but
- # is necessary for IE in some cases :(
- close(CGIOUTr); close(CGIERRr);
- }
- elsif ($cgiheader{"content-type"} eq "") {
- &http_error(500, "Missing Content-Type Header",
- &read_errors(CGIERRr));
- }
- else {
- &write_data("HTTP/1.0 $ok_code $ok_message\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{'server'}\r\n");
- &write_keep_alive(0);
- }
- foreach $h (keys %cgiheader) {
- &write_data("$h: $cgiheader{$h}\r\n");
- }
- &write_data("\r\n");
- }
- &reset_byte_count();
- while($line = <CGIOUTr>) {
- &write_data($line);
- }
- close(CGIOUTr); close(CGIERRr);
- $rv = 0;
- }
- }
-else {
- # A file to output
- local @st = stat($full);
- open(FILE, $full) || &http_error(404, "Failed to open file");
- &write_data("HTTP/1.0 $ok_code $ok_message\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{server}\r\n");
- &write_data("Content-type: ".&get_type($full)."\r\n");
- &write_data("Content-length: $st[7]\r\n");
- &write_data("Last-Modified: ".&http_date($st[9])."\r\n");
- &write_keep_alive();
- &write_data("\r\n");
- &reset_byte_count();
- while(read(FILE, $buf, 1024) > 0) {
- &write_data($buf);
- }
- close(FILE);
- $rv = &check_keep_alive();
- }
-
-# log the request
-&log_request($acpthost, $authuser, $reqline,
- $cgiheader{"location"} ? "302" : $ok_code, &byte_count());
-return $rv;
-}
-
-# http_error(code, message, body, [dontexit])
-sub http_error
-{
-close(CGIOUT);
-local $eh = $error_handler_recurse ? undef :
- $config{"error_handler_$_[0]"} ? $config{"error_handler_$_[0]"} :
- $config{'error_handler'} ? $config{'error_handler'} : undef;
-if ($eh) {
- # Call a CGI program for the error
- $page = "/$eh";
- $querystring = "code=$_[0]&message=".&urlize($_[1]).
- "&body=".&urlize($_[2]);
- $error_handler_recurse++;
- $ok_code = $_[0];
- $ok_message = $_[1];
- goto rerun;
- }
-else {
- # Use the standard error message display
- &write_data("HTTP/1.0 $_[0] $_[1]\r\n");
- &write_data("Server: $config{server}\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Content-type: text/html\r\n");
- &write_keep_alive(0);
- &write_data("\r\n");
- &reset_byte_count();
- &write_data("<h1>Error - $_[1]</h1>\n");
- if ($_[2]) {
- &write_data("<pre>$_[2]</pre>\n");
- }
- }
-&log_request($acpthost, $authuser, $reqline, $_[0], &byte_count())
- if ($reqline);
-shutdown(SOCK, 1);
-exit if (!$_[3]);
-}
-
-sub get_type
-{
-if ($_[0] =~ /\.([A-z0-9]+)$/) {
- $t = $mime{$1};
- if ($t ne "") {
- return $t;
- }
- }
-return "text/plain";
-}
-
-# simplify_path(path, bogus)
-# Given a path, maybe containing stuff like ".." and "." convert it to a
-# clean, absolute form.
-sub simplify_path
-{
-local($dir, @bits, @fixedbits, $b);
-$dir = $_[0];
-$dir =~ s/^\/+//g;
-$dir =~ s/\/+$//g;
-@bits = split(/\/+/, $dir);
-@fixedbits = ();
-$_[1] = 0;
-foreach $b (@bits) {
- if ($b eq ".") {
- # Do nothing..
- }
- elsif ($b eq "..") {
- # Remove last dir
- if (scalar(@fixedbits) == 0) {
- $_[1] = 1;
- return "/";
- }
- pop(@fixedbits);
- }
- else {
- # Add dir to list
- push(@fixedbits, $b);
- }
- }
-return "/" . join('/', @fixedbits);
-}
-
-# b64decode(string)
-# Converts a string from base64 format to normal
-sub b64decode
-{
- local($str) = $_[0];
- local($res);
- $str =~ tr|A-Za-z0-9+=/||cd;
- $str =~ s/=+$//;
- $str =~ tr|A-Za-z0-9+/| -_|;
- while ($str =~ /(.{1,60})/gs) {
- my $len = chr(32 + length($1)*3/4);
- $res .= unpack("u", $len . $1 );
- }
- return $res;
-}
-
-# ip_match(remoteip, localip, [match]+)
-# Checks an IP address against a list of IPs, networks and networks/masks
-sub ip_match
-{
-local(@io, @mo, @ms, $i, $j);
-@io = split(/\./, $_[0]);
-local $hn;
-if (!defined($hn = $ip_match_cache{$_[0]})) {
- $hn = gethostbyaddr(inet_aton($_[0]), AF_INET);
- $hn = "" if ((&to_ipaddress($hn))[0] ne $_[0]);
- $ip_match_cache{$_[0]} = $hn;
- }
-for($i=2; $i<@_; $i++) {
- local $mismatch = 0;
- if ($_[$i] =~ /^(\S+)\/(\S+)$/) {
- # Compare with network/mask
- @mo = split(/\./, $1); @ms = split(/\./, $2);
- for($j=0; $j<4; $j++) {
- if ((int($io[$j]) & int($ms[$j])) != int($mo[$j])) {
- $mismatch = 1;
- }
- }
- }
- elsif ($_[$i] =~ /^\*(\S+)$/) {
- # Compare with hostname regexp
- $mismatch = 1 if ($hn !~ /$1$/);
- }
- elsif ($_[$i] eq 'LOCAL') {
- # Compare with local network
- local @lo = split(/\./, $_[1]);
- if ($lo[0] < 128) {
- $mismatch = 1 if ($lo[0] != $io[0]);
- }
- elsif ($lo[0] < 192) {
- $mismatch = 1 if ($lo[0] != $io[0] ||
- $lo[1] != $io[1]);
- }
- else {
- $mismatch = 1 if ($lo[0] != $io[0] ||
- $lo[1] != $io[1] ||
- $lo[2] != $io[2]);
- }
- }
- else {
- # Compare with IP or network
- @mo = split(/\./, $_[$i]);
- while(@mo && !$mo[$#mo]) { pop(@mo); }
- for($j=0; $j<@mo; $j++) {
- if ($mo[$j] != $io[$j]) {
- $mismatch = 1;
- }
- }
- }
- return 1 if (!$mismatch);
- }
-return 0;
-}
-
-# restart_miniserv()
-# Called when a SIGHUP is received to restart the web server. This is done
-# by exec()ing perl with the same command line as was originally used
-sub restart_miniserv
-{
-close(SOCK); close(MAIN);
-foreach $p (@passin) { close($p); }
-foreach $p (@passout) { close($p); }
-if ($logclearer) { kill('TERM', $logclearer); }
-exec($perl_path, $miniserv_path, @miniserv_argv);
-die "Failed to restart miniserv with $perl_path $miniserv_path";
-}
-
-sub trigger_restart
-{
-$need_restart = 1;
-}
-
-sub to_ipaddress
-{
-local (@rv, $i);
-foreach $i (@_) {
- if ($i =~ /(\S+)\/(\S+)/ || $i =~ /^\*\S+$/ ||
- $i eq 'LOCAL') { push(@rv, $i); }
- else { push(@rv, join('.', unpack("CCCC", inet_aton($i)))); }
- }
-return @rv;
-}
-
-# read_line()
-# Reads one line from SOCK or SSL
-sub read_line
-{
-local($idx, $more, $rv);
-if ($use_ssl) {
- while(($idx = index($read_buffer, "\n")) < 0) {
- # need to read more..
- if (!($more = Net::SSLeay::read($ssl_con))) {
- # end of the data
- $rv = $read_buffer;
- undef($read_buffer);
- return $rv;
- }
- $read_buffer .= $more;
- }
- $rv = substr($read_buffer, 0, $idx+1);
- $read_buffer = substr($read_buffer, $idx+1);
- return $rv;
- }
-else { return <SOCK>; }
-}
-
-# read_data(length)
-# Reads up to some amount of data from SOCK or the SSL connection
-sub read_data
-{
-if ($use_ssl) {
- local($rv);
- if (length($read_buffer)) {
- $rv = $read_buffer;
- undef($read_buffer);
- return $rv;
- }
- else {
- return Net::SSLeay::read($ssl_con, $_[0]);
- }
- }
-else {
- local $buf;
- read(SOCK, $buf, $_[0]) || return undef;
- return $buf;
- }
-}
-
-# write_data(data)
-# Writes a string to SOCK or the SSL connection
-sub write_data
-{
-if ($use_ssl) {
- Net::SSLeay::write($ssl_con, $_[0]);
- }
-else {
- syswrite(SOCK, $_[0], length($_[0]));
- }
-$write_data_count += length($_[0]);
-}
-
-# reset_byte_count()
-sub reset_byte_count { $write_data_count = 0; }
-
-# byte_count()
-sub byte_count { return $write_data_count; }
-
-# log_request(hostname, user, request, code, bytes)
-sub log_request
-{
-if ($config{'log'}) {
- local(@tm, $dstr, $user, $ident, $headers);
- if ($config{'logident'}) {
- # add support for rfc1413 identity checking here
- }
- else { $ident = "-"; }
- @tm = localtime(time());
- $dstr = sprintf "%2.2d/%s/%4.4d:%2.2d:%2.2d:%2.2d %s",
- $tm[3], $make_date_marr[$tm[4]], $tm[5]+1900,
- $tm[2], $tm[1], $tm[0], $timezone;
- $user = $_[1] ? $_[1] : "-";
- if (fileno(MINISERVLOG)) {
- seek(MINISERVLOG, 0, 2);
- }
- else {
- open(MINISERVLOG, ">>$config{'logfile'}");
- chmod(0600, $config{'logfile'});
- }
- foreach $h (split(/\s+/, $config{'logheaders'})) {
- $headers .= " $h=\"$header{$h}\"";
- }
- print MINISERVLOG "$_[0] $ident $user [$dstr] \"$_[2]\" ",
- "$_[3] $_[4]$headers\n";
- close(MINISERVLOG);
- }
-}
-
-# read_errors(handle)
-# Read and return all input from some filehandle
-sub read_errors
-{
-local($fh, $_, $rv);
-$fh = $_[0];
-while(<$fh>) { $rv .= $_; }
-return $rv;
-}
-
-sub write_keep_alive
-{
-local $mode;
-if (@_) { $mode = $_[0]; }
-else { $mode = &check_keep_alive(); }
-&write_data("Connection: ".($mode ? "Keep-Alive" : "close")."\r\n");
-}
-
-sub check_keep_alive
-{
-return $header{'connection'} =~ /keep-alive/i;
-}
-
-sub term_handler
-{
-if (@childpids) {
- kill('TERM', @childpids);
- }
-exit(1);
-}
-
-sub http_date
-{
-local @tm = gmtime($_[0]);
-return sprintf "%s, %d %s %d %2.2d:%2.2d:%2.2d GMT",
- $weekday[$tm[6]], $tm[3], $month[$tm[4]], $tm[5]+1900,
- $tm[2], $tm[1], $tm[0];
-}
-
-sub TIEHANDLE
-{
-my $i; bless \$i, shift;
-}
-
-sub WRITE
-{
-$r = shift;
-my($buf,$len,$offset) = @_;
-&write_to_sock(substr($buf, $offset, $len));
-}
-
-sub PRINT
-{
-$r = shift;
-$$r++;
-&write_to_sock(@_);
-}
-
-sub PRINTF
-{
-shift;
-my $fmt = shift;
-&write_to_sock(sprintf $fmt, @_);
-}
-
-sub READ
-{
-$r = shift;
-substr($_[0], $_[2], $_[1]) = substr($postinput, $postpos, $_[1]);
-$postpos += $_[1];
-}
-
-sub OPEN
-{
-print STDERR "open() called - should never happen!\n";
-}
-
-sub READLINE
-{
-if ($postpos >= length($postinput)) {
- return undef;
- }
-local $idx = index($postinput, "\n", $postpos);
-if ($idx < 0) {
- local $rv = substr($postinput, $postpos);
- $postpos = length($postinput);
- return $rv;
- }
-else {
- local $rv = substr($postinput, $postpos, $idx-$postpos+1);
- $postpos = $idx+1;
- return $rv;
- }
-}
-
-sub GETC
-{
-return $postpos >= length($postinput) ? undef
- : substr($postinput, $postpos++, 1);
-}
-
-sub CLOSE { }
-
-sub DESTROY { }
-
-# write_to_sock(data, ...)
-sub write_to_sock
-{
-foreach $d (@_) {
- if ($doneheaders || $miniserv::nph_script) {
- &write_data($d);
- }
- else {
- $headers .= $d;
- while(!$doneheaders && $headers =~ s/^(.*)(\r)?\n//) {
- if ($1 =~ /^(\S+):\s+(.*)$/) {
- $cgiheader{lc($1)} = $2;
- }
- elsif ($1 !~ /\S/) {
- $doneheaders++;
- }
- else {
- &http_error(500, "Bad Header");
- }
- }
- if ($doneheaders) {
- if ($cgiheader{"location"}) {
- &write_data(
- "HTTP/1.0 302 Moved Temporarily\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{server}\r\n");
- &write_keep_alive(0);
- }
- elsif ($cgiheader{"content-type"} eq "") {
- &http_error(500, "Missing Content-Type Header");
- }
- else {
- &write_data("HTTP/1.0 $ok_code $ok_message\r\n");
- &write_data("Date: $datestr\r\n");
- &write_data("Server: $config{server}\r\n");
- &write_keep_alive(0);
- }
- foreach $h (keys %cgiheader) {
- &write_data("$h: $cgiheader{$h}\r\n");
- }
- &write_data("\r\n");
- &reset_byte_count();
- &write_data($headers);
- }
- }
- }
-}
-
-sub verify_client
-{
-local $cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($_[1]);
-if ($cert) {
- local $errnum = Net::SSLeay::X509_STORE_CTX_get_error($_[1]);
- $verified_client = 1 if (!$errnum);
- }
-return 1;
-}
-
-sub END
-{
-if ($doing_eval) {
- # A CGI program called exit! This is a horrible hack to
- # finish up before really exiting
- close(SOCK);
- &log_request($acpthost, $authuser, $reqline,
- $cgiheader{"location"} ? "302" : $ok_code, &byte_count());
- }
-}
-
-# urlize
-# Convert a string to a form ok for putting in a URL
-sub urlize {
- local($tmp, $tmp2, $c);
- $tmp = $_[0];
- $tmp2 = "";
- while(($c = chop($tmp)) ne "") {
- if ($c !~ /[A-z0-9]/) {
- $c = sprintf("%%%2.2X", ord($c));
- }
- $tmp2 = $c . $tmp2;
- }
- return $tmp2;
-}
-
-# validate_user(username, password)
-sub validate_user
-{
-return 0 if (!$_[0] || !$users{$_[0]});
-if ($users{$_[0]} eq 'x' && $use_pam) {
- $pam_username = $_[0];
- $pam_password = $_[1];
- local $pamh = new Authen::PAM("miniserv", $pam_username, \&pam_conv_func);
- if (!ref($pamh)) {
- print STDERR "PAM init failed : $pamh\n";
- return 0;
- }
- local $pam_ret = $pamh->pam_authenticate();
- return $pam_ret == PAM_SUCCESS ? 1 : 0;
- }
-else {
- return $users{$_[0]} eq crypt($_[1], $users{$_[0]}) ? 1 : 0;
- }
-}
-
-# the PAM conversation function for interactive logins
-sub pam_conv_func
-{
-my @res;
-while ( @_ ) {
- my $code = shift;
- my $msg = shift;
- my $ans = "";
-
- $ans = $pam_username if ($code == PAM_PROMPT_ECHO_ON() );
- $ans = $pam_password if ($code == PAM_PROMPT_ECHO_OFF() );
-
- push @res, PAM_SUCCESS();
- push @res, $ans;
- }
-push @res, PAM_SUCCESS();
-return @res;
-}
-
diff --git a/perl-install/standalone/interactive_http/miniserv.users b/perl-install/standalone/interactive_http/miniserv.users
deleted file mode 100644
index f7338497a..000000000
--- a/perl-install/standalone/interactive_http/miniserv.users
+++ /dev/null
@@ -1 +0,0 @@
-root:x:0
diff --git a/perl-install/standalone/keyboarddrake b/perl-install/standalone/keyboarddrake
deleted file mode 100755
index cef005041..000000000
--- a/perl-install/standalone/keyboarddrake
+++ /dev/null
@@ -1,50 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use keyboard;
-use Xconfig::xfree;
-use common;
-use any;
-use c;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/keyboard-mdk.png";
-my $in;
-my $keyboard = keyboard::read();
-if (my ($kb) = grep { !/^-/ } @ARGV) {
- keyboard::KEYBOARD2text($kb) or die "bad keyboard $kb\n";
- $keyboard->{KEYBOARD} = $kb;
-} else {
- $in = 'interactive'->vnew('su');
-
- choose:
- $keyboard->{KEYBOARD} = $in->ask_from_listf(N("Keyboard"),
- N("Please, choose your keyboard layout."),
- sub { translate(keyboard::KEYBOARD2text($_[0])) },
- [ keyboard::KEYBOARDs() ],
- $keyboard->{KEYBOARD}) or goto end;
-
- keyboard::group_toggle_choose($in, $keyboard) or goto choose;
-}
-
-if ($::expert) {
- my $isNotDelete = !$in->ask_yesorno("BackSpace", N("Do you want the BackSpace to return Delete in console?"), 1);
- $keyboard->{BACKSPACE} = $isNotDelete ? "BackSpace" : "Delete";
-}
-
-keyboard::setxkbmap($keyboard);
-eval {
- my $xfree_conf = Xconfig::xfree->read;
- my $xkb = keyboard::keyboard2full_xkb($keyboard);
- $xfree_conf->set_keyboard($xkb);
- $xfree_conf->write;
-};
-
-keyboard::write($keyboard);
-system('/etc/init.d/keytable', 'restart');
-
-end:
- $in->exit(0) if $in;
diff --git a/perl-install/standalone/listsupportedprinters b/perl-install/standalone/listsupportedprinters
deleted file mode 100755
index efd334409..000000000
--- a/perl-install/standalone/listsupportedprinters
+++ /dev/null
@@ -1,64 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2003-2004 Mandrakesoft
-#
-# Till Kamppeter <till@mandrakesoft.com>
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License Version 2 as
-# published by the Free Software Foundation.
-#
-# 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-use printer::main;
-
-# Data structure for printer data
-my $printer;
-
-# printer::main::read_printer_db() needs a spooler name ...
-$printer->{SPOOLER} = 'cups';
-
-# ... and the user mode (expert mode gives us more info)
-$printer->{expert} = 1;
-
-# Read the command line options
-my $commandline = join ('', @ARGV);
-
-# HELP !!!
-$commandline =~ /-(h\b|help)/i and print "
-Uasge: $ARGV[0] [--only-models] [--help]
-
-Shows list of supported printers and the drivers which support them.
-Manufacturer-supplied PPDs of native PostScript printers, manually added
-drivers, or installed updates are taken into account.
-
---only-models: Show only the model names, not the drivers
-
---help: This help page.
-
-" and exit 0;
-
-# Do we only need models and not drivers? Beginner's mode gives us the
-# needed info then.
-$commandline =~ /-only-models/i and $printer->{expert} = 0;
-
-# Build the list of supported printers
-printer::main::read_printer_db($printer, $printer->{SPOOLER});
-
-# Show the list on STDOUT
-foreach my $item (sort keys %printer::main::thedb) {
- print "$item\n";
-}
-
-
diff --git a/perl-install/standalone/localedrake b/perl-install/standalone/localedrake
deleted file mode 100644
index 9e6d97ba9..000000000
--- a/perl-install/standalone/localedrake
+++ /dev/null
@@ -1,70 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use common;
-use lang;
-use any;
-
-my ($klang, $kcountry, $apply);
-
-foreach (@ARGV) {
- $apply = /--apply/;
- $klang = $1 if /--kde_lang=(.*)/;
- $kcountry = uc($1) if /--kde_country=(.*)/;
-}
-
-if (defined $klang) {
- $klang or exit(-1);
- my $lang = member($klang, lang::list_langs()) ? $klang : 'en_US';
- my $country = member($kcountry, lang::list_countries()) ? $kcountry : 'US';
- my $locale = lang::read($>);
- $klang and $locale->{lang} = $lang;
- $kcountry and $locale->{country} = $country;
- lang::write($locale, $>, 'dont_touch_kde_files') if $apply;
-
- #- help KDE defaulting to the right charset
- print lang::charset2kde_charset(lang::l2charset($lang)), "\n";
- exit(0);
-}
-
-my $locale = lang::read($>);
-my $in = 'interactive'->vnew;
-
-$ugtk2::wm_icon = "localedrake";
-$::Wizard_title = N("LocaleDrake");
-
-sub select_country() {
- any::selectCountry($in, $locale);
-}
-
-eval {
- local $::isWizard = 1;
- local $::Wizard_no_previous = 1;
- language:
- my $old_lang = $locale->{lang};
- $locale->{lang} = any::selectLanguage($in, $locale->{lang});
- $locale->{IM} = lang::get_default_im($locale->{lang}) if $old_lang ne $locale->{lang};
- undef $::Wizard_no_previous;
- select_country() or goto language;
-};
-if ($@) {
- if ($@ =~ /^one lang only/) {
- select_country() or $in->exit(0);
- } elsif ($@ !~ /wizcancel/) {
- die;
- } else {
- $in->exit(0);
- }
-}
-
-lang::write($locale, $>);
-if ($>) {
- if (my $wm = any::running_window_manager()) {
- $in->ask_okcancel('', N("The change is done, but to be effective you must logout"), 1)
- and any::ask_window_manager_to_logout($wm);
- }
-}
diff --git a/perl-install/standalone/logdrake b/perl-install/standalone/logdrake
deleted file mode 100755
index eca83ced2..000000000
--- a/perl-install/standalone/logdrake
+++ /dev/null
@@ -1,517 +0,0 @@
-#! /usr/bin/perl
-# $Id$
-
-# Copyright (C) 2001-2004 Mandrakesoft
-# Yves Duret <yduret at mandrakesoft.com>
-# some code is Copyright: (C) 1999, Michael T. Babcock <mikebabcock@pobox.com>
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# TODO: consider switching from TreeView to gtkhtml
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use common;
-use interactive;
-use ugtk2 qw(:create :dialogs :helpers :wrappers);
-use vars qw(*F);
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/logdrake-mdk.png";
-my $in = 'interactive'->vnew('su');
-
-my ($isExplain, $Explain, $isFile, $File, $isWord, $Word);
-
-#- parse arguments list.
-foreach (@ARGV) {
- /^--explain=(.*)$/ and do { $isExplain = ($Explain) = $1; $isFile = 1; $File = "/var/log/explanations"; next };
- /^--file=(.*)$/ and do { $isFile = ($File) = $1; next };
- /^--word=(.*)$/ and do { $isWord = ($Word) = $1; next };
- /^--alert$/ and do { alert_config(); quit() };
-}
-
-my $isTail = 1 if $isFile;
-$| = 1 if $isTail;
-my $h = chomp_(`hostname -s`);
-
-$ugtk2::wm_icon = "logdrake";
-my $explain_title = N("Mandrakelinux Tools Logs");
-my $my_win = ugtk2->new($isExplain ? $explain_title : N("Logdrake"));
-
-unless ($::isEmbedded) {
- $my_win->{window}->set_border_width(5);
- #$my_win->{window}->set_default_size(540,460);
-}
-$my_win->{window}->signal_connect(delete_event => \&quit);
-
-my $cal = gtkset_sensitive(Gtk2::Calendar->new, 0);
-my $mday = (localtime(time()))[3];
-$cal->select_day($mday);
-my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-my $cal_mode = 0;
-my $cal_butt = gtksignal_connect(Gtk2::CheckButton->new(N("Show only for the selected day")), clicked => sub { $cal_mode = !$cal_mode; gtkset_sensitive($cal,$cal_mode) });
-
-### menus definition
-# the menus are not shown
-# but they provides shiny shortcut like C-q
-my @menu_items = (
- { path => N("/_File"), item_type => '<Branch>' },
- { path => N("/File/_New"), accelerator => N("<control>N") },
- { path => N("/File/_Open"), accelerator => N("<control>O") },
- { path => N("/File/_Save"), accelerator => N("<control>S"), callback => \&save },
- { path => N("/File/Save _As") },
- { path => N("/File/-"), item_type => '<Separator>' },
- { path => N("/File/_Quit"), accelerator => N("<control>Q"), callback => \&quit },
- { path => N("/_Options"), item_type => '<Branch>' },
- { path => N("/Options/Test") },
- { path => N("/_Help"), item_type => '<LastBranch>' },
- { path => N("/Help/_About...") }
- );
-my $_menubar = create_factory_menu($my_win->{rwindow}, @menu_items) unless $::isEmbedded;
-######### menus end
-
-
-########## font and colors
-
-
-# Define global terms:
-# Define good notables:
-my @word_good = ("starting\n", "Freeing", "Detected", "starting.", "accepted.\n", "authenticated.\n", "Ready", "active", "reloading", "saved;", "restarting", "ONLINE\n");
-my @word_warn = ("dangling", "closed.\n", "Assuming", "root", "root\n", "exiting\n", "missing", "Ignored", "adminalert:", "deleting", "OFFLINE\n");
-my @word_bad = "bad";
-my @word_note = ("LOGIN", "DHCP_OFFER", "optimized", "reset:", "unloaded", "disconnected", "connect", "Successful", "registered\n");
-#my @line_good = ("up", "DHCP_ACK", "Cleaned", "Initializing", "Starting", "success", "successfully", "alive", "found", "ONLINE\n");
-#my @line_warn = ("warning:", "WARNING:", "invalid", "obsolete", "bad", "Password", "detected", "timeout", "timeout:", "attackalert:", "wrong", "Lame", "FAILED", "failing", "unknown", "obsolete", "stopped.\n", "terminating.", "disabled\n", "disabled", "Lost");
-#my @line_bad = ("DENY", "lost", "shutting", "dead", "DHCP_NAK", "failure;", "Unable", "inactive", "terminating", "refused", "rejected", "down", "OFFLINE\n", "error\n", "ERROR\n", "ERROR:", "error", "ERROR", "error:", "failed:");
-
-# Now define what we want to use when:
-my $col_good = 'green4';
-my $col_warn = 'yellow4';
-my $col_bad = 'red';
-my $col_note = 'purple';
-my $col = 'darkcyan';
-
-######### font and colors end
-
-my %files = (
- "auth" => { file => "/var/log/auth.log", desc => N("_:this is the auth.log log file\nAuthentication") },
- "user" => { file => "/var/log/user.log", desc => N("_:this is the user.log log file\nUser") },
- "messages" => { file => "/var/log/messages", desc => N("_:this is the /var/log/messages log file\nMessages") },
- "syslog" => { file => "/var/log/syslog", desc => N("_:this is the /var/log/syslog log file\nSyslog") },
- "explanations" => { file => "/var/log/explanations", desc => $explain_title }
-);
-
-my $yy = gtkset_sensitive(gtksignal_connect(Gtk2::Button->new(N("search")) , clicked => \&search),0);
-
-my $log_text = gtktext_insert(Gtk2::TextView->new, [ [ '' ] ]);
-
-my $log_buf = $log_text->get_buffer;
-my $refcount_search;
-#### far from window
-
-my %toggle;
-
-gtkadd($my_win->{window},
- gtkpack_(Gtk2::VBox->new(0,0),
- if_(!$isExplain && !$::isEmbedded, 0, N("A tool to monitor your logs")),
- if_(!$isFile, 0, gtkadd(Gtk2::Frame->new(N("Settings")),
- gtkpack__(Gtk2::VBox->new(0,2),
- gtkpack__(Gtk2::VBox->new(0,2),
- # N("Show lines"),
- gtkpack__(Gtk2::HBox->new(0,0),
- " " . N("Matching") . " ", my $e_yes = Gtk2::Entry->new,
- " " . N("but not matching") . " ", my $e_no = Gtk2::Entry->new
- )
- ),
- gtkpack_(Gtk2::HBox->new(0,0),
- 1, gtkadd(gtkset_border_width(Gtk2::Frame->new(N("Choose file")),2),
- gtkpack(gtkset_border_width(Gtk2::VBox->new(0,0),0),
- map { $toggle{$_} = gtksignal_connect(Gtk2::CheckButton->new($files{$_}{desc}),
- clicked => sub {
- $refcount_search++;
- gtkset_sensitive($yy, $refcount_search);
- }) } sort keys %files,
- )
- ),
- 0, gtkadd(gtkset_border_width(Gtk2::Frame->new(N("Calendar")),2),
- gtkpack__(gtkset_border_width(Gtk2::VBox->new(0,0),5),
- $cal_butt, $cal
- )
- )
- ),
- $yy,
- )
- )
- ),
- !$isExplain ? (1, gtkadd(Gtk2::Frame->new(N("Content of the file")),
- create_scrolled_window($log_text)
- )) : (1, create_scrolled_window($log_text)),
- if_(!$isExplain, 0, gtkadd(gtkset_border_width(gtkset_layout(Gtk2::HButtonBox->new, 'end'), 5),
- if_(!$isFile, gtksignal_connect(Gtk2::Button->new(N("Mail alert")),
- clicked => sub {
- eval { alert_config() };
- my $err = $@;
- $::WizardWindow->destroy if defined $::WizardWindow;
- undef $::WizardWindow;
- if ($err && $err !~ /wizcancel/) {
- err_dialog(N("Error"), N("The alert wizard has failed unexpectedly:")
- . "\n\n" . $err);
- }
- })),
- gtksignal_connect(Gtk2::Button->new(N("Save")), clicked => \&save),
- gtksignal_connect(Gtk2::Button->new($::isEmbedded ? N("Cancel") : N("Quit")), clicked => \&quit)
- )
- )
- )
- );
-
-$isFile && !$::isEmbedded and gtkset_size_request($log_text, 400, 500);
-
-$my_win->{window}->show_all;
-search() if $isFile;
-$my_win->main;
-
-sub quit() { ugtk2->exit(0) }
-
-#-------------------------------------------------------------
-# search functions
-#-------------------------------------------------------------
-sub search() {
- return if !$log_text->window;
- $log_text->window->freeze_updates;
- $log_buf->set_text('');
- if ($isFile) {
- parse_file($File, $File);
- } else {
- foreach (keys %files) {
- parse_file($files{$_}{file}, $files{$_}{desc}) if $toggle{$_}->get_active;
- }
- }
- $log_text->window->thaw_updates;
- $log_text->show;
- gtkflush();
-}
-
-my $timer;
-
-my @logs;
-
-my $F;
-
-sub parse_file {
- my ($file, $descr) = @_;
-
- $file =~ s/\.gz$//;
- my ($pbar, $win_pb);
- unless ($::isEmbedded && $isExplain) {
- gtkadd($win_pb = gtkset_modal(Gtk2::Window->new('toplevel'), 1),
- gtkpack(Gtk2::VBox->new(2,0),
- Gtk2::Label->new(" " . N("please wait, parsing file: %s", $descr) . " "),
- $pbar = Gtk2::ProgressBar->new
- )
- );
- $win_pb->set_transient_for($my_win->{rwindow}) unless $::isEmbedded;
- $win_pb->set_position('center');
- $win_pb->realize;
- $win_pb->show_all;
- gtkflush();
- }
- my $ey = $e_yes->get_chars(0, -1);
- my $en = $e_no->get_chars(0, -1);
- $ey =~ s/ OR /|/;
- $ey =~ s/^\*$//;
- $en =~ s/^\*$/.*/;
- $ey = $ey . $Word if $isWord;
-
- if ($cal_mode) {
- my (undef, $month, $day) = $cal->get_date;
- $ey = $months[$month]."\\s{1,2}$day\\s.*$ey.*\n";
- }
-
- my @all = catMaybeCompressed($file);
-
- if ($isExplain) {
- my (@t, $t);
- while (@all) {
- $t = pop @all;
- next if $t =~ /logdrake/;
- last if $t !~ /$Explain/;
- push @t, $t;
- }
- @all = reverse @t;
- }
-
- my $taille = @all;
- my $i = 0;
- my $test;
- if ($en && !$ey) {
- $test = sub { !/$en/ };
- } elsif ($ey && !$en) {
- $test = sub { /$ey/ };
- } else {
- $test = sub { /$ey/ && !/$en/ };
- }
-
- foreach (@all) {
- $i++;
- if ($pbar && $i % 10) {
- $pbar->set_fraction($i/$taille);
- $win_pb->window->process_updates(1); # no gtkflush() because we do not want to refresh the TextView
- }
-
- logcolorize($_) if $test->();
- }
- $win_pb->destroy if !$::isEmbedded || !$isExplain;
-
- if ($isTail) {
- close $F;
- open $F, $file or die "E: $!";
- local $_;
- while (<$F>) {}; #to prevent to output the file twice..
-# $log_text->set_point($log_text->get_length());
- $timer ||= Glib::Timeout->add(1000, sub {
- logcolorize($_) while <$F>;
- seek $F, 0, 1;
- });
- }
- insert_text_n_scroll();
-}
-
-
-##########################################################################################
-
-sub logcolorize {
- local $_ = shift; #my ($data) = @_;
-
- # we get date & time if it is date & time (dmesg)
- s/(\D{3} .. (\d\d:\d\d:\d\d ))//;
- my $timestamp = $isExplain ? $2 : $1;
- my @rec = split;
-
- log_output($timestamp, 'Bold', 'darkcyan'); # date & time if any...
- # BUG: $col hasn't yet be reseted
- $isExplain or log_output("$rec[0] ", 'Bold', $rec[0] eq $h ? 'blue' : $col); # hostname
-
- if ($rec[1] eq "last") {
- log_output(" last message repeated ", undef, 'green');
- log_output($rec[4], 'Bold', 'green');
- log_output(" times\n", undef, 'green');
- return;
- }
- # Extract PID if present
- if ($rec[1] =~ /\[(\d+)\]:/) {
- my $pid = $1;
- $rec[1] =~ s/\[$1\]://;
- log_output($rec[1] . "[", undef, 'green');
- log_output($pid, 'Bold', 'black');
- log_output("]: ", undef, 'green');
- }
- else {
- log_output($rec[1] . " ", undef, 'green');
- }
-
- foreach my $therest (2 .. $#rec) {
- $col = 'darkcyan';
-
- # Check for keywords to highlight
- foreach (@word_good) { $col = $col_good if $_ eq $rec[$therest] }
- foreach (@word_warn) { $col = $col_warn if $_ eq $rec[$therest] }
- foreach (@word_bad) { $col = $col_bad if $_ eq $rec[$therest] }
- foreach (@word_note) { $col = $col_note if $_ eq $rec[$therest] }
-
- # Watch for words that indicate entire lines should be highlighted
- #foreach (@line_good) { $col = $col_good if $_ eq $rec[$therest] }
- #foreach (@line_warn) { $col = $col_warn if $_ eq $rec[$therest] }
- #foreach (@line_bad) { $col = $col_bad if $_ eq $rec[$therest] }
-
- log_output("$rec[$therest] ", undef, $col);
- }
- log_output("\n", undef, 'black');
- insert_text_n_scroll() if $isExplain;
-}
-
-
-# log_output (Gtk2::TextView, [ [ ... ] ])
-sub log_output {
- my ($text, $font, $col) = @_;
- my $tag = join('', $font, $col);
- push @logs, [ $text, $tag ];
- $log_buf->{tags}{$tag} ||= { if_($font, font => $font), foreground => $col };
-}
-
-sub insert_text_n_scroll() {
- ugtk2::gtktext_insert($log_text, \@logs, append => !($isExplain || $isTail));
- $log_text->scroll_to_iter($log_buf->get_end_iter, 0, 1, 0.5, 0.5);
- undef @logs;
-}
-
-
-#-------------------------------------------------------------
-# mail/sms alert
-#-------------------------------------------------------------
-
-sub alert_config() {
- local $::isEmbedded = 0;
- undef $::WizardTable;
- undef $::WizardWindow;
- my $conffile = "/etc/sysconfig/mail_alert";
- my %options = getVarsFromSh($conffile);
- $options{LOAD} ||= 3;
- $options{MAIL} ||= "root";
- $options{SMTP} ||= "localhost";
-
- my $service = {
- httpd => N("Apache World Wide Web Server"),
- bind => N("Domain Name Resolver"),
- ftp => N("Ftp Server"),
- postfix => N("Postfix Mail Server"),
- samba => N("Samba Server"),
- sshd => N("SSH Server"),
- webmin => N("Webmin Service"),
- xinetd => N("Xinetd Service")
- };
- my @installed_d = grep { -e "/etc/init.d/$_" } sort keys %$service;
- my %services_to_check = map { $_ => 1 } split(':', $options{SERVICES});
-
- $::isWizard = 1;
- use wizards;
- my $w = wizards->new;
- my $mode;
- my $cron_file = "/etc/cron.hourly/logdrake_service";
- my %modes = (
- configure => N("Configure the mail alert system"),
- disable => N("Stop the mail alert system"),
- );
- my $wiz = {
- defaultimage => "logdrake.png",
- name => N("Mail alert"),
- pages => {
- welcome => {
- name => N("Mail alert configuration") . "\n\n" .
- N("Welcome to the mail configuration utility.\n\nHere, you'll be able to set up the alert system.\n"),
- no_back => 1,
- data => [
- { val => \$mode, label => N("What do you want to do?"),
- list => [ keys %modes ], format => sub { $modes{$_[0]} }, },
- ],
-
- post => sub { $mode eq 'configure' ? 'services' : 'stop' },
- },
- services => {
- name => N("Services settings") . "\n\n" .
- N("You will receive an alert if one of the selected services is no longer running"),
- data => [ map { { label => $_, val => \$services_to_check{$_},
- type => "bool", text => $service->{$_} } } @installed_d ],
- next => "load",
- },
- load => {
- #PO- Here "load" is a noun; that is load refers to the system/CPU) load
- name => N("Load setting") . "\n\n" .
- N("You will receive an alert if the load is higher than this value"),
- data => [ { label => N("_: load here is a noun, the load of the system\nLoad"),
- val => \$options{LOAD}, type => 'range', min => 1, max => 50 } ],
- next => "email",
- },
- email => {
- name => N("Alert configuration") . "\n\n" .
- N("Please enter your email address below ") . "\n" .
- N("and enter the name (or the IP) of the SMTP server you wish to use"),
- data => [
- { label => "Email address", val => \$options{MAIL} },
- { label => "Email server", val => \$options{SMTP} },
- ],
- complete => sub {
- if ($options{MAIL} !~ /[\w.-]*\@[\w.-]/ && !member($options{MAIL}, map { $_->[0] } list_passwd())) {
- err_dialog(N("Error"), N("\"%s\" neither is a valid email nor is an existing local user!",
- $options{MAIL}));
- return 1;
- }
- if (member($options{MAIL}, map { $_->[0] } list_passwd()) && $options{SMP} !~ /localhost/) {
- err_dialog(N("Error"), N("\"%s\" is a local user, but you did not select a local smtp, so you must use a complete email address!", $options{MAIL}));
- return 1;
- }
- },
- next => "end",
- },
- end => {
- name => N("Congratulations") . "\n\n" . N("The wizard successfully configured the mail alert."),
- end => 1,
- no_back => 1,
- },
- stop => {
- pre => sub { eval { rm_rf($cron_file) } },
- name => N("Congratulations") . "\n\n" . N("The wizard successfully disabled the mail alert."),
- end => 1,
- no_back => 1,
- },
- },
- };
- $w->process($wiz, $in);
- return if $mode eq 'disable';
-
- $options{SERVICES} = join ':', grep { $services_to_check{$_} } sort keys %services_to_check;
-
- use Data::Dumper;
- output_with_perm $cron_file, 0755, q(#!/usr/bin/perl
-# generated by logdrake
-use MDK::Common;
-my $r;
-my %options = getVarsFromSh("/etc/sysconfig/mail_alert");
-
-#- check services
-my ) . Data::Dumper->Dump([ $service ], [qw(*services)]) . q(
-foreach (split(':', $options{SERVICES})) {
- next unless $services{$_};
- $r .= "Service $_ ($services{$_} is not running)\\n" unless -e "/var/lock/subsys/$_";
-}
-
-#- load
-my ($load) = split ' ', first(cat_("/proc/loadavg"));
-$r .= "Load is huge: $load\n" if $load > $options{LOAD};
-
-#- report it
-if ($r) {
- use Mail::Mailer;
- my $mailer = Mail::Mailer->new('smtp', Server => $options{SMTP});
- $mailer->open({ From => 'root@localhost',
- To => $options{MAIL},
- Subject => "DrakLog Mail Alert",
- })
- or die "Can't open: $!\n";
- print $mailer $r;
- $mailer->close;
-}
-
-# EOF);
- setVarsInSh($conffile, \%options);
-
- if (defined $::WizardWindow) {
- $::WizardWindow->destroy;
- undef $::WizardWindow;
- }
-}
-
-
-#-------------------------------------------------------------
-# menu callback functions
-#-------------------------------------------------------------
-
-
-sub save() {
- $::isWizard = 0;
- my $y = $in->ask_file(N("Save as.."), "/root") or return;
- my $buf = $log_text->get_buffer;
- output($y, $buf->get_text(($buf->get_bounds), 0));
-}
diff --git a/perl-install/standalone/lsnetdrake b/perl-install/standalone/lsnetdrake
deleted file mode 100755
index d6233209d..000000000
--- a/perl-install/standalone/lsnetdrake
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-use network::nfs;
-use network::smb;
-use MDK::Common::Func qw(if_);
-
-"@ARGV" =~ /-h/ and die "usage: lsnetdrake [-h] [--nfs] [--smb]\n";
-
-my $nfs = !@ARGV || "@ARGV" =~ /-(nfs)/;
-my $smb = !@ARGV || "@ARGV" =~ /-(smb)/;
-
-$| = 1;
-$ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";
-
-foreach my $class (if_($nfs, network::nfs->new), if_($smb, network::smb->new)) {
- foreach my $server (sort_names($class->find_servers)) {
- foreach (sort_names(eval { $class->find_exports($server) })) {
- print $class->to_fullstring($_), "\n";
- }
- }
-}
-
-sub sort_names {
- sort { $a->{name} cmp $b->{name} } @_;
-}
diff --git a/perl-install/standalone/man/C/man5/drakbackup.conf.5 b/perl-install/standalone/man/C/man5/drakbackup.conf.5
deleted file mode 100644
index 20abef201..000000000
--- a/perl-install/standalone/man/C/man5/drakbackup.conf.5
+++ /dev/null
@@ -1,180 +0,0 @@
-.\"
-.TH drakbackup.conf 5 "March 2004" Mandrakesoft "System Utilities"
-.SH NAME
-drakbackup.conf
-
-.SH DESCRIPTION
-Drakbackup uses a number of configuration file options to store the user's preferences as to what/where/when data is backed up. Normally these options are set from withing the GUI, but it is also possible to manually edit the file. This manpage attempts to explain the recognized options and what they are used for.
-
-The default configuration file is located in:
-
- Root Mode: /etc/drakxtools/drakbackup/drakbackup.conf
- User Mode: ~/.drakbackup/drakbackup.conf
-
-.B "Option definitions"
-(all options are either =1, or have some text/numeric value or list of values):
-
-.B
- SYS_FILES
- Comma separated list of system directories to backup.
-.B
- HOME_FILES
- Comma separated list of user home directories to backup.
-.B
- OTHER_FILES
- Comma separated list of other files to backup.
-.B
- PATH_TO_SAVE
- Default Hard Drive path to create backup files in.
- Root Mode: default is /var/lib/drakbackup
- User Mode: default is ~/.drakbackup/backups
-.B
- NO_SYS_FILES
- Don't backup system files (default for non\-root).
-.B
- NO_USER_FILES
- Don't backup user files.
-.B
- BACKUPIGNORE
- Honor .backupignore files in backup directories.
-.B
- OPTION_COMP
- Compression option (tar.gz, tar.bz2, tar \- tar.gz is default).
-.B
- NO_BROWSER_CACHE
- Skip web browser cache.
-.B
- CDRW
- Backup media is re\-writable CD.
-.B
- DVDR
- Backup media is recordable DVD (not fully supported yet).
-.B
- DVDRW
- Backup media is recordable DVD+RW.
-.B
- DVDRAM
- Backup media is DVDRAM (not fully supported yet).
-.B
- NET_PROTO
- Network protocol to use for remote backups: (ftp, rsync, ssh, or webdav)
-.B
- HOST_NAME
- Remote backup host.
-.B
- HOST_PATH
- Backup storage path or module on remote host.
-.B
- REMEMBER_PASS
- Remember password on remote host in config file.
-.B
- USER_KEYS
- Ssh keys are already setup for communicating with remote host.
-.B
- DRAK_KEYS
- Use special drakbackup generated host keys.
- (requires perl\-Expect)
-.B
- USE_EXPECT
- Use expect to do the whole scp transfer, without keys.
- (requires perl\-Expect)
-.B
- LOGIN
- Remote host login name.
-.B
- PASSWD
- Password on remote host (if REMEMBER_PASS is enabled).
-.B
- DAEMON_MEDIA
- Daemon mode backup via given media.
- (hd, cd, tape, ftp, rsync, ssh, or webdav)
-.B
- HD_QUOTA
- Use quota to limit hard drive space used for backups.
- (not supported yet)
-.B
- USE_HD
- Use Hard Drive for backups.
- (currently all modes use HD also for temporary storage)
-.B
- MAX_SPACE
- Maximum Hard Drive Space(MB) to consume for backups.
-.B
- USE_CD
- Use CD for backups.
-.B
- USE_NET
- Use network for backups (driven by NET_PROTO).
-.B
- USE_TAPE
- Use tape for backup.
-.B
- DEL_HD_FILES
- Delete local hard drive tar files after backup to other media.
-.B
- TAPE_NOREWIND
- Use non\-rewinding tape device.
-.B
- CD_TIME
- Length of CD media (not currently utilized).
-.B
- DAEMON_TIME_SPACE
- Interval between daemon backup runs (hourly, daily, weekly, custom).
-.B
- CD_WITH_INSTALL_BOOT
- Build a bootable restore CD (currently not utilized).
-.B
- CD_DEVICE
- Cdrecord style CD device name (ie: 1,3,0, or ATAPI:/dev/hdc).
-.B
- USER_MAIL
- User to send backup results to via email.
-.B
- SMTP_SERVER
- Mail server to use for sending mail.
-.B
- SEND_MAIL
- Do send backup results via email.
-.B
- TAPE_DEVICE
- Device to use for tape backup (ie: /dev/st0).
-.B
- MEDIA_ERASE
- Erase media before new backup (applies to tape, CD).
-.B
- MEDIA_EJECT
- Eject media after backup completes.
-.B
- MULTI_SESSION
- Allow muliple sessions to be written to CD media.
-.B
- SYS_INCREMENTAL_BACKUPS
- Do incremental or differential backups of system files.
-.B
- USER_INCREMENTAL_BACKUPS
- Do incremental or differential backups of user files.
-.B
- OTHER_INCREMENTAL_BACKUPS
- Do incremental or differential backups if other files.
-.B
- SYS_DIFFERENTIAL_BACKUPS
- Do differential backups of system files.
-.B
- USER_DIFFERENTIAL_BACKUPS
- Do differential backups of user files.
-.B
- OTHER_DIFFERENTIAL_BACKUPS
- Do differential backups if other files.
-.B
- NO_CRITICAL_SYS
- Do not backup critical system files: (passwd, fstab, group, mtab)
-.B
- CRITICAL_SYS
- Do backup above system files.
-
-.SH "SEE ALSO"
-/usr/share/doc/mandrake/en/Drakxtools-Guide.html/drakbackup.html
-
-.SH AUTHOR
-Stew Benedict <sbenedict@mandrakesoft.com>
-
diff --git a/perl-install/standalone/man/C/man8/drakconnect.8 b/perl-install/standalone/man/C/man8/drakconnect.8
deleted file mode 100644
index f8ba1438b..000000000
--- a/perl-install/standalone/man/C/man8/drakconnect.8
+++ /dev/null
@@ -1,109 +0,0 @@
-.TH DRAKCONNECT 8 "17 November 2003" "drakxtools" "Linux Administrator's Manual"
-.SH NAME
-drakconnect \- configure network interfaces
-.SH SYNOPSIS
-.B "drakconnect"
-.br
-.B "drakconnect --skip-wizard"
-.SH DESCRIPTION
-.B Drakconnect
-is used to configure the network interfaces.
-
-Drakconnect handle ISDN, modems, xDSL, LAN as well as wirelless
-connexions.
-
-There's two main modes: the wizard mode and the "embedded in mcc" view
-(the manage interface). In the wizard mode, drakconnect detect all
-network interfaces and offer to configure them.
-
-.SH OPTIONS
-.TP
-.B "\-\-del"
-Delete a network interface and all related files
-.TP
-.B "\-\-expert"
-Expert mode; give access to more options (advanced options are shown by
-default and some extra steps occured in the wizard)
-.TP
-.B "\-\-help"
-Display short description of drakconnect options
-.TP
-.B "\-\-skip-wizard"
-Manage interface.
-.TP
-.B "\-\-testing"
-Do not do anything (for debugging purpose)
-.SH FILES
-.SS Name resolution
-.I /etc/sysconfig/network
-global network options (hostname, is networking enabled, default gateway)
-.br
-.I /etc/hosts
-hosts to IPs mapping
-.br
-.I /etc/resolv.conf
-domain, primary & secondary DNS
-.br
-.SS Kernel interfaces list
-.I /proc/net/dev
-network interfaces and their stats
-.br
-.I /proc/net/if_inet6
-the same for IPv6
-.br
-.I /sys/class/net/*/
-per network interface sysfs interface
-.br
-.SS Interfaces configuration
-.I /etc/modules.conf and /etc/modprobe.conf
-logical network interfaces (eg: ethX) to kernel driver mapping
-.br
-.I /etc/iftab
-enable to remap interfaces names depending on ARP or MAC addresses,
-kernel driver, ... (see
-.BR iftab (5)
-for further information)
-.br
-.I /etc/sysconfig/network-scripts/ifcfg-*
-per interface configuration (IP/network, IP discovery
-protocol, link notification support, ...) (see
-.BR ifcfg (8)
-for further information)
-.br
-.I /etc/profile.d/proxy.csh /etc/profile.d/proxy.sh
-proxy configuration
-.SS Profiles
-.I /etc/netprofile/
-the directory where profiles are saved
-.br
-.I /etc/netprofile/current
-this file hold the current profile name
-.br
-.I /etc/netprofile/list
-this file list the files to save in profiles
-.br
-.SS Peer
-.I /etc/ppp/options
-generic pppd options
-.br
-.I /etc/ppp/peers/ppp0
-pppd options for provider (ISP)
-.br
-.I /etc/ppp/pap-secrets and /etc/ppp/chap-secrets
-peer authentication data (login and passwords)
-.br
-.I /etc/ppp/pppoe.conf
-ppoe configuration file. see pppoe.conf(8)
-.SH BUGS
-.SH SEE ALSO
-arp(8), ethtool(8), ifcfg(5), ifconfig(8), pppd(8), netstat(8), rarp(8), route(8),
-.SH AUTHORS
-Damien "Dam's" Krotkine,
-.br
-Damien Chaumette,
-.br
-Francois Pons,
-.br
-Thierry Vignaud <tvignaud@mandrakesoft.com>
-.br
-Olivier blin <blino@mandrakesoft.com>
diff --git a/perl-install/standalone/mousedrake b/perl-install/standalone/mousedrake
deleted file mode 100755
index 2f6d0dd87..000000000
--- a/perl-install/standalone/mousedrake
+++ /dev/null
@@ -1,74 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use common;
-use interactive;
-use modules;
-use mouse;
-use c;
-
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/mousedrake-mdk.png";
-my $in = 'interactive'->vnew('su');
-
-my $modules_conf = modules::any_conf->read;
-
-begin:
-my $mouse = mouse::read();
-my %old = %$mouse;
-
-if (!$::noauto) {
- my $probed_mouse = mouse::detect($modules_conf);
- $mouse = $probed_mouse if !$mouse->{XMOUSETYPE} || !$probed_mouse->{unsafe};
-}
-
-if (!$mouse || !$::auto) {
- $mouse ||= mouse::fullname2mouse("serial|Generic 2 Button Mouse");
- my $test_hbox;
- my $name = $in->ask_from_treelistf('mousedrake', N("Please choose your mouse type."), '|',
- sub { join '|', map { translate($_) } split '\|', $_[0] },
- [ mouse::fullnames() ],
- $mouse->{type} . '|' . $mouse->{name});
- $name or $in->exit(0);
- my $mouse_chosen = mouse::fullname2mouse($name);
- $mouse = $mouse_chosen if !($mouse->{type} eq $mouse_chosen->{type} && $mouse->{name} eq $mouse_chosen->{name});
-
- if ($mouse->{device} eq "usbmouse") {
- modules::load_category($modules_conf, 'bus/usb') or die 'no usb bus found\n';
- modules::load(qw(hid mousedev usbmouse));
- }
-
- $mouse->{XEMU3} = 'yes' if $mouse->{nbuttons} < 3 && (!$::noauto || $in->ask_yesorno('', N("Emulate third button?"), 1));
-
- $mouse->{device} = $in->ask_from_listf(N("Mouse Port"),
- N("Please choose which serial port your mouse is connected to."),
- \&mouse::serial_port2text,
- [ mouse::serial_ports ],
- $mouse->{device},
- ) || goto begin if $mouse->{type} eq 'serial';
- $test_hbox and $test_hbox->destroy;
-}
-
-mouse::write_conf($in->do_pkgs, $modules_conf, $mouse, 1);
-
-if ($in->isa('interactive::gtk') && mouse::change_mouse_live($mouse, \%old)) {
-
- require ugtk2;
- ugtk2->import(qw(:wrappers :create));
- my $w = ugtk2->new(N("Mouse test"));
- gtkadd($w->{window},
- gtkpack(Gtk2::VBox->new(0, 5),
- Gtk2::Label->new(N("Please test your mouse:")),
- my $test_hbox = Gtk2::HBox->new(0, 5),
- $w->create_okcancel));
- mouse::test_mouse_standalone($mouse, $test_hbox);
- $w->main or goto begin;
-}
-
-system('service', 'gpm', 'restart') if -e '/var/lock/subsys/gpm';
-
-$in->exit(0);
-goto begin;
diff --git a/perl-install/standalone/net_applet b/perl-install/standalone/net_applet
deleted file mode 100644
index c005862cc..000000000
--- a/perl-install/standalone/net_applet
+++ /dev/null
@@ -1,173 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use c;
-use common;
-use standalone;
-use Digest::MD5;
-use network::netconnect;
-use network::tools;
-
-use Gtk2::TrayIcon;
-
-use ugtk2 qw(:create :helpers :wrappers);
-
-my ($eventbox, $img);
-my ($current_state, $menu, $timeout);
-my $onstartupfile = "$ENV{HOME}/.net_applet";
-add_icon_path("/usr/share/libDrakX/pixmaps/");
-# Allow multiple instances, but only one per user:
-is_running('net_applet') and die "net_applet already running\n";
-my $prog_name = "/usr/bin/net_applet";
-my $current_md5 = md5file($prog_name);
-
-my %appletstate = (
- connected => {
- colour => [ 'connected' ],
- changes => [ 'disconnected', 'error', 'busy' ],
- menu => [ 'downNetwork', 'confNetwork', 'monitorNetwork', 'refresh', 'help' ],
- tt => [ N_("Network is up on interface %s") ]
- },
- disconnected => {
- colour => [ 'disconnected' ],
- changes => [ 'connected', 'error', 'busy' ],
- menu => [ 'upNetwork', 'confNetwork', 'refresh', 'help' ],
- tt => [
- #-PO: keep the "Configure Network" substring synced with the "Configure Network" message below
- N_("Network is down on interface %s. Click on \"Configure Network\"")
- ]
- },
- notconfigured => {
- colour => [ 'disconnected' ],
- changes => [ 'connected' ],
- menu => [ 'confNetwork', 'refresh', 'help' ],
- tt => [
- N_("You don't have any configured Internet connection.
-Run the \"Add Connection\" assistant from the Mandrakelinux Control Center")
- ]
- }
- );
-
-my %actions = (
- 'upNetwork' => { name => sub { N("Connect %s", $_[0]) }, launch => \&network::tools::start_interface },
- 'downNetwork' => { name => sub { N("Disconnect %s", $_[0]) }, launch => \&network::tools::stop_interface },
- 'monitorNetwork' => { name => N("Monitor Network"), launch => sub { system("/usr/sbin/net_monitor --defaultintf $_[0] &") } },
- 'confNetwork' => { name => N("Configure Network"), launch => sub { system("/usr/sbin/drakconnect --skip-wizard &") } },
- 'refresh' => { name => N("Refresh"), launch => sub { checkNetwork() } },
- 'help' => { name => N("Get Online Help"), launch => sub { system("drakhelp --id internet-connection &") } }
- );
-
-gtkadd(my $icon = Gtk2::TrayIcon->new("Net_Applet"),
- gtkadd($eventbox = Gtk2::EventBox->new,
- gtkpack($img = Gtk2::Image->new)
- )
- );
-$eventbox->signal_connect(button_press_event => sub {
- if ($_[1]->button == 1) {
- is_running('net_monitor') or netMonitor()
- }
- $_[1]->button == 3 && $menu and $menu->popup(undef, undef, undef, undef, $_[1]->button, $_[1]->time);
- });
-my ($opt) = @ARGV;
-if ($opt eq '--force' || $opt eq '-f') { setAutoStart('TRUE') };
-
-shouldStart() or die "$onstartupfile should be set to TRUE or use net_applet --force";
-
-checkNetwork();
-cronNetwork();
-
-$icon->show_all;
-Gtk2->main;
-
-ugtk2::exit(0);
-
-sub is_running {
- my ($name) = @_;
- any {
- my ($ppid, $pid, $n) = /^\s*(\d+)\s+(\d+)\s+(.*)/;
- #- to run ps, perl may create some process with $name as name and 1 as ppid
- $ppid != 1 && $pid != $$ && $n eq $name;
- } `ps -o '%P %p %c' -u $ENV{USER}`;
-}
-sub shouldStart() {
- my %p = getVarsFromSh($onstartupfile);
- my $ret = $p{AUTOSTART} eq 'FALSE' ? 0 : 1;
- $ret
-}
-sub md5file {
- my @md5;
- foreach my $file (@_) {
- open(my $FILE, $file) or do { print STDERR "Can't open '$file': $!"; push @md5, "" };
- binmode($FILE);
- push @md5, Digest::MD5->new->addfile($FILE)->hexdigest;
- close($FILE);
- }
- return wantarray() ? @md5 : $md5[0];
-}
-sub netMonitor() {
- system("/usr/sbin/net_monitor&");
- checkNetwork()
-}
-sub checkNetwork() {
- my $netcnx = {};
- my $netc = {};
- my $intf = {};
- network::netconnect::read_net_conf($netcnx, $netc, $intf);
- my ($gw_intf, $is_up, $gw_address, $dns_server) = network::tools::get_internet_connection($netc, $intf);
- go2State($gw_address ? 'connected' : $gw_intf ? 'disconnected' : 'notconfigured', $gw_intf);
-
- my $new_md5 = md5file($prog_name);
- if ($new_md5 ne $current_md5) { exec($prog_name) };
-}
-sub getIP {
- my ($interface) = shift;
- my $ifconfig = '/sbin/ifconfig';
- my @lines = `$ifconfig $interface`;
- my @ip = map { if_(/inet adr:([\d.]+)/, $1) } @lines;
- return wantarray() ? @ip : $ip[0];
-}
-sub cronNetwork() {
- $timeout = Glib::Timeout->add(5*1000, sub {
- checkNetwork();
- 1;
- });
-}
-sub go2State {
- my ($state_type, $interface) = @_;
- if ($current_state ne $state_type) {
- $current_state = $state_type;
- $menu and $menu->destroy;
- $menu = setState($state_type, $interface);
- }
-}
-sub setState {
- my ($state_type, $interface) = @_;
- my $checkmi;
- my $arr = $appletstate{$state_type}{menu};
- my $tmp = gtkcreate_pixbuf($appletstate{$state_type}{colour}[0]);
- $img->set_from_pixbuf($tmp);
- gtkset_tip(Gtk2::Tooltips->new, $eventbox, formatAlaTeX(common::sprintf_fixutf8(translate($appletstate{$state_type}{tt}[0]), $interface)));
- my $menu = Gtk2::Menu->new;
- foreach (@$arr) {
- my $name = ref($actions{$_}{name}) eq 'CODE' ? $actions{$_}{name}->($interface) : $actions{$_}{name};
- my $launch = $actions{$_}{launch};
- $menu->append(gtksignal_connect(gtkshow(Gtk2::MenuItem->new_with_label($name)), activate => sub { $launch->($interface) }));
- }
- $menu->append(gtkshow(Gtk2::SeparatorMenuItem->new));
- $menu->append(gtksignal_connect(gtkset_active($checkmi = Gtk2::CheckMenuItem->new_with_label(N("Always launch on startup")), shouldStart()), toggled => sub { setAutoStart(uc(bool2text($checkmi->get_active))) }));
- $checkmi->show;
- $menu->append(gtksignal_connect(gtkshow(Gtk2::MenuItem->new_with_label(N("Quit"))), activate => sub { mainQuit() }));
- $menu
-}
-sub mainQuit() {
- Glib::Source->remove($timeout) if $timeout;
- Gtk2->main_quit
-}
-sub setAutoStart {
- my $state = shift;
- output_p $onstartupfile,
- qq(AUTOSTART=$state
-);
-}
-
diff --git a/perl-install/standalone/net_monitor b/perl-install/standalone/net_monitor
deleted file mode 100755
index 7124c8a84..000000000
--- a/perl-install/standalone/net_monitor
+++ /dev/null
@@ -1,593 +0,0 @@
-#!/usr/bin/perl
-
-# NetMonitor
-
-# Copyright (C) 1999-2004 Mandrakesoft
-# Damien "Dam's" Krotkine
-# Thierry Vignaud <tvignaud@mandrakesoft.com>
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-
-use strict;
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use c;
-use interactive;
-use ugtk2 qw(:create :helpers :wrappers);
-use common;
-use network::netconnect;
-use network::tools;
-use MDK::Common::Globals "network", qw($in);
-use POSIX;
-
-$ugtk2::wm_icon = "/usr/share/mcc/themes/default/net_monitor-mdk.png";
-
-if ("@ARGV" =~ /--status/) { print connected(); exit(0) }
-my $force = "@ARGV" =~ /--force/;
-my $quiet = "@ARGV" =~ /--quiet/;
-my $connect = "@ARGV" =~ /--connect/;
-my $disconnect = "@ARGV" =~ /--disconnect/;
-my ($default_intf) = "@ARGV" =~ /--defaultintf (\w+)/;
-
-my $netcnx = {};
-my $netc = {};
-my $intf = {};
-network::netconnect::read_net_conf($netcnx, $netc, $intf);
-$default_intf ||= network::tools::get_default_gateway_interface($netc, $intf);
-
-if ($force) {
- $connect and network::tools::start_interface($default_intf);
- $disconnect and network::tools::stop_interface($default_intf);
- $connect = $disconnect = 0;
-}
-$quiet and exit(0);
-my $in = 'interactive'->vnew;
-
-
-my $window1 = ugtk2->new(N("Network Monitoring"));
-$window1->{rwindow}->signal_connect(delete_event => \&main_quit);
-
-unless ($::isEmbedded) {
- $window1->{rwindow}->set_position('center');
- $window1->{rwindow}->set_title(N("Network Monitoring"));
- $window1->{rwindow}->set_border_width(5);
-}
-#$::isEmbedded or $window1->{rwindow}->set_size_request(580, 320);
-
-my $colorr = gtkcolor(50400, 655, 20000);
-my $colort = gtkcolor(55400, 55400, 655);
-my $colora = gtkcolor(655, 50400, 655);
-my $isconnected = -1;
-my @interfaces;
-my $monitor = {};
-my $c_time = 0;
-my $ct_tag;
-
-my ($pixmap, $darea, $gc_lines);
-my ($width, $height) = (300, 150);
-
-my $left_border = 50;
-my $grid_interval = 30;
-my $arrow_space = 6;
-my $arrow_size = 5;
-
-my $cfg_file = $< ? "$ENV{HOME}/.net_monitorrc" : "/etc/sysconfig/net_monitorrc";
-my %config = getVarsFromSh($cfg_file);
-my $use_same_scale = text2bool($config{use_same_scale});
-
-MDK::Common::Globals::init(in => $in);
-
-gtkadd($window1->{window},
- gtkpack_(Gtk2::VBox->new(0,5),
- 1, gtkpack_(Gtk2::HBox->new(0,5),
- 0, my $notebook = Gtk2::Notebook->new,
- 1, gtkpack_(Gtk2::VBox->new(0,5),
- 0, gtkadd(gtkset_shadow_type(Gtk2::Frame->new(N("Settings")), 'etched_out'),
- gtkpack__(gtkset_border_width(Gtk2::HBox->new(0,0),5),
- N("Connection type: "),
- my $label_cnx_type = Gtk2::Label->new("")),
- ),
- 1, gtkadd(gtkset_shadow_type(Gtk2::Frame->new(N("Global statistics")), 'etched_out'),
- gtkpack__(gtkset_border_width(Gtk2::VBox->new(0,0),5),
- create_packtable({ col_spacings => 1, row_spacings => 5, homogeneous => 1 },
- [ Gtk2::Label->new(""), Gtk2::Label->new(N("Instantaneous")) , Gtk2::Label->new(N("Average")) ],
- [ Gtk2::WrappedLabel->new(N("Sending\nspeed:")), my $label_st = Gtk2::Label->new(""), my $label_sta = Gtk2::Label->new(N("unknown")) ],
- [ Gtk2::WrappedLabel->new(N("Receiving\nspeed:")), my $label_sr = Gtk2::Label->new(""), my $label_sra = Gtk2::Label->new(N("unknown")) ],
- ),
- Gtk2::HSeparator->new,
- gtkpack__(gtkset_border_width(Gtk2::HBox->new(0,0),5),
- N("Connection\ntime: "),
- my $label_ct = Gtk2::Label->new(N("unknown")),
- ),
- )
- ),
- )
- ),
- 0, gtksignal_connect(gtkset_active(Gtk2::CheckButton->new(N("Use same scale for received and transmitted")), $use_same_scale), clicked => sub { $use_same_scale = !$use_same_scale }),
- 0, gtkpack(create_hbox('edge'),
- gtksignal_connect(my $button_connect = gtkset_sensitive(Gtk2::Button->new(N("Wait please")), 0), clicked => \&connection),
- gtksignal_connect(my $button_close = Gtk2::Button->new(N("Close")), clicked => \&main_quit),
- ),
- 0, my $statusbar = Gtk2::Statusbar->new
- ),
- );
-
-$window1->{rwindow}->show_all;
-$window1->{rwindow}->realize;
-
-my $gct = Gtk2::Gdk::GC->new($window1->{rwindow}->window);
-$gct->set_foreground($colort);
-my $gcr = Gtk2::Gdk::GC->new($window1->{rwindow}->window);
-$gcr->set_foreground($colorr);
-my $gca = Gtk2::Gdk::GC->new($window1->{rwindow}->window);
-$gca->set_foreground($colora);
-
-$statusbar->push(1, N("Wait please, testing your connection..."));
-$window1->{rwindow}->show_all;
-
-Glib::Timeout->add(1000, \&rescan);
-my $time_tag2 = Glib::Timeout->add(1000, \&update);
-
-update();
-rescan();
-
-gtkflush() while $isconnected == -2 || $isconnected == -1;
-
-Glib::Source->remove($time_tag2);
-$time_tag2 = Glib::Timeout->add(5000, \&update);
-
-connection() if $connect && !$isconnected || $disconnect && $isconnected;
-
-my $tool_pid;
-
-$SIG{CHLD} = sub {
- my $child_pid;
- do {
- $child_pid = waitpid(-1, POSIX::WNOHANG);
- if ($tool_pid eq $child_pid) {
- undef $tool_pid;
- $button_close->set_sensitive(1);
- }
- } while $child_pid > 0;
-};
-
-
-$window1->main;
-main_quit();
-
-my $during_connection;
-my $first;
-
-sub main_quit() {
- $config{use_same_scale} = bool2yesno($use_same_scale);
- setVarsInSh($cfg_file, \%config);
- ugtk2->exit(0);
-}
-
-sub connection() {
- $during_connection = 1;
- my $wasconnected = $isconnected;
-
- $button_connect->set_sensitive(0);
- $button_close->set_sensitive(0);
- $statusbar->pop(1);
- $statusbar->push(1, $wasconnected ? N("Disconnecting from Internet ") : N("Connecting to Internet "));
- if ($wasconnected == 0) {
- $c_time = time();
- $ct_tag = Glib::Timeout->add(1000, sub {
- my ($sec, $min, $hour) = gmtime(time() - $c_time);
- my $e = sprintf("%02d:%02d:%02d", $hour, $min, $sec);
- $label_ct->set_label($e); 1 })
- }
- my $nb_point = 1;
- $first = 1;
-
- my $_tag = Glib::Timeout->add(1000, sub {
- $statusbar->pop(1);
- $statusbar->push(1, ($wasconnected == 1 ? N("Disconnecting from Internet ") : N("Connecting to Internet "))
- . join('', map { "." } (1..$nb_point)));
- $nb_point++;
- if ($nb_point < 4) { return 1 }
- my $ret = 1;
-
- my $isconnect = test_connected(0);
-
- if ($nb_point < 20) {
- if ($first == 1) { # first time
- if ($isconnect == -2) { # wait for last test to finish
- test_connected(2); # not yet terminated, try to cancel it
- return 1;
- }
- test_connected(1); # initiates new connection test
- $first = 0;
- return 1;
- }
- if ($isconnect == -2) { return 1 } # no result yet, wait.
- if ($isconnect == $wasconnected) {
- # we got a test result; but the connection state did not change; retry.
- test_connected(1);
- return 1;
- }
- }
- # either we got a result, or we timed out.
- if ($isconnect != -2 || $nb_point > 20) {
- $isconnected = $isconnect;
- $ret = 0;
- $statusbar->pop(1);
- $statusbar->push(1, $wasconnected ? ($isconnected ?
- N("Disconnection from Internet failed.") :
- N("Disconnection from Internet complete.")) :
- ($isconnected ?
- N("Connection complete.") :
- N("Connection failed.\nVerify your configuration in the Mandrakelinux Control Center."))
- );
- # remove the connection time timer if connection is down or failed
- $isconnected or Glib::Source->remove($ct_tag);
- my $delay = 1000;
- # keep the message displayed longer if there is a problem.
- if ($isconnected == $wasconnected) { $delay = 5000 }
- my $_tag3 = Glib::Timeout->add($delay, sub {
-
- $button_connect->set_sensitive(1);
- $button_close->set_sensitive(1);
- undef $during_connection;
- update();
- return 0;
- });
- }
- return $ret;
- });
-
- gtkflush();
-
- $tool_pid =
- $wasconnected == 1
- ? network::tools::stop_interface($default_intf)
- : network::tools::start_interface($default_intf);
-}
-
-sub graph_window_width() { $width - $left_border }
-
-sub rescan() {
- get_val();
- foreach (@interfaces) {
- my $intf = $_;
- my $recv = $monitor->{$intf}{val}[0];
- my $transmit = $monitor->{$intf}{val}[8];
- my $refr = $monitor->{$intf}{referencer};
- my $reft = $monitor->{$intf}{referencet};
- $monitor->{sr} += $recv - $refr;
- $monitor->{st} += $transmit - $reft;
-
- $monitor->{$intf}{recva} += $recv - $refr;
- $monitor->{$intf}{recvan}++;
- if ($monitor->{$intf}{recvan} > 9) {
- push(@{$monitor->{$intf}{stack_ra}}, $monitor->{$intf}{recva}/10);
- $monitor->{$intf}{recva} = $monitor->{$intf}{recvan} = 0;
- } else { push(@{$monitor->{$intf}{stack_ra}}, -1) }
- shift @{$monitor->{$intf}{stack_ra}} if @{$monitor->{$intf}{stack_ra}} > graph_window_width();
-
- push(@{$monitor->{$intf}{stack_r}}, $recv - $refr);
- shift @{$monitor->{$intf}{stack_r}} if @{$monitor->{$intf}{stack_r}} > graph_window_width();
- $monitor->{$intf}{labelr}->set_label(formatXiB($recv - $monitor->{$intf}{initialr}));
- $monitor->{$intf}{referencer} = $recv;
-
- $monitor->{$intf}{transmita} += $transmit - $reft;
- $monitor->{$intf}{transmitan}++;
- if ($monitor->{$intf}{transmitan} > 9) {
- push(@{$monitor->{$intf}{stack_ta}}, $monitor->{$intf}{transmita}/10);
- $monitor->{$intf}{transmita} = $monitor->{$intf}{transmitan} = 0;
- } else { push(@{$monitor->{$intf}{stack_ta}}, -1) }
- shift @{$monitor->{$intf}{stack_ta}} if @{$monitor->{$intf}{stack_ta}} > graph_window_width();
-
- push(@{$monitor->{$intf}{stack_t}}, $transmit - $reft);
- shift @{$monitor->{$intf}{stack_t}} if @{$monitor->{$intf}{stack_t}} > graph_window_width();
- $monitor->{$intf}{labelt}->set_label(formatXiB($transmit - $monitor->{$intf}{initialt}));
- $monitor->{$intf}{referencet} = $transmit;
-
- draw_monitor($monitor->{$intf}, $intf);
- }
- $label_sr->set_label(formatXiB($monitor->{sr}) . "/s");
- $label_st->set_label(formatXiB($monitor->{st}) . "/s");
- $monitor->{sra} += $monitor->{sr};
- $monitor->{sta} += $monitor->{st};
- $monitor->{nba}++;
- if ($monitor->{nba} > 9) {
- $label_sra->set_label(formatXiB($monitor->{sra}/10) . "/s");
- $label_sta->set_label(formatXiB($monitor->{sta}/10) . "/s");
- $monitor->{sra} = 0;
- $monitor->{sta} = 0;
- $monitor->{nba} = 0;
- }
- $label_cnx_type->set_label(translate($netcnx->{type}));
- $monitor->{$_} = 0 foreach 'sr', 'st';
- 1;
-}
-
-sub get_val() {
- my $a = cat_("/proc/net/dev");
- $a =~ s/^.*?\n.*?\n//;
- $a =~ s/^\s*lo:.*?\n//;
- my @line = split(/\n/, $a);
- my @interfaces = c::get_netdevices();
- map {
- s/\s*(\w*)://;
- my $intf = $1;
- if (member($intf, @interfaces)) {
- $monitor->{$intf}{val} = [ split() ];
- $monitor->{$intf}{intf} = $intf;
- $intf;
- } else { () }
- } @line;
-}
-
-sub change_color {
- my ($color) = @_;
- my $dialog = _create_dialog(N("Color configuration"));
- $dialog->vbox->add(my $colorsel = Gtk2::ColorSelection->new);
- $colorsel->set_current_color($color);
- $dialog->add_button(N("Cancel"), 'cancel');
- $dialog->add_button(N("Ok"), 'ok');
- $dialog->show_all;
- if ($dialog->run eq 'ok') {
- $color = $colorsel->get_current_color;
- }
- $dialog->destroy;
- $color;
-}
-
-my ($scale_r, $scale_t);
-$scale_r = $scale_t = $height;
-
-sub scale_tranmistted($) { $_[0] * $scale_t }
-sub scale_received($) { $_[0] * $scale_r }
-
-sub update() {
- if (!$during_connection) {
- my $isconnect = test_connected(0);
- if ($isconnect != -2) {
- $isconnected = $isconnect; # save current state
- $isconnect = test_connected(1); # start new test
- }
- };
-
- my @intfs = get_val(); # get values from /proc file system
- foreach (@intfs) {
- my $intf = $_;
- if (!member($intf,@interfaces)) {
- $default_intf ||= $intf;
- $monitor->{$intf}{initialr} = $monitor->{$intf}{val}[0];
- $monitor->{$intf}{initialt} = $monitor->{$intf}{val}[8];
- $darea->{$intf} = Gtk2::DrawingArea->new;
- $darea->{$intf}->set_events(["pointer_motion_mask"]);
- $notebook->append_page(gtkshow(my $page = gtkpack_(Gtk2::VBox->new(0,0),
- 0, gtkpack__(gtkset_border_width(Gtk2::HBox->new(0,0), 5),
- gtksize($darea->{$intf}, $width, $height)),
- 0, gtkpack_(Gtk2::HBox->new(0,0),
- 1, gtkpack__(Gtk2::VBox->new(0,0),
- gtkpack__(gtkset_border_width(Gtk2::HBox->new(0,5), 5),
- gtksignal_connect(my $button_t = gtkset_relief(Gtk2::Button->new, 'none'), clicked => sub {
- $colort = change_color($colort);
- $gct->set_foreground($colort);
- $_[0]->queue_draw;
- }),
- N("sent: "), $monitor->{$intf}{labelt} = Gtk2::Label->new("0")),
- gtkpack__(gtkset_border_width(Gtk2::HBox->new(0,5), 5),
- gtksignal_connect(my $button_r = gtkset_relief(Gtk2::Button->new, 'none'), clicked => sub {
- $colorr = change_color($colorr);
- $gcr->set_foreground($colorr);
- $_[0]->queue_draw;
- }),
- N("received: "), $monitor->{$intf}{labelr} = Gtk2::Label->new("0")),
- gtkpack__(gtkset_border_width(Gtk2::HBox->new(0,5), 5),
- gtksignal_connect(my $button_a = gtkset_relief(Gtk2::Button->new, 'none'), clicked => sub {
- $colora = change_color($colora);
- $gca->set_foreground($colora);
- $_[0]->queue_draw;
- }),
- N("average"))
- ),
- 0, gtkpack__(gtkset_border_width(Gtk2::VBox->new(0,0), 5),
- gtkadd(gtkset_shadow_type(Gtk2::Frame->new(N("Local measure")), 'etched_out'),
- gtkpack__(gtkset_border_width(Gtk2::VBox->new(0,0), 5),
- gtkpack__(Gtk2::HBox->new(0,0),
- N("sent: "),
- my $measure_t = Gtk2::Label->new("0")
- ),
- gtkpack__(Gtk2::HBox->new(0,0),
- N("received: "),
- my $measure_r = Gtk2::Label->new("0")
- )
- )
- )
- )
- )
- )),
- Gtk2::Label->new($intf));
- foreach my $i ([$button_t, $gct], [$button_r, $gcr], [$button_a, $gca]) {
- $i->[0]->add(gtksignal_connect(gtkshow(gtksize(gtkset_size_request(Gtk2::DrawingArea->new, 10, 10), 10, 10)),
- expose_event => sub { $_[0]->window->draw_rectangle($i->[1], 1, 0, 0, 10, 10) }));
- }
- $monitor->{$intf}{page} = $notebook->page_num($page);
- $darea->{$intf}->realize;
- $pixmap->{$intf} = Gtk2::Gdk::Pixmap->new($darea->{$intf}->window, $width, $height, $darea->{$intf}->window->get_depth);
- $monitor->{$intf}{referencer} = $monitor->{$intf}{val}[0];
- $monitor->{$intf}{referencet} = $monitor->{$intf}{val}[8];
- $pixmap->{$intf}->draw_rectangle($darea->{$intf}->style->black_gc, 1, 0, 0, $width, $height);
- $darea->{$intf}->signal_connect(motion_notify_event => sub {
- my (undef, $e) = @_;
- my $x = $e->x - 50;
- my $received = $x >= 0 ? $monitor->{$intf}{stack_r}[$x] : 0;
- my $transmitted = $x >= 0 ? $monitor->{$intf}{stack_t}[$x] : 0;
- $measure_r->set_label(formatXiB($received));
- $measure_t->set_label(formatXiB($transmitted));
- });
- $darea->{$intf}->signal_connect(expose_event => sub {
- $darea->{$intf}->window->draw_drawable($darea->{$intf}->style->bg_gc('normal'), $pixmap->{$intf}, 0, 0, 0, 0, $width, $height);
- });
- $gc_lines->{$intf} = Gtk2::Gdk::GC->new($darea->{$intf}->window);
- $gc_lines->{$intf}->set_foreground($darea->{$intf}->style->white);
- $gc_lines->{$intf}->set_line_attributes(1, 'on-off-dash', 'not-last', 'round');
-
- }
- }
- foreach (@interfaces) {
- my $intf = $_;
- $notebook->remove_page($monitor->{$intf}{page}) unless member($intf,@intfs);
- }
- if (@intfs && !@interfaces) {
- #- select the default interface at start
- for (my $num_p = 0; $num_p < $notebook->get_n_pages; $num_p++) {
- if ($notebook->get_tab_label_text($notebook->get_nth_page($num_p)) eq $default_intf) {
- $notebook->set_current_page($num_p);
- last;
- }
- }
- }
- @interfaces = @intfs;
- if ($isconnected != -2 && $isconnected != -1 && !$during_connection) {
- if ($isconnected == 1 && !in_ifconfig($netcnx->{NET_INTERFACE})) {
- $isconnected = 0;
- $statusbar->pop(1);
- $statusbar->push(1, N("Warning, another internet connection has been detected, maybe using your network"));
- } else {
- #- translators : $netcnx->{type} is the type of network connection (modem, adsl...)
- $statusbar->pop(1);
- $statusbar->push(1, $isconnected == 1 ? N("Connected") : N("Not connected"));
- }
- $button_connect->set_sensitive(1);
- $button_connect->set("label", $isconnected == 1 ? N("Disconnect %s", translate($netcnx->{type})) : N("Connect %s", $netcnx->{type}));
- }
- unless ($default_intf || @interfaces) {
- $button_connect->set_sensitive(0);
- $button_connect->set("label", N("No internet connection configured"));
- }
- 1;
-}
-
-sub in_ifconfig {
- my ($intf) = @_;
- -x '/sbin/ifconfig' or return 1;
- $intf eq '' and return 1;
- `/sbin/ifconfig` =~ /$intf/;
-}
-
-sub draw_monitor {
- my ($o, $intf) = @_;
- defined $darea->{$intf} or return;
- my $gcl = $gc_lines->{$intf};
- my $pixmap = $pixmap->{$intf};
- $pixmap->draw_rectangle($darea->{$intf}->style->black_gc, 1, 0, 0, $width, $height);
- my $maxr = 0;
- foreach (@{$o->{stack_r}}) { $maxr = $_ if $_ > $maxr }
- my $maxt = 0;
- foreach (@{$o->{stack_t}}) { $maxt = $_ if $_ > $maxt }
-
- my ($graph_maxr, $graph_maxt);
- if ($use_same_scale) {
- $graph_maxr = $graph_maxt = ($maxr + $maxt)/2;
- } else {
- $graph_maxr = $maxr;
- $graph_maxt = $maxt;
- }
- $scale_r = ($height/2) / max($graph_maxr, 1);
- $scale_t = ($height/2) / max($graph_maxt, 1);
-
- my $step = $left_border - 1;
- foreach (@{$o->{stack_t}}) {
- $pixmap->draw_rectangle($gct, 1, $step, 0, 1, scale_tranmistted($_));
- $step++;
- }
- $step = $left_border - 1;
- my ($av1, $av2, $last_a);
- foreach (@{$o->{stack_ta}}) {
- if ($_ != -1) {
- if (!defined $av1) { $av1 = $_ } else { defined $av2 or $av2 = $_ }
- if ($av1 && $av2) {
- $pixmap->draw_line($gca, $step-15, scale_tranmistted($av1), $step-5, scale_tranmistted($av2));
- $av1 = $av2;
- undef $av2;
- $last_a = $step - $left_border + 1;
- }
- }
- $step++;
- }
- $step = $left_border - 1;
- foreach (@{$o->{stack_r}}) {
- $pixmap->draw_rectangle($gcr, 1, $step, $height-scale_received($_), 1, scale_received($_));
- $step++;
- }
- $step = $left_border - 1;
- $av1 = $av2 = undef;
- foreach (@{$o->{stack_ra}}) {
- if ($_ != -1) {
- if (!defined $av1) { $av1 = $_ } else { defined $av2 or $av2 = $_ }
- if (defined $av1 && defined $av2) {
- $pixmap->draw_line($gca, $step-15, $height-scale_received($av1), $step-5, $height-scale_received($av2));
- $av1 = $av2;
- undef $av2;
- }
- }
- $step++;
- }
-
- my ($pix_maxr, $pix_maxt);
- if ($last_a) {
- $pix_maxr = $height - scale_received(@{$o->{stack_ra}}[$last_a]);
- $pix_maxt = scale_tranmistted(@{$o->{stack_ta}}[$last_a]);
- } else {
- $pix_maxr = $height - scale_received(@{$o->{stack_r}}[@{$o->{stack_r}}-1]);
- $pix_maxt = scale_tranmistted(@{$o->{stack_t}}[@{$o->{stack_t}}-1]);
- }
-
- my $x_l = $arrow_size + 1;
- my $y_l;
-
- #- "transmitted" arrow
- $y_l = max($arrow_space, min($pix_maxt, $pix_maxr - 2*$arrow_size - $arrow_space));
- $pixmap->draw_line($gct, $x_l, 0, $x_l, $y_l);
- $pixmap->draw_line($gct, $x_l-1, 0, $x_l-1, $y_l);
- $pixmap->draw_line($gct, $x_l+1, 0, $x_l+1, $y_l);
- $pixmap->draw_polygon($gct, 1, $x_l-$arrow_size, $y_l, $x_l+$arrow_size, $y_l, $x_l, $y_l+$arrow_size);
-
- #- "received" arrow
- $y_l = min($height - $arrow_space, max($pix_maxr, $y_l + 2*$arrow_size + $arrow_space));
- $pixmap->draw_line($gcr, $x_l, $height, $x_l, $y_l);
- $pixmap->draw_line($gcr, $x_l-1, $height, $x_l-1, $y_l);
- $pixmap->draw_line($gcr, $x_l+1, $height, $x_l+1, $y_l);
- $pixmap->draw_polygon($gcr, 1, $x_l-$arrow_size, $y_l, $x_l+$arrow_size, $y_l, $x_l, $y_l-$arrow_size);
-
- for (my $i = $grid_interval; $i <= $height - $grid_interval; $i += $grid_interval) {
- $pixmap->draw_line($gcl, $left_border, $i, $width, $i);
- my ($gc2, $text);
- if ($i > max($grid_interval, $use_same_scale ? $pix_maxt : $height/2)) {
- $text = formatXiB(($height-$i)/$scale_r);
- $gc2 = $gcr;
- } else {
- $text = formatXiB($i/$scale_t);
- $gc2 = $gct;
- }
- $pixmap->draw_layout($gc2, 45-string_width($darea->{$intf}, $text), $i-5, $darea->{$intf}->create_pango_layout($text));
- }
- $darea->{$intf}->queue_draw;
-}
-
-
-sub test_connected {
- my ($arg) = @_;
- $::testing || network::tools::test_connected($arg);
-}
diff --git a/perl-install/standalone/printerdrake b/perl-install/standalone/printerdrake
deleted file mode 100755
index e80b8abb9..000000000
--- a/perl-install/standalone/printerdrake
+++ /dev/null
@@ -1,589 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2003-2004 Mandrakesoft
-#
-# Till Kamppeter <till@mandrakesoft.com>
-# Daouda Lo <daouda@mandrakesoft.com>
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License Version 2 as
-# published by the Free Software Foundation.
-#
-# 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-
-use strict;
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-
-use common;
-use any;
-
-use ugtk2 qw(:all);
-use interactive;
-use POSIX qw(mktime ceil);
-use printer::printerdrake;
-use printer::main;
-#Only for Debugging
-#use Devel::Peek;
-use Gtk2::Gdk::Keysyms;
-use modules;
-use c;
-
-my %sysh = distrib();
-my $distroname = $sysh{system};
-
-my $domainname = "mandrakesoft.com";
-
-my $pixdir = '/usr/share/libDrakX/pixmaps/';
-
-local $_ = join '', @ARGV;
-
-my $printer;
-
-$ugtk2::wm_icon = "printerdrake";
-my $in = 'interactive'->vnew('su', if_(!$::isEmbedded, 'printer-mdk'));
-
-
-my $commandline = $_;
-
-# Data structure for GTK2 main window
-my $us = {};
-$us->{VERSION} = '10.1';
-
-# GTK2 splash screen
-my $window_splash;
-if (0 && !$::isInstall && !$::isEmbedded) {
- $window_splash = Gtk2::Window->new('popup');
-#BUG $window_splash->signal_connect(delete_event => \&quit_global);
- $window_splash->set_title(N("Printerdrake") . $us->{VERSION});
- $window_splash->set_position('center_always');
- $window_splash->add(gtkadd(gtkset_shadow_type(Gtk2::Frame->new, 'etched_out'),
- gtkpack(Gtk2::VBox->new(0, 0),
- gtkcreate_img("$pixdir/about.png"),
- Gtk2::Label->new(N("Loading printer configuration... Please wait"))
- )
- )
- );
- $window_splash->show_all;
- gtkflush();
-}
-
-#my $wait = $in->wait_message(N("Please wait"),
-# N("Loading printer configuration... "));
-#gtkflush();
-
-# Check whether Foomatic is installed and install it if necessary
-#printer::printerdrake::install_foomatic($in);
-
-my $w = $in->wait_message(N("Printerdrake"),
- N("Reading data of installed printers..."));
-
-# Get what was installed before
-eval { $printer = printer::main::getinfo('') };
-
-undef $w;
-
-exit 0 unless printer::printerdrake::first_time_dialog($printer, $in, undef);
-
-# Were we in expert mode last time?
-$printer->{expert} = printer::main::get_usermode();
-
-# Choose the spooler by command line options
-$::expert and $printer->{expert} = 1;
-$commandline =~ /-cups/ and
- $printer->{SPOOLER} = 'cups' and printer::main::read_configured_queues($printer);
-$commandline =~ /-rcups/ and
- $printer->{SPOOLER} = 'rcups' and printer::main::read_configured_queues($printer);
-$commandline =~ /-lpr/ and
- $printer->{SPOOLER} = 'lpd' and printer::main::read_configured_queues($printer);
-$commandline =~ /-lpd/ and
- $printer->{SPOOLER} = 'lpd' and printer::main::read_configured_queues($printer);
-$commandline =~ /-lprng/ and
- $printer->{SPOOLER} = 'lprng' and printer::main::read_configured_queues($printer);
-$commandline =~ /-pdq/ and
- $printer->{SPOOLER} = 'pdq' and printer::main::read_configured_queues($printer);
-
-if ($::isInstall) {
- # Interactive main window for installation
- printer::printerdrake::main($printer, $::o->{security}, $in, 1, undef);
- exit();
-}
-
-require security::level;
-my $security = security::level::get();
-
-# Do not let printerdrake ask for the spooler
-$printer->{SPOOLER} ||= 'cups';
-
-# Initialization
-printer::printerdrake::init($printer, $security, $in, undef);
-
-# GTK2 main window
-
-my $stringsearch = '';
-
-sub HelpSystem() { exec("drakhelp --id printerdrake") unless fork() };
-
-$us->{wnd} = ugtk2->new(N("%s Printer Management Tool", $distroname) . " " . $us->{VERSION});
-gtkset_size_request($us->{wnd}{rwindow}, 660, 460);
-
-if (!$::isEmbedded) {
- $us->{wnd}{rwindow}->set_position('center');
-}
-$us->{wnd}{window}->signal_connect(delete_event => \&QuitGlobal);
-my $ltree_model = Gtk2::ListStore->new("Glib::String", "Glib::String", "Glib::String", "Glib::String", "Glib::String", "Glib::String", "Glib::String");
-my $rtree_model = Gtk2::ListStore->new("Glib::String", "Glib::String", "Glib::String", "Glib::String", "Glib::String", "Glib::String");
-my ($localtree, $remotetree);
-$localtree = CreateTree($ltree_model);
-$remotetree = CreateTree($rtree_model);
-# slightly verbatimed from control-center
-my %options = (
- 'add' => [ N("/_Actions"), N("/_Add Printer") ],
- 'default' => [ N("/_Actions"), N("/Set as _Default") ],
- 'edit' => [ N("/_Actions"), N("/_Edit") ],
- 'delete' => [ N("/_Actions"), N("/_Delete") ],
- 'expert' => [ N("/_Options"), N("/_Expert mode") ]
- );
-my %buttorcheck;
-my ($menu, $factory) = create_factory_menu($::isEmbedded ? $::Plug : $us->{wnd}{rwindow},
- ([ N("/_File"), undef, undef, undef, '<Branch>' ],
- [ N("/_File") . N("/_Refresh"), undef, sub { Refresh($stringsearch) }, undef, '<StockItem>', 'gtk-refresh' ],
- [ N("/_File") . N("/_Quit"), N("<control>Q"), \&QuitGlobal, undef, '<StockItem>', 'gtk-quit' ],
- [ N("/_Actions"), undef, undef, undef, '<Branch>' ],
- [ N("/_Actions") . N("/_Add Printer"), undef, \&AddPrinter, undef, '<StockItem>', 'gtk-add' ],
- [ join('', @{$options{default}}), undef, \&SetAsDefault, undef, '<StockItem>', 'gtk-default' ],
- [ join('', @{$options{edit}}), undef, \&Edit, undef, '<StockItem>', 'gtk-properties' ],
- [ join('', @{$options{delete}}), undef, \&Delete, undef, '<StockItem>', 'gtk-delete' ],
- [ N("/_Actions") . N("/_Configure CUPS"), undef, \&ConfigCUPS, undef, '<StockItem>', 'gtk-config' ],
- [ N("/_Options"), undef, undef, undef, '<Branch>' ],
- [ join('', @{$options{expert}}), undef, sub {
- $printer->{expert} = $buttorcheck{expert}->get_active;
- # Remember state of expert
- # mode for next
- # printerdrake session
- printer::main::set_usermode($printer->{expert});
- # Read printer database
- # for the new user mode
- %printer::main::thedb =
- ();
- }, undef, '<CheckItem>' ],
- [ N("/_Help"), undef, undef, undef, '<Branch>' ],
- if_(-x "/usr/sbin/drakhelp_inst",
- [ N("/_Help") . N("/_Help"), undef, sub { HelpSystem() }, undef, '<StockItem>', 'gtk-help' ],
- ),
- if_(!-e "/etc/sysconfig/oem",
- [ N("/_Help") . N("/_Report Bug"), undef, sub { system("$ENV{BROWSER} https://qa.$domainname &") }, undef, '<StockItem>', 'gtk-stop' ],
- ),
- [ N("/_Help") . N("/_About..."), undef, \&About, undef, '<StockItem>', 'gtk-preferences' ]
- )
- );
-%buttorcheck = map {
- $_ => $factory->get_widget("<main>" . join '', map { s/_//; $_ } @{$options{$_}})
-}('add', 'default', 'edit', 'delete', 'expert');
-
-if (defined $buttorcheck{expert}) {
- $buttorcheck{expert}->set_active($printer->{expert});
-} else {
- print STDERR "BUG with LANGUAGE $ENV{LANGUAGE}\n";
-}
-
-my $toolb = Gtk2::Toolbar->new;
-my $filter;
-my $searchBox = gtkpack_(Gtk2::HBox->new(0,5),
- 1, Gtk2::Label->new(""),
- 0, Gtk2::Label->new(N("Search:")),
- 0, gtksignal_connect($filter = Gtk2::Entry->new,
- key_press_event => sub { $_[1]->keyval == $Gtk2::Gdk::Keysyms{Return} and Refresh($filter->get_text) }),
- 0, my $fbut = Gtk2::Button->new(N("Apply filter")),
- );
-gtkappend_page(my $nb = Gtk2::Notebook->new, gtkpack(create_scrolled_window($localtree)), gtkshow(Gtk2::Label->new(N("Configured on this machine"))));
-gtkappend_page($nb, gtkpack(create_scrolled_window($remotetree)), gtkshow(Gtk2::Label->new(N("Configured on other machines"))));
-$nb->set_show_border(0);
-$us->{wnd}{window}->add(gtkpack_(Gtk2::VBox->new(0, 0),
- 0, $menu,
- 0, $toolb,
- 0, $searchBox,
- 0, Gtk2::HSeparator->new,
- 1, $nb));
-my @lcolsize = (1, 1, 1, 1, 1, 1, 1, -1);
-my @rcolsize = (1, 1, 1, 1, 1, 1, -1);
-each_index {
- my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i);
- $col->set_sort_column_id($::i);
- $col->set_min_width($lcolsize[$::i]);
- $localtree->append_column($col);
-} (N("Def."), N("Printer Name"), N("State"), N("Model"), N("Connection Type"), N("Description"), N("Location"));
-
-each_index {
- my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i);
- $col->set_sort_column_id($::i);
- $col->set_min_width($rcolsize[$::i]);
- $remotetree->append_column($col);
-} (N("Def."), N("Printer Name"), N("State"), N("Server Name"), N("Description"), N("Location"));
-my @toolbwg = map {
- $toolb->append_item($_->[0], $_->[1], $_->[2],
- Gtk2::Image->new_from_file($pixdir . $_->[2] . '.png'), $_->[3], $toolb);
-# $toolb->append_space;
-} ([
- # FIXME: then "add printer" should be a simple verb as suggested in Human Guidelines!!!
- #-PO: "Add Printer" is a button text and the translation has to be AS SHORT AS POSSIBLE
- N("Add Printer"), N("Add a new printer to the system"), 'printer_add', \&AddPrinter ],
- [
- #-PO: "Set as default" is a button text and the translation has to be AS SHORT AS POSSIBLE
- N("Set as default"), N("Set selected printer as the default printer"), 'printer_default', \&SetAsDefault ],
- [
- #-PO: "Edit" is a button text and the translation has to be AS SHORT AS POSSIBLE
- N("Edit"), N("Edit selected printer"), 'printer_conf', \&Edit ],
- [
- #-PO: "Delete" is a button text and the translation has to be AS SHORT AS POSSIBLE
- N("Delete"), N("Delete selected printer"), 'printer_del', \&Delete ],
- [
- #-PO: "Refresh" is a button text and the translation has to be AS SHORT AS POSSIBLE
- N("Refresh"), N("Refresh the list"), 'refresh', sub { Refresh($stringsearch) } ],
- [
- #-PO: "Configure CUPS" is a button text and the translation has to be AS SHORT AS POSSIBLE
- N("Configure CUPS"), N("Configure CUPS printing system"), 'cups_config', \&ConfigCUPS ]
- );
-my ($tbadd, $tbdefault, $tbedit, $tbdel, $_tbref, $_tbconfig) = @toolbwg;
-GrayDelEdit();
-foreach ($tbadd, $buttorcheck{add}) { defined $_ and $_->set_sensitive($printer->{SPOOLER} ne "rcups") };
-$localtree->parent->parent->set_sensitive($printer->{SPOOLER} ne "rcups");
-$nb->set_current_page(1) if $printer->{SPOOLER} eq "rcups";
-
-$fbut->signal_connect('clicked', sub { $stringsearch = $filter->get_text; Refresh($stringsearch) });
-Refresh($stringsearch);
-$nb->signal_connect('switch-page' => sub { NotebookSwitch() });
-$us->{wnd}{rwindow}->show_all;
-set_selection($printer->{DEFAULT});
-#undef $wait;
-if (0 && !$::isInstall && !$::isEmbedded) {
- $window_splash->destroy;
- undef $window_splash;
-}
-gtkset_mousecursor_normal();
-
-# Prevent subwindows to embed themselves in the mcc which has already the
-# main window embedded
-local $::isEmbedded = 0;
-
-Gtk2->main;
-ugtk2->exit;
-
-sub GrayDelEdit() {
- foreach ($tbdefault, $tbedit, $tbdel, $buttorcheck{default}, $buttorcheck{edit}, $buttorcheck{delete}) { defined $_ and $_->set_sensitive(0) };
-}
-
-sub TreeUnselect {
- my $treev = shift;
- $treev->get_selection->unselect_all;
- GrayDelEdit()
-}
-sub NotebookSwitch() {
- TreeUnselect($localtree);
- TreeUnselect($remotetree);
- #set_selection_on_first();
-}
-
-sub RefreshLocalPrintersFull {
- my ($strfilt) = @_;
- my @printers;
- defined $printer and @printers = keys %{$printer->{configured}};
- $ltree_model->clear;
- return if $printer->{SPOOLER} eq "rcups";
- my @LocalReal;
- LOOP: foreach my $p (@printers) {
- # Apply string search to all fields, not only the printer name
- my $connect = printer::main::connectionstr($printer->{configured}{$p}{queuedata}{connect});
- my $model = $printer->{configured}{$p}{queuedata}{make} . ' ' .
- $printer->{configured}{$p}{queuedata}{model};
- my $description = $printer->{configured}{$p}{queuedata}{desc};
- my $location = $printer->{configured}{$p}{queuedata}{loc};
- my $searchstr = "$p|$model|$connect|$description|$location";
- push(@LocalReal, $p) if $searchstr =~ /\Q$strfilt/i;
- };
- foreach my $p (sort { lc($a) cmp lc($b) } @LocalReal) {
- my $state = ($printer->{SPOOLER} !~ /cups/ ? N("Unknown") :
- (printer::cups::queue_enabled($p) ? N("Enabled") :
- N("Disabled")));
- my $connect = printer::main::connectionstr($printer->{configured}{$p}{queuedata}{connect});
- my $description = $printer->{configured}{$p}{queuedata}{desc};
- my $location = $printer->{configured}{$p}{queuedata}{loc};
- my $model = $printer->{configured}{$p}{queuedata}{make} . ' ' .
- $printer->{configured}{$p}{queuedata}{model};
- my $default = ($p eq $printer->{DEFAULT} ? "X" : "");
- $ltree_model->append_set([ 0 => $default, 1 => $p, 2 => $state,
- 3 => $model,
- 4 => $connect, 5 => $description,
- 6 => $location ]);
- }
-}
-
-sub RefreshRemotePrintersFull {
- my ($strfilt) = @_;
- my @printers;
- defined $printer and @printers = printer::cups::lpstat_lpv();
- $rtree_model->clear;
- my @RemoteReal;
- LOOP: foreach my $p (@printers) {
- # No locally defined queues
- next LOOP if defined($printer->{configured}{$p->{queuename}});
- # Apply string search to all fields, not only the printer name
- my $queue = $p->{queuename};
- my $server = $p->{ipp} || $printer->{remote_cups_server};
- my $description = $p->{description};
- my $location = $p->{location};
- my $searchstr = "$queue|$server|$description|$location";
- # All remaining to which the search term applies
- push(@RemoteReal, $p) if $searchstr =~ /\Q$strfilt/i;
- };
- foreach my $p (sort { lc($a->{queuename}) cmp lc($b->{queuename}) }
- @RemoteReal) {
- my $queue = $p->{queuename};
- my $state = ($printer->{SPOOLER} !~ /cups/ ? N("Unknown") :
- (printer::cups::queue_enabled($queue) ? N("Enabled") :
- N("Disabled")));
- my $server = $p->{ipp} || $printer->{remote_cups_server};
- my $description = $p->{description};
- my $location = $p->{location};
- my $default = ($queue eq $printer->{DEFAULT} ? "X" : "");
- $rtree_model->append_set([ 0 => $default, 1 => $queue,
- 2 => $state, 3 => $server,
- 4 => $description,
- 5 => $location ]);
- }
-}
-
-sub Refresh {
- my ($strfilt) = @_;
- my $selection = get_selection();
- RefreshLocalPrintersFull($strfilt);
- RefreshRemotePrintersFull($strfilt);
- GrayDelEdit();
- set_selection($selection);
-}
-
-sub AddPrinter() {
- deactivate_mainwindow();
- if (printer::printerdrake::add_printer($printer, $in, undef)) {
- Refresh($stringsearch);
- set_selection($printer->{QUEUE});
- } else {
- delete($printer->{QUEUE});
- }
- activate_mainwindow();
-}
-
-sub SetAsDefault() {
- deactivate_mainwindow();
- my $queue = get_selection();
- printer::printerdrake::default_printer($printer, $in, $queue);
- Refresh($stringsearch);
- activate_mainwindow();
-}
-
-sub Edit() {
- deactivate_mainwindow();
- my $queue = get_selection();
- printer::printerdrake::edit_printer($printer, $in, undef, $queue);
- Refresh($stringsearch);
- if ($printer->{QUEUE}) {
- set_selection($printer->{QUEUE});
-# } else {
-# set_selection_on_first();
- }
- activate_mainwindow();
-}
-
-sub Delete() {
- deactivate_mainwindow();
- my $queue = get_selection();
- if (printer::printerdrake::remove_printer($printer, $in, $queue)) {
- Refresh($stringsearch);
- set_selection_on_first();
- } else {
- delete($printer->{QUEUE});
- }
- activate_mainwindow();
-}
-
-sub ConfigCUPS() {
- deactivate_mainwindow();
- printer::printerdrake::config_cups($printer, $security, $in, undef);
- foreach ($tbadd, $buttorcheck{add}) { defined $_ and $_->set_sensitive($printer->{SPOOLER} ne "rcups") };
- $localtree->parent->parent->set_sensitive($printer->{SPOOLER} ne "rcups");
- $nb->set_current_page(1) if $printer->{SPOOLER} eq "rcups";
- Refresh($stringsearch);
- activate_mainwindow();
-}
-
-sub deactivate_mainwindow() {
- $us->{wnd}{rwindow}->set_sensitive(0);
- gtkset_mousecursor_wait();
-}
-
-sub activate_mainwindow() {
- $us->{wnd}{rwindow}->set_sensitive(1);
- gtkset_mousecursor_normal();
-}
-
-sub set_selection_on_first() {
- # On which page are we currently
- my $page = $nb->get_current_page;
- my ($tree, $model);
- if ($page <= 0) {
- # Locally defined printer: first page
- $tree = $localtree;
- $model = $ltree_model;
- } elsif ($page == 1) {
- # Remotely defined printer: second page
- $tree = $remotetree;
- $model = $rtree_model;
- }
- my $iter = $model->get_iter_first;
- $tree->get_selection->select_iter($iter) if $iter;
-}
-
-sub set_selection {
- my ($queue) = @_;
- return if !$queue;
- my ($tree, $model, $page);
- if (defined($printer->{configured}{$queue})) {
- # Locally defined printer: first page
- $tree = $localtree;
- $model = $ltree_model;
- $page = 0;
- } else {
- # Remotely defined printer: second page
- $tree = $remotetree;
- $model = $rtree_model;
- $page = 1;
- }
- # Search entry on page
- my $iter = $model->get_iter_first;
- while ($iter) {
- my $q = $model->get($iter, 1);
- if ($q eq $queue) {
- $tree->get_selection->select_iter($iter);
- $nb->set_current_page($page);
- return;
- }
- $iter = $model->iter_next($iter);
- }
- # Requested entry does not exist, go to the first entry on the current
- # page.
- set_selection_on_first();
-}
-
-sub get_selection() {
- my $queue;
- my $page = $nb->get_current_page;
- if ($page <= 0) {
- $queue = GetNameEntFromIter($localtree, $ltree_model, 1);
- } elsif ($page == 1) {
- $queue = GetNameEntFromIter($remotetree, $rtree_model, 1);
- }
- return $queue;
-}
-
-sub GetNameEntFromIter {
- my ($tree, $model, $rank) = @_;
- my (undef, $iter) = $tree->get_selection->get_selected;
- return undef if !defined($iter);
- my $name = $model->get($iter, $rank);
- $name
-}
-
-sub CreateTree {
- my ($tree_model) = @_;
- my $tree = Gtk2::TreeView->new_with_model($tree_model);
- $tree->get_selection->set_mode('browse');
- $tree->set_headers_visible(1);
- $tree->set_rules_hint(1);
- $tree->get_selection->signal_connect('changed' => sub {
- my (undef, $_event) = @_;
- my (undef, $iter) = $tree->get_selection->get_selected;
- return unless $iter;
- foreach ($tbdefault, $tbedit, $tbdel, $buttorcheck{default}, $buttorcheck{edit}, $buttorcheck{delete}) { $_->set_sensitive(1) }
- my $queue = $tree_model->get($iter, 1);
- if (!defined($printer->{configured}{$queue})) {
- foreach ($tbdel, $buttorcheck{delete}) {
- $_->set_sensitive(0);
- }
- }
- if ($queue eq $printer->{DEFAULT}) {
- foreach ($tbdefault, $buttorcheck{default}) {
- $_->set_sensitive(0);
- }
- }
- });
- $tree->signal_connect(button_press_event => sub {
- my (undef, $event) = @_;
- my (undef, $iter) = $tree->get_selection->get_selected;
- return unless $iter;
- foreach ($tbdefault, $tbedit, $tbdel, $buttorcheck{default}, $buttorcheck{edit}, $buttorcheck{delete}) { $_->set_sensitive(1) };
- my $queue = $tree_model->get($iter, 1);
- if (!defined($printer->{configured}{$queue})) {
- foreach ($tbdel, $buttorcheck{delete}) {
- $_->set_sensitive(0);
- }
- }
- if ($queue eq $printer->{DEFAULT}) {
- foreach ($tbdefault, $buttorcheck{default}) {
- $_->set_sensitive(0);
- }
- }
- Edit() if $event->type eq '2button-press';
- });
- $tree->signal_connect(key_press_event => sub {
- my (undef, $event) = @_;
- my (undef, $iter) = $tree->get_selection->get_selected;
- return unless $iter;
- Edit() if $event->keyval == $Gtk2::Gdk::Keysyms{Return};
- });
- $tree
-}
-
-sub NewDialog {
- my ($title, $o_no_button) = @_;
- my $dialog = gtkset_border_width(Gtk2::Dialog->new, 10);
- $dialog->set_transient_for($us->{wnd}{rwindow});
- $dialog->set_position('center-on-parent');
- $dialog->set_title($title);
- $dialog->action_area->pack_start(gtkadd(Gtk2::HButtonBox->new,
- gtksignal_connect(Gtk2::Button->new(N("Close")), clicked => sub { $dialog->destroy })
- ),
- 0,0,0) unless $o_no_button;
- gtkset_modal($dialog, 1);
-}
-
-sub About() {
- my $window_about = NewDialog(N("Printerdrake"));
- my $tree_model = Gtk2::TreeStore->new("Glib::String", "Glib::String", "Glib::String");
- my $list = Gtk2::TreeView->new_with_model($tree_model);
- $list->can_focus(0);
- each_index { $list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => $::i)) } 0..2;
- $list->set_headers_visible(0);
- foreach my $row ([ '', '', '' ], [ N("Authors: "), 'Till Kamppeter', "<till\@$domainname>" ], [ '', '', '' ]) {
- $tree_model->append_set(undef, [ map_index { $::i => $_ } @$row ]);
- }
- $list->get_selection->set_mode('none');
- gtkpack_($window_about->vbox,
- -r "$pixdir/about-printerdrake.png" ?
- (0, Gtk2::Image->new_from_file("$pixdir/about-printerdrake.png")) : (1, gtkmodify_font(Gtk2::Label->new(N("Printer Management \n") . $us->{VERSION}), 'Bold 18'),),
- 1, $list,
- );
- $window_about->show_all;
-}
-
-sub QuitGlobal() {
- gtkset_mousecursor_normal();
- Gtk2->main_quit;
-}
diff --git a/perl-install/standalone/scannerdrake b/perl-install/standalone/scannerdrake
deleted file mode 100755
index 09508e280..000000000
--- a/perl-install/standalone/scannerdrake
+++ /dev/null
@@ -1,950 +0,0 @@
-#!/usr/bin/perl
-
-# scannerdrake $Id$
-# Yves Duret <yduret at mandrakesoft.com>
-# Till Kamppeter <till at mandrakesoft.com>
-# Copyright (C) 2001-2004 Mandrakesoft
-#
-# 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, 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, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use lib qw(/usr/lib/libDrakX);
-use strict;
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use common;
-
-use interactive;
-use scanner;
-use handle_configs;
-use services;
-
-my $companyname = "Mandrakesoft";
-my $distroname = "Mandrakelinux";
-my $shortdistroname = "Mandrakelinux";
-my $domainname = "mandrakesoft.com";
-
-foreach (@ARGV) {
- /^--update-usbtable$/ and do { scanner::updateScannerDBfromUsbtable(); exit() };
- /^--update-sane=(.*)$/ and do { scanner::updateScannerDBfromSane($1); exit() };
- /^--manual$/ and $::Manual=1;
- /^--dynamic=(.*)$/ and do { dynamic(); exit() };
-}
-
-$ugtk2::wm_icon = "scannerdrake";
-my $in = 'interactive'->vnew('su');
-if (!files_exist(qw(/usr/bin/scanimage
- /etc/sane.d/dll.conf)) ||
- (!files_exist(qw(/usr/bin/xsane)) &&
- !files_exist(qw(/usr/bin/kooka)) &&
- !$in->do_pkgs->is_installed('scanner-gui'))) {
- if (!$in->ask_yesorno(N("Warning"), N("SANE packages need to be installed to use scanners.
-
-Do you want to install the SANE packages?"))) {
- $in->ask_warn("Scannerdrake",
- N("Aborting Scannerdrake."));
- exit 0;
- }
- if (!$in->do_pkgs->install('sane-backends', 'scanner-gui')) {
- $in->ask_warn(N("Error"),
- N("Could not install the packages needed to set up a scanner with Scannerdrake.") . " " .
- N("Scannerdrake will not be started now."));
- exit 0;
- }
-}
-if ($::Manual) { manual(); quit() }
-my $wait = $in->wait_message(N("Scannerdrake"),
- N("Searching for configured scanners..."));
-my @c = scanner::configured();
-$wait = undef;
-$wait = $in->wait_message(N("Scannerdrake"),
- N("Searching for new scanners..."));
-my @f = scanner::detect(@c);
-$wait = undef;
-my $changed = 0;
-@f and $changed = auto();
-if ($changed) {
- my $_wait =
- $in->wait_message(N("Scannerdrake"),
- N("Re-generating list of configured scanners..."));
- @c = scanner::configured();
-}
-mainwindow(@c);
-quit();
-
-sub removeverticalbar {
- my ($s) = @_;
- $s =~ s/\|/ /g;
- my $searchmake = handle_configs::searchstr(first($s =~ /^\s*(\S+)\s+/));
- $s =~ s/($searchmake)\s*$searchmake/$1/;
- return $s;
-}
-
-sub auto() {
- my $changed = 0;
- foreach (@f) {
- my $c = 0;
- if (member($_->{val}{DESCRIPTION}, keys %$scanner::scannerDB)) {
- my $name = $_->{val}{DESCRIPTION};
- $name =~ s/\s$//; # some HP entries have a trailing space, i will correct usbtable asap
- if ($scanner::scannerDB->{$name}{flags}{unsupported}) {
- $in->ask_warn('Scannerdrake', N("The %s is not supported by this version of %s.", removeverticalbar($name), $distroname));
- next;
- }
- if ($in->ask_yesorno('Scannerdrake', N("%s found on %s, configure it automatically?", removeverticalbar($name), $_->{port}),1)) {
- $c = (tryConfScanner($name, $_->{port},
- $_->{val}{vendor},
- $_->{val}{id}) ||
- manual($_->{port}, $_->{val}{vendor},
- $_->{val}{id}, $name));
- } else {
- $c = manual($_->{port}, $_->{val}{vendor},
- $_->{val}{id}, $name);
- }
- } else {
- $in->ask_yesorno('Scannerdrake',
- N("%s is not in the scanner database, configure it manually?",
- removeverticalbar($_->{val}{DESCRIPTION})),1)
- and $c =
- manual($_->{port}, $_->{val}{vendor}, $_->{val}{id},
- $_->{val}{DESCRIPTION});
- }
- $changed ||= $c;
- }
- return $changed;
-}
-
-sub manual {
- my ($port, $vendor, $product, $name) = @_;
- my $s =
- $in->ask_from_treelist('Scannerdrake',
- N("Select a scanner model") .
- if_($port || $name, N(" (")) .
- if_($name, N("Detected model: %s",
- removeverticalbar($name))) .
- if_($port && $name, N(", ")) .
- if_($port, N("Port: %s", $port)) .
- if_($port || $name, N(")")),
- '|', [' None', keys %$scanner::scannerDB],
- '') or return 0;
- return 0 if $s eq ' None';
- if ($scanner::scannerDB->{$s}{flags}{unsupported}) {
- $in->ask_warn('Scannerdrake', N("The %s is not supported by this version of %s.", removeverticalbar($s), $distroname));
- return 0;
- }
- return tryConfScanner($s, $port, $vendor, $product);
-}
-
-sub dynamic() {
- @f = scanner::detect();
- my $name;
- foreach (@f) {
- if (member($_->{val}{DESCRIPTION}, keys %$scanner::scannerDB)) {
- $name = $_->{val}{DESCRIPTION};
- $name =~ s/\s$//; #some HP entry have a trailing space, i will correct usbtable asap
- next if ($scanner::scannerDB->{$name}{flags}{unsupported});
- scanner::confScanner($name, $_->{port},
- $_->{val}{vendor}, $_->{val}{id}, "");
- }
- }
-}
-
-sub installfirmware {
- my ($model, $backend) = @_;
- my $firmware;
- my $choice = N("Do not install firmware file");
- while (1) {
- # Tell user about firmware installation
- $in->ask_from('Scannerdrake',
- N("It is possible that your %s needs its firmware to be uploaded everytime when it is turned on.", removeverticalbar($model)) . " " .
- N("If this is the case, you can make this be done automatically.") . " " .
- N("To do so, you need to supply the firmware file for your scanner so that it can be installed.") . " " .
- N("You find the file on the CD or floppy coming with the scanner, on the manufacturer's home page, or on your Windows partition."),
- [
- { label => N("Install firmware file from"),
- val => \$choice,
- list => [N("CD-ROM"),
- N("Floppy Disk"),
- N("Other place"),
- N("Do not install firmware file")],
- not_edit => 1, sort => 0 },
- ],
- ) or return "///";
- my $dir;
- if ($choice eq N("CD-ROM")) {
- $dir = "/mnt/cdrom";
- } elsif ($choice eq N("Floppy Disk")) {
- $dir = "/mnt/floppy";
- } elsif ($choice eq N("Other place")) {
- $dir = "/mnt";
- } else {
- return "";
- }
- # Let user select a firmware file from a floppy, hard disk, ...
- $firmware = $in->ask_file(N("Select firmware file"), "$dir");
- last if !$firmware || (-r $firmware);
- $in->ask_warn(N("Error"),
- N("The firmware file %s does not exist or is unreadable!",
- $firmware));
-
- }
- # Install the firmware file in /usr/share/sane/firmware
- $firmware = scanner::installfirmware($firmware, $backend);
- return $firmware;
-}
-
-sub updatefirmware {
- my (@configured) = @_;
- my $firmware;
- my @scanners =
- map {
- $_->{val}{DESCRIPTION}
- } grep {
- $_->{val}{FIRMWARELINE}
- } @configured;
- my ($scannerchoice, $mediachoice);
- while (1) {
- # Tell user about firmware installation
- $in->ask_from('Scannerdrake',
- ($#scanners > 0 ?
- N("It is possible that your scanners need their firmware to be uploaded everytime when they are turned on.") :
- N("It is possible that your %s needs its firmware to be uploaded everytime when it is turned on.", $scanners[0])) . " " .
- N("If this is the case, you can make this be done automatically.") . " " .
- ($#scanners > 0 ?
- N("To do so, you need to supply the firmware files for your scanners so that it can be installed.") :
- N("To do so, you need to supply the firmware file for your scanner so that it can be installed.")) . " " .
- N("You find the file on the CD or floppy coming with the scanner, on the manufacturer's home page, or on your Windows partition.") . "\n" .
- N("If you have already installed your scanner's firmware you can update the firmware here by supplying the new firmware file."),
- [
- { label => N("Install firmware for the"),
- val => \$scannerchoice,
- list => \@scanners,
- not_edit => 1, sort => 1 },
- { label => N("Install firmware file from"),
- val => \$mediachoice,
- list => [N("CD-ROM"),
- N("Floppy Disk"),
- N("Other place")],
- not_edit => 1, sort => 0 },
- ],
- ) or return 0;
- my $dir;
- if ($mediachoice eq N("CD-ROM")) {
- $dir = "/mnt/cdrom";
- } elsif ($mediachoice eq N("Floppy Disk")) {
- $dir = "/mnt/floppy";
- } elsif ($mediachoice eq N("Other place")) {
- $dir = "/mnt";
- } else {
- return 0;
- }
- # Let user select a firmware file from a floppy, hard disk, ...
- $firmware = $in->ask_file(N("Select firmware file for the %s",
- $scannerchoice), "$dir");
- last if !$firmware || (-r $firmware);
- $in->ask_warn(N("Error"),
- N("The firmware file %s does not exist or is unreadable!",
- $firmware));
-
- }
-
- return 0 if !$firmware;
-
- foreach (@configured) {
- next if $_->{val}{DESCRIPTION} ne $scannerchoice;
- # Install the firmware file in /usr/share/sane/firmware
- my $backend = $_->{val}{BACKEND};
- $firmware = scanner::installfirmware($firmware, $backend);
- if (!$firmware) {
- $in->ask_warn('Error',
- N("Could not install the firmware file for the %s!",
- $scannerchoice));
- return 0;
- }
- # Enter the path to the firmware in the appropriate config file
- my $firmwareline =$_->{val}{FIRMWARELINE};
- $firmwareline =~ s/\$FIRMWARE/$firmware/sg;
- scanner::setfirmware($backend, $firmwareline);
- last;
- }
-
- # Success message
- $in->ask_warn('Scannerdrake',
- N("The firmware file for your %s was successfully installed.",
- $scannerchoice));
-
- return 1;
-}
-
-sub tryConfScanner {
- # take care if interactive output is needed (unsupported, parallel..)
- my ($model, $port, $vendor, $product) = @_;
- if ($scanner::scannerDB->{$model}{flags}{unsupported}) {
- $in->ask_warn('Scannerdrake', N("The %s is unsupported",
- removeverticalbar($model)));
- return 0;
- }
- if ($scanner::scannerDB->{$model}{server} =~ /(printerdrake|hpoj)/i) {
- $in->ask_warn('Scannerdrake', N("The %s must be configured by printerdrake.\nYou can launch printerdrake from the %s Control Center in Hardware section.", removeverticalbar($model), $shortdistroname));
- return 0;
- }
- if ($scanner::scannerDB->{$model}{ask} =~ /DEVICE/ || !$port) {
- $port ||= N("Auto-detect available ports");
- $in->ask_from('Scannerdrake',
- N("Please select the device where your %s is attached", removeverticalbar($model)) . " " .
- N("(Note: Parallel ports cannot be auto-detected)"),
- [
- { label => N("choose device"),
- val => \$port,
- list => [N("Auto-detect available ports"),
- '/dev/scanner',
- '/dev/usb/scanner0',
- '/dev/usb/scanner1',
- '/dev/usb/scanner2',
- 'libusb:001:001',
- 'libusb:001:002',
- 'libusb:001:003',
- 'libusb:001:004',
- 'libusb:001:005',
- 'libusb:001:006',
- 'libusb:001:007',
- 'libusb:001:008',
- 'libusb:001:009',
- 'libusb:001:010',
- '/dev/sg0',
- '/dev/sg1',
- '/dev/sg2',
- '/dev/sg3',
- '/dev/sg4',
- '/dev/parport0',
- '/dev/parport1',
- '/dev/parport2',
- '/dev/pt_drv',
- '/dev/ttyS0',
- '/dev/ttyS1',
- '/dev/ttyS2'],
- not_edit => 0, sort => 0 },
- ],
- ) or return 0;
- if ($port eq N("Auto-detect available ports")) {
- $wait = $in->wait_message(N("Scannerdrake"),
- N("Searching for scanners..."));
- my @d = scanner::detect();
- undef $wait;
- my @list = map {
- $_->{port} . " (" .
- removeverticalbar($_->{val}{DESCRIPTION}) . ")";
- } @d;
- $port ||= $list[0];
- $in->ask_from('Scannerdrake',
- N("Please select the device where your %s is attached", removeverticalbar($model)),
- [
- { label => N("choose device"),
- val => \$port,
- list => \@list,
- not_edit => 1, sort => 0 },
- ],
- ) or return 0;
- $port =~ s/^\s*([^\(\s]*)\s*\(.*$/$1/;
- foreach (@d) {
- next if $_->{port} ne $port;
- $vendor = $_->{val}{vendor};
- $product = $_->{val}{id};
- last;
- }
- }
- }
- ($vendor, $product) = scanner::get_usb_ids_for_port($port);
- my $firmware;
- if (grep { /FIRMWARELINE/ } @{$scanner::scannerDB->{$model}{lines}} ) {
- $firmware = installfirmware($model,
- $scanner::scannerDB->{$model}{server});
- return 0 if $firmware eq "///";
- }
- scanner::confScanner($model, $port, $vendor, $product, $firmware);
- $in->ask_warn(N("Congratulations!"),
- N("Your %s has been configured.\nYou may now scan documents using \"XSane\" or \"Kooka\" from Multimedia/Graphics in the applications menu.", removeverticalbar($model)));
- return 1;
-}
-
-sub quit() {
- $in->exit(0);
-}
-
-sub mainwindow {
- my @configured = @_;
- # main loop
- my $maindone;
- while (!$maindone) {
- # Generate list of configured scanners
- my $msg = do {
- if (@configured) {
- my @scannerlist =
- map {
- my $entry = $_->{val}{DESCRIPTION};
- if_($entry, " - $entry\n");
- } @configured;
- if (@scannerlist) {
- my $main_msg =
- @scannerlist > 1 ?
- N_("The following scanners\n\n%s\nare available on your system.\n") :
- N_("The following scanner\n\n%s\nis available on your system.\n");
- sprintf($main_msg, join('', @scannerlist));
- } else {
- N("There are no scanners found which are available on your system.\n");
- }
- } else {
- N("There are no scanners found which are available on your system.\n");
- }
- };
- my $buttonclicked;
- #- Show dialog
- if ($in->ask_from_
- (
- {
- title => N("Scannerdrake"),
- messages => $msg,
- ok => "",
- cancel => "",
- },
- [
- { val => N("Search for new scanners"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "autoadd";
- 1;
- } },
- { val => N("Add a scanner manually"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "manualadd";
- 1;
- } },
- ( (grep { $_->{val}{FIRMWARELINE} } @configured) ?
- { val => N("Install/Update firmware files"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "firmware";
- 1;
- } } : () ),
- { val => N("Scanner sharing"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "sharing";
- 1;
- } },
- { val => N("Quit"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "quit";
- 1;
- } },
- ]
- )
- ) {
- my $changed = 0;
- if ($buttonclicked eq "autoadd") {
- # Do scanner auto-detection
- my $wait =
- $in->wait_message(N("Scannerdrake"),
- N("Searching for configured scanners..."));
- @configured = scanner::configured();
- $wait =
- $in->wait_message(N("Scannerdrake"),
- N("Searching for new scanners..."));
- my @f = scanner::detect(@configured);
- $wait = undef;
- if (@f) {
- $changed = auto();
- }
- } elsif ($buttonclicked eq "manualadd") {
- # Show dialogs to manually add a scanner
- $changed = manual();
- } elsif ($buttonclicked eq "sharing") {
- # Show dialog to set up scanner sharing
- $changed = sharewindow(@configured);
- } elsif ($buttonclicked eq "firmware") {
- # Show dialog to select the firmware file
- updatefirmware(@configured);
- } elsif ($buttonclicked eq "quit") {
- # We have clicked "Quit"
- $maindone = 1;
- }
- if ($changed) {
- my $_wait =
- $in->wait_message(N("Scannerdrake"),
- N("Re-generating list of configured scanners..."));
- @configured = scanner::configured();
- }
- } else {
- # Cancel clicked
- $maindone = 1;
- }
- }
-}
-
-sub makeexportmenues {
- my @exports = @_;
- my %menuexports = map {
- ($_ eq '+' ? N("All remote machines") : $_) => $_;
- } map {
- # Remove comments and blank lines
- (/^\s*($|#)/ ? () : chomp_($_));
- } @exports;
- my %menuexports_inv = reverse %menuexports;
- return (\%menuexports, \%menuexports_inv);
-}
-
-sub makeimportmenues {
- my @imports = @_;
- my %menuimports = map {
- ($_ eq 'localhost' ? N("This machine") : $_) => $_;
- } map {
- # Remove comments and blank lines
- if_(!/^\s*($|#)/, chomp_($_));
- } @imports;
- my %menuimports_inv = reverse %menuimports;
- return (\%menuimports, \%menuimports_inv);
-}
-
-sub sharewindow {
- my @_configured = @_;
- # Read list of hosts to where to export the local scanners
- my @exports = cat_("/etc/sane.d/saned.conf");
- my ($menuexports, $menuexports_inv) =
- makeexportmenues(@exports);
- # Read list of hosts from where to import scanners
- my @imports = cat_("/etc/sane.d/net.conf");
- my ($menuimports, $menuimports_inv) =
- makeimportmenues(@imports);
- # Is saned running?
- my $sanedrunning = services::starts_on_boot("saned");
- my $oldsanedrunning = $sanedrunning;
- # Is the "net" SANE backend active
- my $netbackendactive = grep { /^\s*net\s*$/ }
- cat_("/etc/sane.d/dll.conf");
- my $oldnetbackendactive = $netbackendactive;
- # Set this to 1 to tell the caller that the list of locally available
- # scanners has changed (Here if the SANE client configuration has
- # changed)
- my $changed = 0;
- my $importschanged = 0;
- # main loop
- my $maindone;
- while (!$maindone) {
- my $buttonclicked;
- #- Show dialog
- if ($in->ask_from_
- (
- {
- title => N("Scannerdrake"),
- messages => N("Here you can choose whether the scanners connected to this machine should be accessible by remote machines and by which remote machines.") .
- N("You can also decide here whether scanners on remote machines should be made available on this machine."),
- },
- [
- { text => N("The scanners on this machine are available to other computers"), type => 'bool',
- val => \$sanedrunning },
- { val => N("Scanner sharing to hosts: ") .
- (keys %$menuexports > 0 ?
- (keys %$menuexports > 2 ?
- join(", ", (keys %$menuexports)[0,1]) . " ..." :
- join(", ", keys %$menuexports)) :
- N("No remote machines")),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "exports";
- 1;
- },
- disabled => sub {
- !$sanedrunning;
- } },
- { text => N("Use scanners on remote computers"),
- type => 'bool',
- val => \$netbackendactive },
- { val => N("Use the scanners on hosts: ") .
- (keys %$menuimports > 0 ?
- (keys %$menuimports > 2 ?
- join(", ", (keys %$menuimports)[0,1]) . " ..." :
- join(", ", keys %$menuimports)) :
- N("No remote machines")),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "imports";
- 1;
- },
- disabled => sub {
- !$netbackendactive;
- } },
- ]
- )
- ) {
- if ($buttonclicked eq "exports") {
- # Show dialog to add hosts to share scanners to
- my $subdone = 0;
- my $choice;
- while (!$subdone) {
- my @list = keys %$menuexports;
- # Entry should be edited when double-clicked
- $buttonclicked = "edit";
- $in->ask_from_
- (
- { title => N("Sharing of local scanners"),
- messages => N("These are the machines on which the locally connected scanner(s) should be available:"),
- ok => "",
- cancel => "",
- },
- # List the hosts
- [ { val => \$choice, format => \&translate,
- sort => 0, separator => "####",
- tree_expanded => 1,
- quit_if_double_click => 1,
- allow_empty_list => 1,
- list => \@list },
- { val => N("Add host"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "add";
- 1;
- } },
- { val => N("Edit selected host"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "edit";
- 1;
- },
- disabled => sub {
- return ($#list < 0);
- } },
- { val => N("Remove selected host"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "remove";
- 1;
- },
- disabled => sub {
- return ($#list < 0);
- } },
- { val => N("Done"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "";
- $subdone = 1;
- 1;
- } },
- ]
- );
- if ($buttonclicked eq "add" ||
- $buttonclicked eq "edit") {
- my ($hostchoice, $ip);
- if ($buttonclicked eq "add") {
- # Use first entry as default for a new entry
- $hostchoice =
- N("Name/IP address of host:");
- } else {
- if ($menuexports->{$choice} eq '+') {
- # Entry is "All hosts"
- $hostchoice = $choice;
- } else {
- # Entry is a name/an IP address
- $hostchoice =
- N("Name/IP address of host:");
- $ip = $choice;
- }
- }
- my @menu = (N("All remote machines"),
- N("Name/IP address of host:"));
- # Show the dialog
- my $address;
- my $oldaddress =
- ($buttonclicked eq "edit" ?
- $menuexports->{$choice} : "");
- if ($in->ask_from_
- (
- { title => N("Sharing of local scanners"),
- messages => N("Choose the host on which the local scanners should be made available:"),
- callbacks => {
- complete => sub {
- if ($hostchoice eq $menu[0]) {
- $address = "+";
- } elsif ($hostchoice eq $menu[1]) {
- $address = $ip;
- }
- # Do not allow an empty address
- if ($address !~ /\S/) {
- $in->ask_warn(N("Error"),
- N("You must enter a host name or an IP address.\n"));
- return (1,0);
- }
- # Strip off leading and trailing
- # spaces
- $address =~ s/^\s*(.*?)\s*$/$1/;
- # Check whether item is duplicate
- if ($address ne $oldaddress &&
- member("$address\n",
- @exports)) {
- $in->ask_warn(N("Error"),
- N("This host is already in the list, it cannot be added again.\n"));
- return (1,1);
- }
- return 0;
- },
- },
- },
- # List the host types
- [ { val => \$hostchoice, format => \&translate,
- type => 'list',
- sort => 0,
- list => \@menu },
- { val => \$ip,
- disabled => sub {
- $hostchoice ne
- N("Name/IP address of host:");
- } },
- ],
- )) {
- # OK was clicked, insert new item into the list
- if ($buttonclicked eq "add") {
- handle_configs::set_directive(\@exports,
- $address);
- } else {
- handle_configs::replace_directive(\@exports,
- $oldaddress,
- $address);
- }
- # Refresh list of hosts
- ($menuexports, $menuexports_inv) =
- makeexportmenues(@exports);
- # Position the list cursor on the new/modified
- # item
- $choice = $menuexports_inv->{$address};
- }
- } elsif ($buttonclicked eq "remove") {
- my $address = $menuexports->{$choice};
- handle_configs::remove_directive(\@exports,
- $address);
- # Refresh list of hosts
- ($menuexports, $menuexports_inv) =
- makeexportmenues(@exports);
- }
- }
- } elsif ($buttonclicked eq "imports") {
- # Show dialog to add hosts on which the scanners should be
- # used
- my $subdone = 0;
- my $choice;
- while (!$subdone) {
- my @list = keys %$menuimports;
- # Entry should be edited when double-clicked
- $buttonclicked = "edit";
- $in->ask_from_
- (
- { title => N("Usage of remote scanners"),
- messages => N("These are the machines from which the scanners should be used:"),
- ok => "",
- cancel => "",
- },
- # List the hosts
- [ { val => \$choice, format => \&translate,
- sort => 0, separator => "####",
- tree_expanded => 1,
- quit_if_double_click => 1,
- allow_empty_list => 1,
- list => \@list },
- { val => N("Add host"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "add";
- 1;
- } },
- { val => N("Edit selected host"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "edit";
- 1;
- },
- disabled => sub {
- return ($#list < 0);
- } },
- { val => N("Remove selected host"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "remove";
- 1;
- },
- disabled => sub {
- return ($#list < 0);
- } },
- { val => N("Done"),
- type => 'button',
- clicked_may_quit => sub {
- $buttonclicked = "";
- $subdone = 1;
- 1;
- } },
- ]
- );
- if ($buttonclicked eq "add" ||
- $buttonclicked eq "edit") {
- my ($hostchoice, $ip);
- if ($buttonclicked eq "add") {
- # Use first entry as default for a new entry
- $hostchoice =
- N("Name/IP address of host:");
- } else {
- if ($menuimports->{$choice} eq 'localhost') {
- # Entry is "This machine"
- $hostchoice = $choice;
- } else {
- # Entry is a name/an IP address
- $hostchoice =
- N("Name/IP address of host:");
- $ip = $choice;
- }
- }
- my @menu = (N("This machine"),
- N("Name/IP address of host:"));
- # Show the dialog
- my $address;
- my $oldaddress =
- ($buttonclicked eq "edit" ?
- $menuimports->{$choice} : "");
- if ($in->ask_from_
- (
- { title => N("Sharing of local scanners"),
- messages => N("Choose the host on which the local scanners should be made available:"),
- callbacks => {
- complete => sub {
- if ($hostchoice eq $menu[0]) {
- $address = 'localhost';
- } elsif ($hostchoice eq $menu[1]) {
- $address = $ip;
- }
- # Do not allow an empty address
- if ($address !~ /\S/) {
- $in->ask_warn(N("Error"),
- N("You must enter a host name or an IP address.\n"));
- return (1,0);
- }
- # Strip off leading and trailing
- # spaces
- $address =~ s/^\s*(.*?)\s*$/$1/;
- # Check whether item is duplicate
- if ($address ne $oldaddress &&
- member("$address\n",
- @imports)) {
- $in->ask_warn(N("Error"),
- N("This host is already in the list, it cannot be added again.\n"));
- return (1,1);
- }
- return 0;
- },
- },
- },
- # List the host types
- [ { val => \$hostchoice, format => \&translate,
- type => 'list',
- sort => 0,
- list => \@menu },
- { val => \$ip,
- disabled => sub {
- $hostchoice ne
- N("Name/IP address of host:");
- } },
- ],
- )) {
- # OK was clicked, insert new item into the list
- if ($buttonclicked eq "add") {
- handle_configs::set_directive(\@imports,
- $address);
- } else {
- handle_configs::replace_directive(\@imports,
- $oldaddress,
- $address);
- }
- $importschanged = 1;
- # Refresh list of hosts
- ($menuimports, $menuimports_inv) =
- makeimportmenues(@imports);
- # Position the list cursor on the new/modified
- # item
- $choice = $menuimports_inv->{$address};
- }
- } elsif ($buttonclicked eq "remove") {
- my $address = $menuimports->{$choice};
- handle_configs::remove_directive(\@imports,
- $address);
- # Refresh list of hosts
- ($menuimports, $menuimports_inv) =
- makeimportmenues(@imports);
- $importschanged = 1;
- }
- }
- } else {
- # We have clicked "OK"
- $maindone = 1;
- if ($importschanged) {
- $changed = 1;
- }
- # Write /etc/sane.d/saned.conf
- output("/etc/sane.d/saned.conf", @exports);
- # Write /etc/sane.d/net.conf
- output("/etc/sane.d/net.conf", @imports);
- # Turn on/off saned
- if ($sanedrunning != $oldsanedrunning) {
- if ($sanedrunning) {
- # Make sure saned and xinetd is installed and
- # running
- if (!files_exist('/usr/sbin/xinetd',
- '/usr/sbin/saned')) {
- if (!$in->ask_yesorno(N("Warning"), N("saned needs to be installed to share the local scanner(s).
-
-Do you want to install the saned package?"))) {
- $in->ask_warn("Scannerdrake",
- N("Your scanner(s) will not be available on the network."));
- } elsif (!$in->do_pkgs->install('xinetd', 'saned')) {
- $in->ask_warn(N("Error"),
- N("Could not install the packages needed to share your scanner(s).") . " " .
- N("Your scanner(s) will not be available on the network."));
- }
- }
- # Start saned and make sure that it gets started on
- # every boot
- services::start_service_on_boot("saned");
- services::start_service_on_boot("xinetd");
- services::restart("xinetd");
- } else {
- # Stop saned and make sure that it does not get
- # started when booting
- services::do_not_start_service_on_boot("saned");
- services::restart("xinetd");
- }
- }
- # Turn on/off "net" SANE backend
- if ($netbackendactive != $oldnetbackendactive) {
- my @dllconf = cat_("/etc/sane.d/dll.conf");
- if ($netbackendactive) {
- handle_configs::set_directive(\@dllconf, "net");
- } else {
- handle_configs::comment_directive(\@dllconf, "net");
- }
- output("/etc/sane.d/dll.conf", @dllconf);
- $changed = 1;
- }
- }
- } else {
- # Cancel clicked
- $maindone = 1;
- }
- }
- return $changed;
-}
diff --git a/perl-install/standalone/service_harddrake b/perl-install/standalone/service_harddrake
deleted file mode 100755
index 530059ff1..000000000
--- a/perl-install/standalone/service_harddrake
+++ /dev/null
@@ -1,212 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-
-use strict;
-use diagnostics;
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use c;
-use common;
-use interactive;
-use detect_devices;
-use harddrake::data;
-use harddrake::autoconf;
-use harddrake::sound;
-use modules;
-use Storable qw(store retrieve);
-
-
-my $force = member('--force', @ARGV);
-
-my $mode = $ARGV[0] eq 'stop' && 'stop';
-
-if ($mode eq 'stop') {
- append_to_file('/etc/hotplug/blacklist', "\nsnd-usb-audio\n");
- c::_exit(0);
-}
-
-my $invert_do_it = $ARGV[0] eq 'X11' ? 1 : 0;
-my ($hw_sysconfdir, $timeout) = ("/etc/sysconfig/harddrake2", $invert_do_it ? 600 : 25);
-my $last_boot_config = "$hw_sysconfdir/previous_hw";
-
-$last_boot_config .= '_X11' if $invert_do_it;
-
-my $modules_conf = modules::any_conf->read;
-
-# autoreconfigure the mouse on major kernel change:
-my $prev_kernel = { getVarsFromSh("$hw_sysconfdir/kernel") }->{KERNEL};
-my $curr_kernel = c::kernel_version();
-$curr_kernel =~ s/(^\d+\.\d+).*/$1/;
-setVarsInSh("$hw_sysconfdir/kernel", { KERNEL => $curr_kernel });
-if ($curr_kernel ne $prev_kernel) {
- log::explanations("Autoconfiguring mouse since we switched between 2.4.x and 2.6.x kernels");
- harddrake::autoconf::mouse_conf($modules_conf);
-}
-
-if (find { $_->{driver} =~ /Card:NVIDIA/ } detect_devices::probeall()) {
- if (find { -e join('', "/lib/modules/", c::kernel_version(), "/kernel/drivers/$_") } map { ("video/$_", "char/$_", "char/drm/$_") } qw(NVdriver nvidia.o nvidia.o.gz nvidia.ko nvidia.ko.gz)) {
- # do not automatically switch from nv to nvidia (in order to handle
- # cases where nvidia module crashes the system):
- #
- # substInFile {
- # log::explanations("switch XFree86 driver from nv to nvidia") if /Driver "nv"/;
- # s!Driver "nv.*"!Driver "nvidia"!g;
- # s!#*( Load.*glx)!\1!g;
- # } $_ foreach "/etc/X11/XF86Config-4", "/etc/X11/XF86Config";
- } else {
- substInFile {
- log::explanations("switch XFree86 driver from nvidia to nv") if /Driver "nv.+"/;
- s!Driver "nv.*"!Driver "nv"!g;
- } $_ foreach grep { -e $_ } "/etc/X11/XF86Config-4", "/etc/X11/XF86Config";
- }
-}
-
-my $is_globetrotter = -f '/usr/sbin/mdkmove';
-
-# first run ? if not read old hw config
-my $previous_config;
-
-if (-f $last_boot_config && -s $last_boot_config) {
- eval { $previous_config = Storable::retrieve($last_boot_config) };
- log::explanations("resetting previous harware file ($@)") if $@;
-}
-
-$previous_config ||= {};
-
-$previous_config = $$previous_config if ref($previous_config) !~ /HASH/;
-my (%config, $wait);
-my $in;
-my $splash = -f '/proc/splash';
-my $splash_was_silent = cat_('/proc/splash') =~ /, silent : on/;
-
-# For each hw, class, detect device, compare and offer to reconfigure if needed
-foreach my $hw_class (@harddrake::data::tree) {
- my ($Ident, $item, $configurator, $detector, $do_it) = @$hw_class{qw(class string configurator detector checked_on_boot)};
- $configurator ||= $hw_class->{configurator};
-
- next unless $do_it ^ $invert_do_it;
- # No detector ? (should never happen but who know ?)
- ref($detector) eq 'CODE' or next;
-
- my %ID = map {
- my $i = $_;
- my $id = defined $i->{device} ? $i->{device} : join(':', map { $i->{$_} } qw(vendor id subvendor subid));
- $id => $i;
- } eval { &$detector };
- $config{$Ident} = \%ID;
- next if !$is_globetrotter && !$force && is_empty_hash_ref($previous_config); # don't fsck on first run but if --force
-
- my $oldconfig = $previous_config->{$Ident};
-
- my $msg;
- my @was_removed = difference2([ keys %$oldconfig ], [ keys %ID ]);
- if (@was_removed) {
- $msg .= N("Some devices in the \"%s\" hardware class were removed:\n", $item) .
- join('', map { N("- %s was removed\n", harddrake::data::custom_id($oldconfig->{$_}, $item)) } @was_removed) . "\n";
- }
- my @added = difference2([ keys %ID ], [ keys %$oldconfig ]);
- $msg .= N("Some devices were added: %s\n", $item) if @added;
- $msg .= N("- %s was added\n", harddrake::data::custom_id($ID{$_}, $item)) foreach @added;
- log::explanations("removed $Ident: " . harddrake::data::custom_id($oldconfig->{$_}, $item)) foreach @was_removed;
- log::explanations("added $Ident: " . harddrake::data::custom_id($ID{$_}, $item)) foreach @added;
-
- modules::load_and_configure($modules_conf, 'ohci1394') if $Ident eq 'FIREWIRE_CONTROLLER' && any { $_->{driver} eq 'ohci1394' } @added;
- @added || @was_removed or next;
-
- next if $Ident eq 'MOUSE' && $curr_kernel ne $prev_kernel;
-
- my @configurator_pool;
- if (harddrake::data::is_removable($Ident)) {
- foreach my $device (@ID{@added}) {
- push @configurator_pool, harddrake::data::set_removable_auto_configurator($Ident, $device);
- };
- foreach my $device (@$oldconfig{@was_removed}) {
- push @configurator_pool, harddrake::data::set_removable_remover($Ident, $device);
- }
- } else {
- @configurator_pool = $configurator;
- }
- if ($Ident eq "AUDIO") {
- # automatic sound slots configuration
- rm_rf("/etc/asound.state");
- harddrake::sound::configure_sound_slots($modules_conf);
- next;
- } elsif ($Ident eq "ETHERNET") {
- $modules_conf->remove_alias_regexp('^(wlan|eth)[0-9]*$');
- modules::load_category($modules_conf, 'network/main|gigabit|usb|wireless|firewire|pcmcia');
- require network::ethernet;
- network::ethernet::update_iftab();
- network::ethernet::configure_eth_aliases($modules_conf);
- $modules_conf->write;
- } elsif (member($Ident, qw(AGP ATA_STORAGE SATA_STORAGE SCSI_CONTROLLER TV))) {
- # add agpgart and the like modules to modprobe.preload if needed:
- $modules_conf->write;
- next;
- } elsif ($Ident eq "USB_CONTROLLER") {
- modules::load_category($modules_conf, 'bus/usb');
- $modules_conf->write;
- } elsif ($Ident eq "VIDEO") {
- harddrake::autoconf::xconf($modules_conf, {});
- next;
- } elsif ($Ident eq "MOUSE") {
- harddrake::autoconf::mouse_conf($modules_conf);
- next;
- }
-
- next if $is_globetrotter && !$hw_class->{automatic};
- next unless $configurator_pool[0];
- if (ref($configurator) ne 'CODE' && !-x first(split /\s+/, $configurator_pool[0])) {
- log::explanations(qw(skip $Ident configuration since "$configurator" isn't executable));
- next;
- }
- my ($pid, $no, $res);
- $hw_class->{automatic} ||= ref($configurator) eq 'CODE';
-
- if (!$hw_class->{automatic}) {
- $SIG{ALRM} = sub { $no = 1; kill 15, $pid };
- unless ($pid = fork()) {
- $splash and eval { output('/proc/splash', 'verbose') } and $splash = 0;
- exec("/usr/share/harddrake/confirm", $Ident, $timeout, $msg);
- }
- alarm($timeout);
- wait();
- $res = $?;
- alarm(0);
- } else {
- $res = 1;
- }
- if (ref($configurator) eq 'CODE') {
- eval { $configurator->() };
- log::explanations(qw(cannot run "$configurator": $@)) if $@;
- } elsif (!$no && $res) {
- foreach my $program (@configurator_pool) {
- if (fork()) {
- wait();
- } else {
- log::explanations(qq(run "$program"));
- exec("$program 2>/dev/null") or do {
- log::explanations(qq(cannot run "$program"));
- require POSIX;
- POSIX::_exit();
- };
- }
- }
- }
- if (!$hw_class->{automatic}) {
- require interactive;
- undef $wait;
- $in ||= interactive->vnew;
- $wait = $in->wait_message(N("Please wait"), N("Hardware probing in progress"));
- }
-
-}
-
-# output new hw config
-log::explanations("created file $last_boot_config");
-Storable::store(\%config, $last_boot_config);
-
-# restore bootsplash mode
-$splash_was_silent and eval { output('/proc/splash', 'silent') };
-
-
-$in->exit(0) if $in;
diff --git a/perl-install/standalone/service_harddrake.sh b/perl-install/standalone/service_harddrake.sh
deleted file mode 100644
index c12bedc31..000000000
--- a/perl-install/standalone/service_harddrake.sh
+++ /dev/null
@@ -1,54 +0,0 @@
-#!/bin/bash
-#
-# harddrake This scripts runs the harddrake hardware probe.
-#
-# chkconfig: 345 05 95
-# description: This runs the hardware probe, and optionally configures \
-# changed hardware.
-
-# This is an interactive program, we need the current locale
-
-[[ -f /etc/profile.d/lang.sh ]] && . /etc/profile.d/lang.sh
-
-# Source function library.
-. /etc/rc.d/init.d/functions
-
-
-SUBSYS=/var/lock/subsys/harddrake
-
-case "$1" in
- start)
-# We (mdk) don't support updfstab (yet)
-# action "Updating /etc/fstab" /usr/sbin/updfstab
-
- gprintf "Checking for new hardware"
- /usr/share/harddrake/service_harddrake 2>/dev/null
- RETVAL=$?
- if [ "$RETVAL" -eq 0 ]; then
- action "" /bin/true
- else
- action "" /bin/false
- fi
- # We don't want to run this on random runlevel changes.
- touch $SUBSYS
-# [ /etc/modules.conf -nt /lib/modules/$(uname -r)/modules.dep ] && touch /lib/modules/$(uname -r)/modules.dep 2>/dev/null >/dev/null || : &
- exit $RETVAL
- ;;
- status)
- if [ -f $SUBSYS ]; then
- gprintf "Harddrake service was run at boot time"
- else gprintf "Harddrake service was not run at boot time"
- fi
- ;;
- reload)
- ;;
- stop)
- # dummy
- rm -f $SUBSYS
- action "Stopping %s" harddrake /usr/share/harddrake/service_harddrake stop 2>/dev/null
- ;;
- *)
- gprintf "Usage: %s {start|stop}\n" "$0"
- exit 1
- ;;
-esac
diff --git a/perl-install/standalone/service_harddrake_confirm b/perl-install/standalone/service_harddrake_confirm
deleted file mode 100644
index 1528fd9bf..000000000
--- a/perl-install/standalone/service_harddrake_confirm
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/usr/bin/perl
-use lib qw(/usr/lib/libDrakX);
-use common;
-use interactive;
-
-my $in = interactive->vnew;
-my $res = $in->ask_okcancel(N("Hardware changes in \"%s\" class (%s seconds to answer)", $ARGV[0], $ARGV[1]),
- $ARGV[2] . N("Do you want to run the appropriate config tool?"), 1);
-$in->exit($res);