summaryrefslogtreecommitdiffstats
path: root/perl-install/standalone
diff options
context:
space:
mode:
authorMystery Man <unknown@mandriva.org>2002-08-29 08:27:03 +0000
committerMystery Man <unknown@mandriva.org>2002-08-29 08:27:03 +0000
commite3000d1c3652d63caebb334ab96251875e875b5c (patch)
treef1011fca62406be25bdce4ba865d3c0cf9d933e1 /perl-install/standalone
parent71180d5532cd2fe1853cc32d8826a04644e2ec08 (diff)
downloaddrakx-backup-do-not-use-e3000d1c3652d63caebb334ab96251875e875b5c.tar
drakx-backup-do-not-use-e3000d1c3652d63caebb334ab96251875e875b5c.tar.gz
drakx-backup-do-not-use-e3000d1c3652d63caebb334ab96251875e875b5c.tar.bz2
drakx-backup-do-not-use-e3000d1c3652d63caebb334ab96251875e875b5c.tar.xz
drakx-backup-do-not-use-e3000d1c3652d63caebb334ab96251875e875b5c.zip
This commit was manufactured by cvs2svn to create tag 'V1_1_9_25mdk'.V1_1_9_25mdk
Diffstat (limited to 'perl-install/standalone')
-rwxr-xr-xperl-install/standalone/XFdrake164
-rwxr-xr-xperl-install/standalone/adduserdrake43
-rwxr-xr-xperl-install/standalone/diskdrake106
-rwxr-xr-xperl-install/standalone/drakTermServ1304
-rwxr-xr-xperl-install/standalone/drakautoinst363
-rwxr-xr-xperl-install/standalone/drakbackup4915
-rwxr-xr-xperl-install/standalone/drakboot62
-rwxr-xr-xperl-install/standalone/drakbug198
-rwxr-xr-xperl-install/standalone/drakbug_report14
-rwxr-xr-xperl-install/standalone/drakconnect693
-rwxr-xr-xperl-install/standalone/drakfloppy455
-rwxr-xr-xperl-install/standalone/drakfont1264
-rwxr-xr-xperl-install/standalone/drakgw547
-rwxr-xr-xperl-install/standalone/drakproxy33
-rwxr-xr-xperl-install/standalone/draksound57
-rwxr-xr-xperl-install/standalone/draksplash544
-rwxr-xr-xperl-install/standalone/drakupdate_fstab123
-rwxr-xr-xperl-install/standalone/drakxservices23
-rwxr-xr-xperl-install/standalone/drakxtv168
-rwxr-xr-xperl-install/standalone/fileshareset389
-rwxr-xr-xperl-install/standalone/harddrake213
-rw-r--r--perl-install/standalone/icons/categ.pngbin5173 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakTS.620x57.pngbin410 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakbackup.540x57.pngbin15562 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakconnect_step.pngbin10749 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/drakfont.620x57.pngbin13239 -> 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/K7.pngbin594 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/cable.pngbin506 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/cd.pngbin712 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/cpu.pngbin438 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/floppy.pngbin419 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/harddisk.pngbin731 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/harddrake.pngbin671 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/hw_mouse.pngbin606 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/hw_network.pngbin499 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/hw_printer.pngbin547 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/ide_hd.pngbin712 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/isdn.pngbin584 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/joystick.pngbin592 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/keyboard.pngbin798 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/memory.pngbin527 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/modem.pngbin533 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/scanner.pngbin685 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/scsi.pngbin390 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/scsi_hd.pngbin677 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/sound.pngbin435 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/tape.pngbin374 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/tv.pngbin543 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/unknown.pngbin461 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/usb.pngbin432 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/video.pngbin526 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/harddrake2/webcam.pngbin444 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/hori.pngbin7232 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic-drakfont-48.pngbin3337 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-CD-40.pngbin1444 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-back-up-16.pngbin594 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-back-up-32.pngbin3153 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-back-up-48.pngbin4735 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-discdurwhat-40.pngbin1873 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-dossier-32.pngbin818 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-moreoption-40.pngbin1891 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-network-40.pngbin952 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-others-40.pngbin2230 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-system-40.pngbin1169 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-systemeplus-40.pngbin1551 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-tape-40.pngbin2389 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-users-40.pngbin1836 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-when-40.pngbin1834 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/ic82-where-40.pngbin1124 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/mdk_logo.pngbin10892 -> 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/reload.xpm31
-rw-r--r--perl-install/standalone/icons/smbnfs_default.pngbin279 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/smbnfs_has_mntpoint.pngbin300 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/smbnfs_mounted.pngbin295 -> 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_left.pngbin2185 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/wiz_default_up.pngbin14567 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/wiz_drakconnect.pngbin14567 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/wiz_drakgw.pngbin8733 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/wiz_firewall.pngbin7016 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/wiz_printerdrake.pngbin11340 -> 0 bytes
-rw-r--r--perl-install/standalone/icons/wiz_scannerdrake.pngbin7158 -> 0 bytes
-rw-r--r--perl-install/standalone/interactive_http/Makefile21
-rw-r--r--perl-install/standalone/interactive_http/authorised_progs13
-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.init51
-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/keyboarddrake67
-rwxr-xr-xperl-install/standalone/livedrake46
-rw-r--r--perl-install/standalone/localedrake40
-rwxr-xr-xperl-install/standalone/logdrake542
-rwxr-xr-xperl-install/standalone/lsnetdrake29
-rwxr-xr-xperl-install/standalone/mousedrake72
-rwxr-xr-xperl-install/standalone/net_monitor539
-rwxr-xr-xperl-install/standalone/printerdrake80
-rwxr-xr-xperl-install/standalone/scannerdrake126
-rwxr-xr-xperl-install/standalone/service_harddrake73
-rw-r--r--perl-install/standalone/service_harddrake.sh53
-rwxr-xr-xperl-install/standalone/tinyfirewall30
117 files changed, 0 insertions, 15420 deletions
diff --git a/perl-install/standalone/XFdrake b/perl-install/standalone/XFdrake
deleted file mode 100755
index c02a003e2..000000000
--- a/perl-install/standalone/XFdrake
+++ /dev/null
@@ -1,164 +0,0 @@
-#!/usr/bin/perl
-
-# XFdrake
-# Copyright (C) 1999 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 common;
-use any;
-use c;
-
-local $_ = join '', @ARGV;
-
-my ($configure_this) = grep { !/^-/ } @ARGV;
-$configure_this ||= 'everything';
-
-/-h/ || $configure_this !~ /^(resolution|monitor|everything|auto_install)/ and die <<'EOF';
-usage: XFdrake [--expert] [--noauto] [--auto] [everything]
- XFdrake [--noauto] monitor
- XFdrake resolution
-EOF
-
-my $auto = /-auto/;
-$::expert = /-expert/;
-$::noauto = /-noauto/;
-$::testing = /-testing/;
-
-begin:
-{
- my $in = 'interactive'->vnew('su', 'X');
-
- modules::mergein_conf('/etc/modules.conf') if -r '/etc/modules.conf';
-
- $::isEmbedded and kill 'USR2', $::CCPID;
-
- my $rc = do {
- if ($configure_this eq 'everything') {
- check_XFree($in);
- my $raw_X = Xconfig::xfree->read;
- my $default = Xconfig::default::configure();
- my $has_conf = @{$raw_X->{xfree3}} || @{$raw_X->{xfree4}};
- $raw_X->{xfree3} = $default->{xfree3} if !@{$raw_X->{xfree3}};
- $raw_X->{xfree4} = $default->{xfree4} if !@{$raw_X->{xfree4}};
-
- if ($has_conf) {
- Xconfig::main::configure_chooser($in, $raw_X, $in->do_pkgs, { allowNVIDIA_rpms => allowNVIDIA_rpms() });
- } else {
- Xconfig::main::configure_everything($in, $raw_X, $in->do_pkgs, $auto, { allowNVIDIA_rpms => allowNVIDIA_rpms() });
- }
- } elsif ($configure_this eq 'auto_install') {
- Xconfig::main::configure_everything_auto_install(Xconfig::default::configure(), $in->do_pkgs, {}, { allowNVIDIA_rpms => allowNVIDIA_rpms() });
- } 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);
- }
- };
- $rc && $rc eq 'config_changed' and ask_for_X_restart($in);
-
- $in->exit(0) if !$::isEmbedded;
-
- kill 'USR1', $::CCPID;
- goto begin;
-}
-
-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('XFree86', 'XFree86-75dpi-fonts');
- -e $f or die "install XFree86 first!\n";
-
- system("mount /proc 2>/dev/null"); # ensure /proc is mounted for pci probing
-}
-
-sub allowNVIDIA_rpms {
- my $allowNVIDIA_rpms;
- my (%list, %select);
-
- eval {
- require urpm;
- my $urpm = new urpm;
- $urpm->read_config(nocheck_access => 1);
- foreach (grep { !$_->{ignore} } @{$urpm->{media} || []}) {
- $urpm->parse_synthesis($_);
- }
- foreach (@{$urpm->{depslist} || []}) {
- $_->name =~ /NVIDIA/ and $list->{$_->name} = 1;
- }
- };
- if ($list{NVIDIA_GLX}) {
- eval {
- my ($version, $release, $ext) = c::kernel_version() =~ /([^-]*)-([^-]*mdk)(\S*)/;
- $ext and $ext = "-$ext";
- $list{"NVIDIA_kernel-$version-$release$ext"} or die "no NVIDIA kernel for current kernel";
- $select{"NVIDIA_kernel-$version-$release$ext"} = 1;
- foreach (`rpm -qa kernel-2* kernel-smp-2* kernel-enterprise-2* kernel-secure-2* kernel kernel-smp kernel-entreprise kernel22 kernel22-smp kernel22-secure`) {
- ($ext, $version, $release) = /kernel[^-]*(-\D[^-]*)-([^-]*)-([^-]*mdk)?/;
- $release or ($version, $release) = $version =~ /(.*?)\.(\d+mdk)/;
- $list{"NVIDIA_kernel-$version-$release$ext"} and $select{"NVIDIA_kernel-$version-$release$ext"} = 1;
- }
- $allowNVIDIA_rpms = [ keys(%select), "NVIDIA_GLX" ];
- }
- }
- if (!$allowNVIDIA_rpms) {
- $allowNVIDIA_rpms = system("modprobe NVdriver 2>/dev/null") == 0 && []; #- empty list but true.
- }
- $allowNVIDIA_rpms;
-}
-
-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('', _("Please log out and then use Ctrl-Alt-BackSpace"));
- return;
- }
-
- $in->ask_okcancel('', _("Please relog into %s to activate the changes", ucfirst (lc $wm)), 1) or return;
-
- fork and return;
- any::ask_window_manager_to_logout($wm);
-
- open STDIN, "</dev/zero";
- open STDOUT, ">/dev/null";
- open STDERR, ">&STDERR";
- c::setsid();
- exec qw(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 98a2e3dd0..000000000
--- a/perl-install/standalone/adduserdrake
+++ /dev/null
@@ -1,43 +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;
-
-local $_ = join '', @ARGV;
-
-/-h/ and die "usage: adduserdrake [--beginner] [--expert] [<users...>]\n";
-
-$::beginner = /-beginner/;
-$::expert = /-expert/;
-
-my @etc_pass_fields = qw(name pw uid gid realname home shell);
-my @shells = grep { -x $_ } map { "/bin/$_" } qw(bash tcsh zsh ash ksh);
-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', 'user');
- 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->do_pkgs->install("autologin") if $o->{autologin};
-#any::set_autologin('', $o->{autologin}, $o->{desktop});
-
-$in->exit(0) if $in;
diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake
deleted file mode 100755
index 8f42d9664..000000000
--- a/perl-install/standalone/diskdrake
+++ /dev/null
@@ -1,106 +0,0 @@
-#!/usr/bin/perl
-
-# DiskDrake
-# Copyright (C) 1999 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 diskdrake::interactive;
-use interactive;
-use detect_devices;
-use fsedit;
-use fs;
-use log;
-use c;
-
-
-my %options;
-my @l = @ARGV;
-while (my $e = shift @l) {
- my ($option) = $e =~ /--?(.*)/ or next;
- if ($option =~ /(.*?)=(.*)/) {
- $options{$1} = $2;
- } else {
- $options{$option} = '';
- }
-}
-$::expert = defined(delete $options{expert});
-$::testing = defined(delete $options{testing});
-
-my @types = qw(hd nfs smb dav removable fileshare);
-my ($type, $para) = ('hd', '');
-foreach (@types) {
- if (exists $options{$_}) {
- $para = delete $options{$_};
- $type = $_;
- last;
- }
-}
-%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') {
- any::fileshare_config($in);
- $in->exit(0);
-}
-
-my $all_hds = fsedit::get_hds({}, $in);
-
-$SIG{__DIE__} = sub { my $m = chomp_($_[0]); log::l("ERROR: $m") };
-
-fs::get_raw_hds('', $all_hds);
-
-fs::merge_info_from_fstab([ fsedit::get_really_all_fstab($all_hds) ]);
-fs::merge_info_from_mtab([ fsedit::get_really_all_fstab($all_hds) ]);
-
-$all_hds->{current_fstab} = fs::fstab_to_string($all_hds);
-
-if ($type eq 'hd') {
- diskdrake::interactive::main($in, $all_hds);
-} 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);
- diskdrake::removable::main($in, $all_hds, $raw_hd);
-} elsif ($type eq 'dav') {
- ($::isEmbedded, my $isEmbedded) = (0, $::isEmbedded);
- require diskdrake::dav;
- diskdrake::dav::main($in, $all_hds);
- $::isEmbedded = $isEmbedded;
-} 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 9b868e5d5..000000000
--- a/perl-install/standalone/drakTermServ
+++ /dev/null
@@ -1,1304 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2002 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.
-#
-# first pass at an interactive tool to help setup/maintain the Mandrake
-# Terminal Server implementation
-#
-# Requires: etherboot, mkinitrd-net, terminal-server, dhcpd-server
-# clusternfs, tftpserver
-#
-# Tasks:
-# 1) creation/management of boot images (kernel+initrd, etherboot enabled)
-# mkinitrd-net is the command line interface for this
-# 2) create/modify /etc/dhcpd.conf for diskless clients
-# 3) create/modify /etc/exports for clusternfs export of "/"
-# 4) add/remove entries in /etc/shadow$$CLIENTS$$ to allow user access
-# 5) per client XF86Config-4, using /etc/XF86Config-4$$IP-ADDRESS$$
-# 6) other per client customizations (modules.conf, keyboard, mouse)
-# 7) enable/modify /etc/xinetd.d/tftp for etherboot
-# 8) create etherboot floppies for client machines
-#
-# Thanks to the fine work of the folks involved in ltsp.org, and
-# Michael Brown <mbrown@fensystems.co.uk>
-#
-
-use Gtk;
-use lib qw(/usr/lib/libDrakX );
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use my_gtk qw(:helpers :wrappers);
-use common;
-use run_program;
-
-use strict;
-use Config;
-use POSIX;
-
-my $in = 'interactive'->vnew('su');
-
-my @buff; #- used o display status info
-
-my $central_widget;
-my $window1;
-my $windows;
-my $status_box;
-my $main_box;
-
-my $nfs_subnet;
-my $nfs_mask;
-
-my $in = 'interactive'->vnew;
-
-if ("@ARGV" =~ /--help|-h/) {
- print q(Mandrake Terminal Server Configurator
---enable : enable MTS
---disable : disable MTS
---start : start MTS
---stop : stop MTS
---adduser : add an existing system user to MTS (requires username)
---deluser : delete an existing system user from MTS (requires username)
---addclient : add a client machine to MTS (requires MAC address, IP, nbi image name)
---delclient : delete a client machine from MTS (requires MAC address, IP, nbi image name)
-);
- exit(0);
-}
-
-#- make sure terminal server and friends are installed
-my $ts = system("rpm -qa | grep 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 -qa | grep terminal-server > /dev/null");
- if ($ts eq 256) {
- warn("Useless without Terminal Server");
- exit(1);
- }
-}
-
-if ("@ARGV" =~ /--enable/) {
- my $cmd_line = 1;
- enable_ts($cmd_line);
- exit(0);
-}
-
-if ("@ARGV" =~ /--disable/) {
- my $cmd_line = 1;
- disable_ts($cmd_line);
- exit(0);
-}
-
-if ("@ARGV" =~ /--start/) {
- my $cmd_line = 1;
- start_ts($cmd_line);
- exit(0);
-}
-
-if ("@ARGV" =~ /--stop/) {
- my $cmd_line = 1;
- stop_ts($cmd_line);
- exit(0);
-}
-
-if ("@ARGV" =~ /--adduser/) {
- die "$0 $ARGV[0] requires a username...\n" if $#ARGV<1;
- my $cmd_line = 1;
- adduser($cmd_line, $ARGV[1]);
- exit(0);
-}
-
-if ("@ARGV" =~ /--deluser/) {
- die "$0 $ARGV[0] requires a username...\n" if $#ARGV<1;
- my $cmd_line = 1;
- deluser($cmd_line, $ARGV[1]);
- exit(0);
-}
-
-if ("@ARGV" =~ /--addclient/) {
- die "$0 $ARGV[0] requires hostname, MAC address, IP, nbi-image...\n" if $#ARGV<4;
- my $cmd_line = 1;
- addclient($cmd_line, $ARGV[1], $ARGV[2], $ARGV[3], $ARGV[4]);
- exit(0);
-}
-
-if ("@ARGV" =~ /--delclient/) {
- die "$0 $ARGV[0] requires hostname...\n" if $#ARGV<1;
- my $cmd_line = 1;
- delclient($cmd_line, $ARGV[1], $ARGV[2], $ARGV[3]);
- exit(0);
-}
-
-interactive_mode() if $#ARGV<1;
-
-sub cursor_wait {
- # turn the cursor to a watch
- $window1->window->set_cursor( new Gtk::Gdk::Cursor( 150 ) );
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-sub cursor_norm {
- # restore normal cursor
- $window1->window->set_cursor( new Gtk::Gdk::Cursor( 68 ) );
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-sub display_error {
- my ($message) = @_;
- my $label;
- my $error_box;
- ${$central_widget}->destroy();
- gtkpack($status_box,
- $error_box = gtkpack_(new Gtk::VBox(0,0),
- 1, new Gtk::Label($message),
- 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread),
- gtksignal_connect(new Gtk::Button(_("OK")), clicked =>
- sub { ${$central_widget}->destroy(); create_fontsel() }),
- ),
- )
- );
- $central_widget = \$error_box;
-}
-
-sub interactive_mode {
- my $font_sel;
-# $interactive = 1;
- init Gtk;
- $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel;
- $window1->signal_connect (delete_event => sub { Gtk->exit(0) });
- $window1->set_position(1);
- $window1->set_title(_("Mandrake Terminal Server Configuration"));
- $window1->set_border_width(5);
- my ($pix_user_map, $pix_user_mask) = gtkcreate_png("ic82-network-40");
- my ($pix_u_map, $pix_u_mask) = gtkcreate_png("drakTS.620x57");
-
- gtkadd($window1,
- gtkpack_(new Gtk::VBox(0,2),
- if_(!$::isEmbedded, 0, new Gtk::Pixmap($pix_u_map, $pix_u_mask)),
- 1, gtkpack_(new Gtk::HBox(0,2),
- 1, gtkpack_(new Gtk::VBox(0,2),
- 1, gtkpack ($status_box = new Gtk::VBox(0,5),
- $main_box = new Gtk::VBox(0,10),
- ),
- 1, gtkpack_(new Gtk::HBox(0,2),
- 0, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end),
- gtksignal_connect(new Gtk::Button(_("Enable Server")), clicked =>
- sub { ${$central_widget}->destroy();
- $windows = 1;
- cursor_wait();
- enable_ts();
- cursor_norm();
- }),
- gtksignal_connect(new Gtk::Button(_("Disable Server")), clicked =>
- sub { ${$central_widget}->destroy();
- cursor_wait();
- disable_ts();
- cursor_norm();
- }),
- ),
- 0, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end),
- gtksignal_connect(new Gtk::Button(_("Start Server")), clicked =>
- sub { ${$central_widget}->destroy();
- $windows = 0;
- cursor_wait();
- start_ts();
- cursor_norm();
- }),
- gtksignal_connect(new Gtk::Button(_("Stop Server")), clicked =>
- sub { ${$central_widget}->destroy();
- cursor_wait();
- stop_ts();
- cursor_norm();
- }),
- ),
- 0, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end),
- gtksignal_connect(new Gtk::Button(_("Etherboot Floppy/ISO")), clicked =>
- sub { ${$central_widget}->destroy(); $windows = 1; make_boot();}),
- gtksignal_connect(new Gtk::Button(_("Net Boot Images")), clicked =>
- sub { ${$central_widget}->destroy(); make_nbi() }),
- ),
- 0, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end),
- gtksignal_connect(new Gtk::Button(_("Add/Del Users")), clicked =>
- sub { ${$central_widget}->destroy(); $windows = 0; maintain_users();}),
- gtksignal_connect(new Gtk::Button(_("Add/Del Clients")), clicked =>
- sub { ${$central_widget}->destroy(); maintain_clients()}),
- ),
- 1, new Gtk::HBox(0,2),
- 0, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end),
- gtksignal_connect(new Gtk::Button(_("Help")),clicked =>
- sub { ${$central_widget}->destroy(); help() }),
- gtksignal_connect(new Gtk::Button(_("Close")), clicked => sub {
- $::isEmbedded and kill 'USR1', $::CCPID;
- Gtk->main_quit() }),
- ),
- ),
- ),
- ),
- ),
- );
- $central_widget = \$main_box;
- $window1->show_all;
- $window1->realize;
- $window1->show_all();
-
- Gtk->main_iteration while Gtk->events_pending;
- $::isEmbedded and kill 'USR2', $::CCPID;
- Gtk->main;
- Gtk->exit(0);
-}
-
-sub about {
- my $text = new Gtk::Text(undef, undef);
- my $about_box;
- gtkpack($status_box,
- $about_box = gtkpack_(new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::HBox(0,0),
- 1, gtktext_insert(gtkset_editable($text, 1), "
- Copyright (C) 2002 by MandrakeSoft
- Stew Benedict 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.
-
- Thanks:
- - LTSP Project http://www.ltsp.org
- - Michael Brown <mbrown\@fensystems.co.uk>
-
-"),
- 0, new Gtk::VScrollbar($text->vadj),
- ),
- 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread),
- gtksignal_connect(new Gtk::Button(_("OK")), clicked =>
- sub { ${$central_widget}->destroy(); create_fontsel() }),
- ),
- )
- );
- $central_widget = \$about_box;
- $status_box->show_all();
-}
-
-sub help {
- my $text = new Gtk::Text(undef, undef);
- my $help_box;
- gtkpack($status_box,
- $help_box = gtkpack_(new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::HBox(0,0),
- 1, gtktext_insert(gtkset_editable($text, 1), "drakTermServ Overview
-
- - Create Etherboot Enabled Boot Images:
- To boot a kernel via etherboot, a special kernel/initrdrd image must be created.
- mkinitrd-net does much of this work and drakTermServ is just a graphical interface
- to help manage/customize these images.
-
- - 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.
-
- A typical dhcpd.conf stanza to support a diskless client looks like:
-
- host curly {
- hardware ethernet 00:20:af:2f:f7:9d;
- fixed-address 192.168.192.3;
- filename \"i386/boot/boot-3c509.2.4.18-6mdk.nbi\";
- }
-
- 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: You must stop/start the server after adding or changing clients/
-
- - 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.
-
- - Maintain /etc/shadow\$\$CLIENT\$\$:
- For users to be able to log into the system from a diskless client, their entry in
- /etc/shadow needs to be duplicated in /etc/shadow\$\$CLIENTS\$\$. drakTermServ helps
- in this respect by adding or removing system users from this file.
-
- - Per client /etc/X11XF86Config-4\$\$IP-ADDRESS\$\$:
- Through clusternfs, each diskless client can have it's own unique configuration files
- on the root filesystem of the server. In the future drakTermServ will help create these
- files.
-
- - Per client system configuration files:
- Through clusternfs, each diskless client cand have it's own unique configuration files
- on the root filesystem of the server. In the future, drakTermServ can help create files
- such as /etc/modules.conf, /etc/sysconfig/mouse, /etc/sysconfig/keyboard on a per-client
- basis.
-
- - /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 it's images.
-
- - Create etherboot floppies/CDs:
- The diskless client machines need either ROM images on the NIC, or a boot floppy
- or CD to initate 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/boot1a.bin /\
- /usr/lib/etherboot/lzrom/3c509.lzrom > /dev/fd0
-
-
-"),
- 0, new Gtk::VScrollbar($text->vadj),
- ),
- 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread),
- gtksignal_connect(new Gtk::Button(_("OK")), clicked =>
- sub { ${$central_widget}->destroy(); }),
- ),
- )
- );
- $central_widget = \$help_box;
- $status_box->show_all();
-}
-
-sub make_boot {
- #- make a boot image on floppy or iso from etherboot images
- my $boot_box;
- my $rom_path = "/usr/lib/etherboot";
- my @nics = all("/usr/lib/etherboot/lzrom");
- my $list_nics = new Gtk::List();
- my $nic;
-
- foreach (@nics) {
- my $t = $_;
- $list_nics->add(gtkshow(gtksignal_connect(new Gtk::ListItem($t),
- select => sub { $nic = $t; })));
- }
- $list_nics->set_selection_mode('single');
-
- gtkpack($status_box,
- $boot_box = gtkpack_(new Gtk::VBox(0,10),
- 0, gtkadd(new Gtk::HBox(0,10),
- new Gtk::HBox(0,5),
- createScrolledWindow($list_nics),
- gtkadd(new Gtk::VBox(1,10),
- new Gtk::HBox(0,20),
- gtksignal_connect(new Gtk::Button(_("Boot Floppy")), clicked =>
- sub {write_eb_image($nic, $rom_path, "floppy"); }),
- gtksignal_connect(new Gtk::Button(_("Boot ISO")), clicked =>
- sub {write_eb_image($nic, $rom_path, "iso"); }),
- new Gtk::HBox(0,20),
- ),
- new Gtk::HBox(0,5),
- ),
- ),
- );
-
- $central_widget = \$boot_box;
- $boot_box->show_all();
-}
-
-sub make_nbi {
- my $nbi_box;
- my @kernels = grep(/vmlinuz/, all("/boot"));
- 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", "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 $tree_kernels = new Gtk::Tree();
-
- foreach (@kernels){
- my $t = $_;
- my $t_kernel= new_with_label Gtk::TreeItem($t);
- gtksignal_connect($t_kernel, select => sub { $kernel = $t;
- $nic = ''; });
- $tree_kernels->append($t_kernel);
-
- my $k_detail = new Gtk::Tree();
- $t_kernel->set_subtree($k_detail);
-
- foreach (@nics) {
- my $m = $_;
- my $k_det_nic = new_with_label Gtk::TreeItem($m);
- gtksignal_connect($k_det_nic, select => sub { $nic = $m;
- $kernel = $t; });
- $k_detail->append($k_det_nic);
- $k_det_nic->show();
- }
- }
-
- # existing nbi images in list
- my $list_nbis = new Gtk::List();
- my @nbis = grep(/\.nbi/, all("/var/lib/tftpboot"));
- my $nbi;
-
- foreach (@nbis) {
- my $t = $_;
- $list_nbis->add(gtkshow(gtksignal_connect(new Gtk::ListItem($t),
- select => sub { $nbi = $t; })));
- }
- $list_nbis->set_selection_mode('single');
-
- gtkpack($status_box,
- $nbi_box = gtkpack_(new Gtk::VBox(1,10),
- 0, gtkadd(new Gtk::HBox(0,10),
- createScrolledWindow($tree_kernels),
- gtkadd(new Gtk::VBox(1,10),
- gtksignal_connect(new Gtk::Button(_("Build Whole Kernel -->")), clicked =>
- sub { if ($kernel) {
- $in->ask_warn('',_("This will take a few minutes."));
- cursor_wait();
- system("/usr/bin/mknbi-set -k /boot/$kernel");
- $list_nbis->clear_items();
- @nbis = grep(/\.nbi/, all("/var/lib/tftpboot"));
- foreach (@nbis) {
- my $t = $_;
- $list_nbis->add(gtkshow(gtksignal_connect(new Gtk::ListItem($t),
- select => sub { $nbi = $t; })));
- }
- cursor_norm();
- } else {
- $in->ask_warn('',_("No kernel selected!")) if !($kernel);
- }
- }),
- gtksignal_connect(new Gtk::Button(_("Build Single NIC -->")), clicked =>
- sub { if ($nic) {
- system("/usr/bin/mknbi-set -k /boot/$kernel -r $nic");
- $list_nbis->clear_items();
- @nbis = grep(/\.nbi/, all("/var/lib/tftpboot"));
- foreach (@nbis) {
- my $t = $_;
- $list_nbis->add(gtkshow(gtksignal_connect(new Gtk::ListItem($t),
- select => sub { $nbi = $t; })));
- }
- } else {
- $in->ask_warn('',_("No nic selected!"));
- }
- }),
- gtksignal_connect(new Gtk::Button(_("Build All Kernels -->")), clicked =>
- sub { $in->ask_warn('',_("This will take a few minutes."));
- cursor_wait();
- system("/usr/bin/mknbi-set");
- $list_nbis->clear_items();
- @nbis = grep(/\.nbi/, all("/var/lib/tftpboot"));
- foreach (@nbis) {
- my $t = $_;
- $list_nbis->add(gtkshow(gtksignal_connect(new Gtk::ListItem($t),
- select => sub { $nbi = $t; })));
- }
- cursor_norm();
- }),
- new Gtk::HBox(1,1),
- gtksignal_connect(new Gtk::Button(_("<-- Delete")), clicked =>
- sub { my $nbi = "/var/lib/tftpboot/" . $nbi;
- my $result = unlink("$nbi") || warn("Can't delete $nbi...");
- if ($result eq 1) {
- $list_nbis->remove_items($list_nbis->selection);
- }
- }),
- gtksignal_connect(new Gtk::Button(_("Delete All NBIs")), clicked =>
- sub { cursor_wait();
- foreach (grep(/\.nbi/, all("/var/lib/tftpboot"))) {
- my $nbi = "/var/lib/tftpboot/" . $_;
- my $result = unlink("$nbi") || warn("Can't delete $nbi...");
- #- wanted to walk through these and delete
- #- but can't figure out how to get the item from
- #- the label :(
- }
- $list_nbis->clear_items();
- cursor_norm();
- }),
- new Gtk::HBox(1,1),
- ),
- createScrolledWindow($list_nbis),
- ),),
- );
-
- $central_widget = \$nbi_box;
- $nbi_box->show_all();
-}
-
-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\$\$");
-
- #- use /homes to filter system daemons
- my @homes = all("/home");
-
- my $list_sys_users = new Gtk::List();
- my $sys_user;
-
- foreach (@sys_users) {
- my ($s_label, $dummy) = split(/:/, $_, 2);
- if (grep(/$s_label/, @homes)) {
- $list_sys_users->add(gtkshow(gtksignal_connect(new Gtk::ListItem($s_label),
- select => sub { $sys_user = $s_label; })));
- }
- }
- $list_sys_users->set_selection_mode('single');
-
- my $list_ts_users = new Gtk::List();
- my $ts_user;
-
- foreach (@ts_users) {
- my ($t_label, $dummy) = split(/:/, $_, 2);
- my @system_entry = grep(/$t_label/, @sys_users);
- $t_label = $t_label . " !!!" if ($_ ne $system_entry[0]);
- $list_ts_users->add(gtkshow(gtksignal_connect(new Gtk::ListItem($t_label),
- select => sub { $ts_user = $t_label; })));
- }
- $list_ts_users->set_selection_mode('single');
-
- gtkpack($status_box,
- $user_box = gtkpack_(new Gtk::VBox(0,10),
- 0, gtkadd(new Gtk::Label( "!!! 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(new Gtk::HBox(0,20),
- createScrolledWindow($list_sys_users),
- gtkadd(new Gtk::VBox(1,10),
- new Gtk::HBox(0,10),
- gtksignal_connect(new Gtk::Button(_("Add User -->")), clicked =>
- sub { my $result = adduser(0, $sys_user);
- if ($result eq 0) {
- $list_ts_users->add(gtkshow(gtksignal_connect(new Gtk::ListItem($sys_user),
- select => sub { $ts_user = $sys_user;
- $list_ts_users->show(); })));
- }
- }),
- gtksignal_connect(new Gtk::Button(_("<-- Del User")), clicked =>
- sub { deluser(0, $ts_user);
- $list_ts_users->remove_items($list_ts_users->selection);
- }),
- new Gtk::HBox(0,10),
- ),
- createScrolledWindow($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;
-
- #- client info in tree view
- my $tree_clients = new Gtk::Tree();
- foreach my $key(keys(%clients)){
- my $t = $key;
- my $t_client= new_with_label Gtk::TreeItem($t);
- gtksignal_connect($t_client, select => sub { $client = $t; });
- $tree_clients->append($t_client);
-
- my $c_detail = new Gtk::Tree();
- $t_client->set_subtree($c_detail);
-
- my $c_det_hw = new_with_label Gtk::TreeItem($clients{$key}->{hardware});
- $c_detail->append($c_det_hw);
- $c_det_hw->show();
-
- my $c_det_ip = new_with_label Gtk::TreeItem($clients{$key}->{address});
- $c_detail->append($c_det_ip);
- $c_det_ip->show();
-
- my $c_det_nbi = new_with_label Gtk::TreeItem($clients{$key}->{filename});
- $c_detail->append($c_det_nbi);
- $c_det_nbi->show();
- }
- $tree_clients->set_selection_mode('single');
-
- #- entry boxes for client data entry
- my $label_host = new Gtk::Label("Client Name:");
- $label_host->set_justify('left');
- my $entry_host = new Gtk::Entry(20);
- my $label_mac = new Gtk::Label("MAC Address:");
- $label_mac->set_justify('left');
- my $entry_mac = new Gtk::Entry(20);
- my $label_ip = new Gtk::Label("IP Address:");
- $label_ip->set_justify('left');
- my $entry_ip = new Gtk::Entry(20);
- my $label_nbi = new Gtk::Label("Kernel Netboot Image:");
- $label_nbi->set_justify('left');
- my $entry_nbi = new Gtk::Combo();
-
- my @images = grep(/\.nbi/, all("/var/lib/tftpboot/"));
- $entry_nbi->set_popdown_strings(@images);
- $entry_nbi->set_value_in_list(1, 0);
-
- gtkpack($status_box,
- my $client_box = gtkpack_(new Gtk::VBox(1,10),
- 0, gtkadd(new Gtk::HBox(0,10),
- gtkadd(new Gtk::VBox(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(new Gtk::VBox(1,10),
- new Gtk::HBox(1,1),
- gtksignal_connect(new Gtk::Button(_("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 ne '' && $mac ne '' && $ip ne '' && $nbi ne '') {
-
- my $result = addclient(0, $hostname, $mac, $ip, $nbi);
-
- if ( $result eq 0 ) {
- my $t_client= new_with_label Gtk::TreeItem($hostname);
- gtksignal_connect($t_client, select => sub { $client = $hostname; });
- $tree_clients->append($t_client);
-
- my $c_detail = new Gtk::Tree();
- $t_client->set_subtree($c_detail);
-
- my $c_det_hw = new_with_label Gtk::TreeItem($mac);
- $c_detail->append($c_det_hw);
- $c_det_hw->show();
-
- my $c_det_ip = new_with_label Gtk::TreeItem($ip);
- $c_detail->append($c_det_ip);
- $c_det_ip->show();
-
- my $c_det_nbi = new_with_label Gtk::TreeItem($nbi);
- $c_detail->append($c_det_nbi);
- $c_det_nbi->show();
- $t_client->show();
- }
- }
- }),
- gtksignal_connect(new Gtk::Button(_("<-- Del Client")), clicked =>
- sub { my $result = delclient(0, $client);
- if ( $result eq 0 ) {
- $tree_clients->remove_items($tree_clients->selection);
- }
- }),
- gtksignal_connect(new Gtk::Button(_("dhcpd Config...")), clicked =>
- sub { ${$central_widget}->destroy(); dhcpd_config(); }),
- new Gtk::HBox(1,1),
- ),
- createScrolledWindow($tree_clients),
- ),),
- );
-
- $central_widget = \$client_box;
- $client_box->show_all();
-}
-
-sub dhcpd_config {
- #- do main dhcp server config
- my $dhcpd_box;
- my @netmask = ();
- my @broadcast = ();
- my @netconfig = ();
- my @ifconfig = ();
- my @ifvalues = ();
- my @resolve = ();
- my @nserve = ();
- my %netconfig;
- my @subnet = ();
- my @nservers = ();
-
- #- entry boxes for data entry
- my $box_subnet = new Gtk::HBox(0,0);
- my $label_subnet = new Gtk::Label("Subnet:");
- $label_subnet->set_justify('right');
- my $entry_subnet = new Gtk::Entry(20);
- $box_subnet->pack_end($entry_subnet, 0, 0, 10);
- $box_subnet->pack_end($label_subnet, 0, 0, 10);
-
- my $box_netmask = new Gtk::HBox(0,0);
- my $label_netmask = new Gtk::Label("Netmask:");
- $label_netmask->set_justify('left');
- my $entry_netmask = new Gtk::Entry(20);
- $box_netmask->pack_end($entry_netmask, 0, 0, 10);
- $box_netmask->pack_end($label_netmask, 0, 0, 10);
-
- my $box_routers = new Gtk::HBox(0,0);
- my $label_routers = new Gtk::Label("Routers:");
- $label_routers->set_justify('left');
- my $entry_routers = new Gtk::Entry(20);
- $box_routers->pack_end($entry_routers, 0, 0, 10);
- $box_routers->pack_end($label_routers, 0, 0, 10);
-
- my $box_subnet_mask = new Gtk::HBox(0,0);
- my $label_subnet_mask = new Gtk::Label("Subnet Mask:");
- $label_subnet_mask->set_justify('left');
- my $entry_subnet_mask = new Gtk::Entry();
- $box_subnet_mask->pack_end($entry_subnet_mask, 0, 0, 10);
- $box_subnet_mask->pack_end($label_subnet_mask, 0, 0, 10);
-
- my $box_broadcast = new Gtk::HBox(0,0);
- my $label_broadcast = new Gtk::Label("Broadcast Address:");
- $label_broadcast->set_justify('left');
- my $entry_broadcast = new Gtk::Entry(20);
- $box_broadcast->pack_end($entry_broadcast, 0, 0, 10);
- $box_broadcast->pack_end($label_broadcast, 0, 0, 10);
-
- my $box_domain = new Gtk::HBox(0,0);
- my $label_domain = new Gtk::Label("Domain Name:");
- $label_domain->set_justify('left');
- my $entry_domain = new Gtk::Entry(20);
- $box_domain->pack_end($entry_domain, 0, 0, 10);
- $box_domain->pack_end($label_domain, 0, 0, 10);
-
- my $box_name_servers = new Gtk::HBox(0,0);
- my $box_name_servers_entry = new Gtk::VBox(0,0);
- my $label_name_servers = new Gtk::Label("Name Servers:");
- $label_name_servers->set_justify('left');
- my $entry_name_server1 = new Gtk::Entry();
- my $entry_name_server2 = new Gtk::Entry();
- my $entry_name_server3 = new Gtk::Entry();
- $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, 10);
- $box_name_servers->pack_end($label_name_servers, 0, 0, 10);
-
- #- grab some default entries from the running system
-
- if ( -e "/etc/sysconfig/network") {
- %netconfig = getVarsFromSh("/etc/sysconfig/network");
- $entry_domain->set_text($netconfig{DOMAINNAME});
- }
-
- if ( -e "/etc/sysconfig/network-scripts/ifcfg-eth0") {
- %netconfig = getVarsFromSh("/etc/sysconfig/network-scripts/ifcfg-eth0");
- $entry_netmask->set_text($netconfig{NETMASK});
- $entry_subnet_mask->set_text($netconfig{NETMASK});
-
- }
-
- @ifconfig = grep(/inet/, `/sbin/ifconfig eth0`);
- @ifvalues = split(/[: \t]+/, $ifconfig[0]);
- $entry_broadcast->set_text($ifvalues[5]);
-
- @broadcast = split(/\./, $ifvalues[5]);
- @netmask = split(/\./, $netconfig{NETMASK});
-
- foreach (0..3) {
- #- wasn't evaluating the & as expected
- my $val1= $broadcast[$_] + 0;
- my $val2 = $netmask[$_] + 0;
- $subnet[$_] = $val1 & $val2;
- }
-
- $entry_subnet->set_text(join(".", @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 lt 4)){
- $nservers[$i] = $ifvalues[1]; $i++;
- }
- }
-
- $entry_name_server1->set_text($nservers[1]);
- $entry_name_server2->set_text($nservers[2]);
- $entry_name_server3->set_text($nservers[3]);
-
- gtkpack($status_box,
- $dhcpd_box = gtkpack_(new Gtk::HBox(1,10),
- 0, gtkadd((new Gtk::VBox),
- 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(new Gtk::VBox(0,0),
- new Gtk::Label("dhcpd Server Configuration\n\n
- Most of these values were extracted
- from your running system. You can
- modify as needed."),
- gtksignal_connect(new Gtk::Button(_("Write Config")), clicked =>
- sub { write_dhcpd_config(
- $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()
- );}),
- new Gtk::HBox(0,10),
- ),
- ),
- );
-
- $central_widget = \$dhcpd_box;
- $dhcpd_box->show_all();
-}
-
-sub write_dhcpd_config {
- my( $subnet, $netmask, $routers, $subnet_mask, $broadcast, $domain, $ns1, $ns2, $ns3) = @_;
-
- $nfs_subnet = $subnet;
- $nfs_mask = $subnet_mask;
-
- open(FHANDLE, "> /etc/dhcpd.conf");
- print FHANDLE "#dhcpd.conf - generated by drakTermServ\n\n";
- print FHANDLE "ddns-update-style none;\n\n";
- print FHANDLE "# Long leases (48 hours)\ndefault-lease-time 172800;\nmax-lease-time 172800;\n\n";
- print FHANDLE "# Include Etherboot definitions and defaults\ninclude \"/etc/dhcpd.conf.etherboot.include\";\n\n";
- print FHANDLE "# Network-specific section\n\n";
-
- print FHANDLE "subnet $subnet netmask $netmask {\n";
- print FHANDLE "\toption routers $routers;\n" if $routers;
- print FHANDLE "\toption subnet-mask $subnet_mask;\n" if $subnet_mask;
- print FHANDLE "\toption broadcast-address $broadcast;\n" if $broadcast;
- print FHANDLE "\toption domain-name \"$domain\";\n" if $domain;
-
- 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;
- print FHANDLE $ns_string if $ns_string;
-
- print FHANDLE "}\n\n";
-
- print FHANDLE "# Include client machine configurations\ninclude \"/etc/dhcpd.conf.etherboot.clients\";\n";
- close FHANDLE
-}
-
-sub write_eb_image {
- #- write a bootable etherboot CD image or floppy
- my ($nic, $rom_path, $type) = @_;
- if ($type eq 'floppy') {
- my $in = interactive->vnew;
- if ( -e "/dev/fd0" ) {
- my $result = $in->ask_okcancel(_("Please insert floppy disk:"));
- return if !($result);
- $result = system("cat $rom_path/boot1a.bin $rom_path/lzrom/$nic > /dev/fd0") if $result;
- if ($result) {
- $in->ask_warn('',_("Couldn't access the floppy!"))
- } else {
- $in->ask_warn('',_("Floppy can be removed now"))
- }
- } else {
- $in->ask_warn('',_("No floppy drive available!"));
- }
- } else {
- mkdir_p("/tmp/eb");
- system("cat $rom_path/boot1a.bin $rom_path/lzrom/$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/eb.iso" ) {
- $in->ask_warn('',_("Etherboot ISO image is %s", "/tmp/$nic.iso"))
- } else {
- $in->ask_warn('',_("Something went wrong! - Is mkisofs installed?"))
- }
- }
-}
-
-sub enable_ts {
- #- setup default config files for terminal server
-
- my $cmd_line = @_;
-
- @buff = ();
- $buff[0] = "Enabling Terminal Server...\n\n";
- $buff[1] = "\tChecking default /etc/dhcpd.conf...\n";
- my @my_conf = cat_("/etc/dhcpd.conf");
- if ($my_conf[0] !~ /drakTermServ/) {
- if ($cmd_line eq 1) {
- print("No /etc/dhcpd.conf built yet - use GUI to create!!\n");
- return;
- } else {
- $in->ask_warn('',_("Need to create /etc/dhcpd.conf first!"));
- #$central_widget->destroy;
- dhcpd_config();
- return;
- }
- }
- my $buff_index = toggle_chkconfig("on", "dhcpd", 2);
- $buff[$buff_index] = "\tSetting up default /etc/exports...\n";
- cp_af("/etc/exports", "/etc/exports.mdkTS");
- open(FHANDLE, "> /etc/exports");
- print FHANDLE "#/etc/exports - generated by drakTermServ\n\n";
- print FHANDLE "/\t(ro,all_squash)\n";
- print FHANDLE "/home\t$nfs_subnet/$nfs_mask(rw,root_squash)\n";
- close FHANDLE;
- $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
- my $cmd_line = @_;
-
- @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");
- my $buff_index = toggle_chkconfig("off", "dhcpd", 2);
- $buff[$buff_index] = "\tRestoring default /etc/exports...\n";
- cp_af("/etc/exports.mdkTS", "/etc/exports");
- $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("/sbin/service $service $command > /tmp/drakTSservice.status 2>&1");
- open(STATUS, "/tmp/drakTSservice.status");
- while(<STATUS>) {
- my ($phrase, $result) = split(':',$_);
- $result = "[ OK ]" if ($result =~ /OK/);
- $result = "[ FAIL ]" if ($result =~ /FAIL/);
- $buff[$buff_index] = "\t$phrase:\t\t\t" . $result . "\n";
- $buff_index++;
- }
- close STATUS;
- unlink "/tmp/drakTSservice.status" or warn("Can't delete /tmp/drakTSservice.status\n");
- $buff_index;
-}
-
-sub start_ts {
- #- start the terminal server
- my $cmd_line = @_;
-
- @buff = ();
- $buff[0] = "Starting Terminal Server...\n\n";
- my $buff_index = service_change("dhcpd", "start", 2);
- $buff_index = service_change("clusternfs", "start", $buff_index);
- $buff[$buff_index] = "\n\tDone!";
-
- if ($cmd_line == 1){
- print "@buff\n";
- return;
- }
-
- show_status(@buff);
-}
-
-sub stop_ts {
- #- stop the terminal server
- my $cmd_line = @_;
-
- @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!";
-
- if ($cmd_line == 1){
- print "@buff\n";
- return;
- }
-
- show_status(@buff);
-
-}
-
-sub show_status {
- #- just a generic routine to display an array of text in the GUI screen
- my @buff = @_;
-
- my $text = new Gtk::Text(undef, undef);
- my $status_t_box;
- gtkpack($status_box,
- $status_t_box = gtkpack_(new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::HBox(0,0),
- 1, gtktext_insert(gtkset_editable($text, 1), "@buff"),
- ),
- ),
- );
-
- $central_widget = \$status_t_box;
- $status_box->show_all();
-}
-
-sub adduser {
- my ($cmd_line, $username) = @_;
- my @active_users = cat_("/etc/shadow");
- my @ts_users = cat_("/etc/shadow\$\$CLIENT\$\$");
- my $is_user = grep(/$username/, @active_users);
- my $add_fail = 0;
- my $in_already;
-
- if ($is_user) {
- my @shadow_entry = grep(/$username/, @active_users);
- my $is_ts_user = grep(/$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 "$username passwd bad in Terminal Server - rewriting...\n";
- deluser($cmd_line, $username);
- adduser($cmd_line, $username);
- }
- } else {
- # new ts user
- open(FHANDLE, ">> /etc/shadow\$\$CLIENT\$\$");
- print FHANDLE "$shadow_entry[0]" or $add_fail = 1;
- close FHANDLE;
- $in_already = 0;
- }
- }
-
- if ($cmd_line == 1){
- print "$username is not a user..\n" if !($is_user);
- print "$username is already a Terminal Server user\n" if $in_already;
- if ($add_fail== 1 || $in_already || !$is_user) {
- print "Addition of $username to Terminal Server failed!\n";
- } else {
- print "$username added to Terminal Server\n";
- }
- return;
- } else {
- $in_already;
- }
-}
-
-sub deluser {
- # del a user from the shadow$$CLIENT$$ file
- my ($cmd_line, $username) = @_;
- my $i;
- my $user;
- my $user_deleted;
-
- my @ts_users = cat_("/etc/shadow\$\$CLIENT\$\$");
- my $is_ts_user = grep(/$username/, @ts_users);
-
- if ($is_ts_user) {
- $i = 0;
- foreach $user (@ts_users) {
- if ($user =~ /$username/) {
- splice (@ts_users, $i, 1);
- $user_deleted = 1;
- break;
- }
- $i++;
- }
- open(FHANDLE, "> /etc/shadow\$\$CLIENT\$\$");
- foreach $user (@ts_users) {
- print FHANDLE "$user";
- }
- close FHANDLE;
- }
-
- if ($cmd_line == 1){
- if ($user_deleted) {
- print "Deleted $username...\n";
- } else {
- print "$username not found...\n";
- }
- return;
- }
-}
-
-sub addclient {
- #- add a new client entry after checking for dups
- my ($cmd_line, $hostname, $mac, $ip, $nbi) = @_;
-
- my $host_in_use = 0;
- my $mac_in_use = 0;
- my $ip_in_use = 0;
- my $client;
-
- my %ts_clients = read_dhcpd_conf();
-
- foreach $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 "$hostname already in use\n" if $host_in_use;
- print "$mac already in use\n" if $mac_in_use;
- print "$ip already in use\n" 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;
- $ts_clients{$hostname}->{filename} = $nbi;
-
- my $clients = "/etc/dhcpd.conf.etherboot.clients";
- open(CLIENT, ">> $clients") || warn ("Can't open $clients!");
- print_client_entry("CLIENT", $hostname, %ts_clients);
- close CLIENT;
- 0;
- }
-}
-
-sub delclient {
- #- find a client and delete the entry in dhcpd.conf
- my ($cmd_line, $hostname) = @_;
- my $client;
- my $host_found;
-
- my %ts_clients = read_dhcpd_conf();
-
- foreach $client(keys(%ts_clients)){
- if ($hostname eq $client) {
- $host_found = 1;
- delete $ts_clients{$client};
- write_dhcpd_conf(%ts_clients);
- return 0;
- }
- }
-
- if ($cmd_line == 1){
- print "$hostname not found...\n" if (!$host_found);
- return;
- }
-}
-
-sub print_client_entry {
- #- print a client entry, in proper format
- my ($handle, $client, %ts_clients) = @_;
-
- print $handle "host $client {\n";
- print $handle "\thardware ethernet\t$ts_clients{$client}->{hardware};\n";
- print $handle "\tfixed-address\t\t$ts_clients{$client}->{address};\n";
- print $handle "\tfilename\t\t\"$ts_clients{$client}->{filename}\";\n";
- print $handle "}\n";
-}
-
-sub write_dhcpd_conf {
- my %ts_clients = @_;
- my $clients = "/etc/dhcpd.conf.etherboot.clients";
- my $key;
-
- open(CLIENT, "> $clients") || warn ("Can't open $clients!");
- foreach $key(keys(%ts_clients)){
- print_client_entry("CLIENT", $key, %ts_clients);
- }
- close CLIENT
-}
-
-sub read_dhcpd_conf {
- my $clients = "/etc/dhcpd.conf.etherboot.clients";
- my %ts_clients;
- my $hostname;
-
- #- read and parse current client entries
- open(CLIENTS, $clients) || warn("Can't open $clients\n");
- while(<CLIENTS>) {
- 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/);
- $ts_clients{$hostname}->{$name} = $val;
- }
- }
- }
- close CLIENTS;
- %ts_clients;
-}
diff --git a/perl-install/standalone/drakautoinst b/perl-install/standalone/drakautoinst
deleted file mode 100755
index 66cba5e93..000000000
--- a/perl-install/standalone/drakautoinst
+++ /dev/null
@@ -1,363 +0,0 @@
-#!/usr/bin/perl
-
-#
-# Guillaume Cottenceau (gc@mandrakesoft.com)
-#
-# Copyright 2001 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;
-
-/-h/ and die "usage: drakautoinst [--version]\n";
-/-version/ and die 'version: $Id$ '."\n";
-$::direct = /-direct/;
-$::direct = 1; #DEBUG
-
-my $in = 'interactive'->vnew('su', 'default');
-
-begin:
-$::isEmbedded and kill 'USR2', $::CCPID;
-
-my $imagefile = "/root/drakx/replay_install.img";
--f $imagefile or $in->ask_okcancel(_("Error!"),
- _("I can't find needed image file `%s'.", $imagefile), 1), quit_global($in, 0);
-
-$::direct or $in->ask_okcancel(_("Auto Install Configurator"),
-_("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.
-
-Do you want 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 => _($st->{$f}{text}), val => \$def_choice, list => [ _('replay'), _('manual') ] };
- push @all_steps, [ $f, \$def_choice ];
-}
-
-$in->ask_from(_("Automatic Steps Configuration"),
- _("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 _('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);
-$in->ask_okcancel('', _("Insert a blank floppy in drive %s", $floppy), 1) or quit_global($in, 0);
-{
- standalone::explanations(_("Creating auto install floppy"));
- my $w = $in->wait_message('', _("Creating auto install floppy"));
- commands::dd("if=$imagefile", "of=$dev", "bs=1440", "count=1024");
- common::sync();
-}
-fs::mount($dev, $mountdir, 'vfat', 0);
-my $cfgfile = "$mountdir/auto_inst.cfg";
-eval(cat_($cfgfile));
-my $o_old = $o;
-
-if (!$::isEmbedded && $in->isa('interactive::gtk')) {
- require Gtk;
- init Gtk;
- require my_gtk;
- import my_gtk qw(:helpers :wrappers);
-
- my %tree;
- $struct_gui{$_} = 'General' foreach qw(lang isUpgrade autoExitInstall timezone default_packages mkbootdisk);
- $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);
-
- %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 => '',
- );
-
- member($_, keys %struct_gui) and push @{$tree{$struct_gui{$_}}}, [$_ , $pixmap{$_}, h2widget($o->{$_}, "\$o->\{$_\}") ] foreach (keys %$o);
-
- my $W = my_gtk->new(_('$o edition'));
- my @box_to_hide;
- my $nb_pages=0;
- my $notebook = new Gtk::Notebook;
- $notebook->set_show_border(0);
- $notebook->set_show_tabs(0);
- $notebook->append_page(gtkpack_(gtkset_border_width(new Gtk::VBox(0,0), 10),
- 1, new Gtk::VBox(0,0),
- 0, gtkpack_(new Gtk::HBox(0,0),
- 1, new Gtk::VBox(0,0),
- 0, gtkadd(gtkset_shadow_type(new Gtk::Frame, 'etched-in'),
- new Gtk::Pixmap(gtkcreate_png('mdk_logo'))),
- 1, new Gtk::VBox(0,0),
- ),
- 0, _("\nWelcome.\n\nThe parameters of the auto-install are available in the sections on the left"),
- 1, new Gtk::VBox(0,0),
- ), undef);
- $notebook->show_all;
- $notebook->set_page(0);
-
- gtkadd($W->{window},
- gtkpack_(new Gtk::VBox(0,5),
- 1, gtkpack_(new Gtk::HBox(0,0),
- 0, gtkadd(gtkset_usize(gtkset_shadow_type(new Gtk::Frame, 'in'), 130, 470),
- gtkpack_(new Gtk::VBox(0,0),
- map {
- my $box = new Gtk::VBox(0,0);
- push @box_to_hide, $box;
- $box->{vis} = 0;
- my @button_to_hide;
- 0, gtksignal_connect(new Gtk::Button($_), clicked => sub {
- if($box->{vis}) { $box->hide(); $box->{vis} = 0; $notebook->set_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(new Gtk::ToggleButton(), '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_page($local_page) };
- gtksignal_connect($button, toggled => sub {
- $button->get_active() and $function->()
- });
- my $b;
- if ($_->[1] ne "") { $b = new Gtk::Pixmap(gtkcreate_png($_->[1]))} else { $b = ()};
- gtksignal_connect(gtkadd($button,
- gtkpack__(new Gtk::VBox(0,3),
- $b,
- _($_->[0]),
- )
- ), 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, new Gtk::HSeparator,
- 0, gtkadd(gtkset_border_width(gtkset_layout(new Gtk::HButtonBox, 'end'), 5),
- gtksignal_connect(new Gtk::Button(_("Accept")), clicked => sub { Gtk->main_quit; }),
- gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub { $o = $o_old; Gtk->main_quit; quit_global($in, 0) }),
- )
- )
- );
- $_->hide foreach @box_to_hide;
-# $W->{window}->show_all;
-# gtkadd($W->{window},
-# gtkpack_($W->create_box_with_title(_("Edit variables")),
-# 1, my $notebook = create_notebook( map { $_, h2widget($o->{$_}, "\$o->\{$_\}") } keys %$o ),
-# 0, gtkpack(gtkset_border_width(new Gtk::HBox(0,0),5), $W->create_okcancel),
-# ),
-# );
-# $notebook->set_tab_pos('left');
-# $::isEmbedded and Gtk->main_iteration while Gtk->events_pending;
- $::isEmbedded and kill ('USR2', $::CCPID);
- $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(_("Congratulations!"),
-_("The floppy has been successfully generated.
-You may now replay your installation."));
-
-quit_global($in, 0);
-
-
-sub quit_global {
- my ($in, $exitcode) = @_;
- $::isEmbedded ? kill 'USR1', $::CCPID : $in->exit($exitcode);
- goto begin;
-}
-
-
-
-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++;
- my ($button_add, $button_remove);
- $w = gtkpack_(new Gtk::VBox(0,0),
- 1, createScrolledWindow(gtkpack__($vb = new Gtk::VBox(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(_("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_(new Gtk::VBox(0,0),
- 1, createScrolledWindow(
- gtkpack__($vb = new Gtk::VBox(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 {
- $label =~ /\$o->\{(.+)\}/;
- $w = create_packtable({ col_spacings => 10, row_spacings => 3 },
- create_entry_element($k, $label, $1))
- }
- 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 = new Gtk::Entry;
- $e->{value} = $value;
- my $tag = Gtk->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_add, $button_remove);
- 0, gtkadd(gtkset_border_width(gtkset_layout(new Gtk::HButtonBox, 'spread'), 5),
- gtksignal_connect($button_add = new Gtk::Button(_("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 = new Gtk::Button(_("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 e42126615..000000000
--- a/perl-install/standalone/drakbackup
+++ /dev/null
@@ -1,4915 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2001 MandrakeSoft by Sebastien DUPONT <dupont_s@epita.fr>
-# Updated 2002 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.
-#
-#________________________________________________________________
-#
-# Description:
-#
-# Drakbackup is used to backup your system.
-# During the configuration you can select
-# - System files,
-# - Users files,
-# - Other files.
-# or All your system ... and Other (like windows Partitions)
-#
-# Drakbackup allows you to backup your system on:
-# - Harddrive.
-# - NFS.
-# - CDROM (CDRW), DVDROM (with autoboot, rescue and autoinstall.).
-# - FTP.
-# - Rsync.
-# - Webdav.
-# - Tape.
-#
-# Drakbackup allows you to Restore your system on
-# choosen directory.
-#
-# Per default all backup will be stored on your
-# /var/lib/drakbackup directory
-#
-# Configuration file:
-# /etc/drakconf/drakbackup/drakbakup.conf
-#
-#________________________________________________________________
-#
-# Backup files formats:
-#
-# no incremental backup:
-# backup_sys_date_hour.tar.*
-# backup_user_toto_date_hour.tar.*
-# backup_other_date_hour.tar.*
-#
-# first incremental backup: (if backup_base* does not exist )
-#
-# backup_base_sys_date_hour.tar.*
-# backup_base_user_toto_date_hour.tar.*
-# backup_base_other_date_hour.tar.*
-#
-# other incremental backup: (if backup_base* already exist )
-#
-# backup_incr_sys_date_hour.tar.*
-# backup_incr_user_toto_date_hour.tar.*
-# backup_incr_other_date_hour.tar.*
-#
-# all backup runs will generate:
-#
-# drakbackup_date_hour.txt
-#
-# this will contain media & hostname
-#________________________________________________________________
-#
-# REQUIRE: cron if daemon
-# cdrecord & mkisofs
-# perl Net::FTP
-# ssh-askpass
-# sitecopy - for webdav
-# rsync
-# perl Expect
-
-# BUGS:
-#DONE restore->other_media->next->previous => crash ...
-#DONE selection des sources a inclure dans le backup cd.
-#DONE help -> ok after install_rpm
-# sort of fixed - doesn't always land where you would expect
-# but at least it doesn't die
-#
-# TODO:
-# 1 - print ftp problem for user.
-# 2 - calcul disk space.
-# use quota.
-#WHY? - Apple can read Joliet - would you really be restoring on MacOS?
-#Or for bootable - PPC is being depracated anyway ;(
-# 4 - write on cd --> ! change Joliet to HFS for Apple
-# 6 - total backup.( all partitions wanted, windows partitions for example!)
-# dump use for total backup.
-# 7 - custom deamon
-# 10- backend: --resore_all, --restore_sys, --restore_users
-#WHAT IS THIS?
-# --build_cd_autoinst
-# 12- cpio use !!
-# 13- boot floppy disk (with dialog)
-# 14- build autoboot with backup and install cd
-# 15- use .backupignore like on CVS
-# 16- afficher les modif dans un fichier texte du meme nom
-# pour afficher durant le restore.
-# 17- futur: could be possible to restore a specific file
-# or directory at specific date.
-# 18- possible all files each time from directory.
-#
-# DONE TODAY:
-#________________________________________________________________
-
-use Gtk;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use my_gtk qw(:helpers :wrappers);
-use common;
-use strict;
-use Time::localtime;
-use detect_devices;
-use Data::Dumper;
-
-my $in = 'interactive'->vnew('', 'default');
-$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/;
-
-if ("@ARGV" =~ /--help|-h/) {
- print q(Backup and Restore application
-
---default : save default directories.
---debug : show all debug messages.
---show-conf : list of files or directories to backup.
---config-info : explain configuration file options (for non-X users).
---daemon : use daemon configuration.
---help : show this message.
---version : show version name.
-);
- exit(0);
-}
-
-if ("@ARGV" =~ /--version/) {
- print "Drakbackup Version 1.2\n";
- exit(0);
-}
-
-# Backend Options.
-# make this global for status screen
-my $window1;
-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 @all_user_list;
-my $list_other;
-my $DEBUG = 0;
-my $restore_sys = 1;
-my $restore_user = 1;
-my $restore_other = 1;
-my $restore_step_sys_date = "";
-my @user_backuped;
-my @sys_backuped;
-my $sys_backuped = 0;
-my $other_backuped = 0;
-my @user_list_to_restore;
-my @sys_list_to_restore;
-my $cd_device_entry;
-my $custom_help;
-my $button_box;
-my $button_box_tmp;
-my $next_widget;
-my $sav_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 $stext;
-my $the_time;
-my @user_list_to_restore2;
-my @data_backuped;
-my $label_tail;
-my @list_to_build_on_cd;
-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;
-#- ack - not a great default - changed 20020814 (SB)
-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 = ("cd", "hd", "tape");
-my %cd_devices;
-my $cd_drives;
-my $std_device;
-my @tape_devices;
-my $tar_ext = "tar.gz";
-
-# config. FILES -> Default PATH & Global variables.
-my @sys_files = ("/etc");
-my @user_list;
-my @list_other = () ;
-my $cfg_dir = "/etc/drakxtools/drakbackup/";
-my $save_path = "/var/lib/drakbackup";
-my $log_buff;
-my $comp_mode = 0;
-my $backup_sys = 1;
-my $backup_user = 1;
-my $backup_daemon = 1;
-my $backup_sys_versions = 0;
-my $backup_user_versions = 0;
-my $backup_other_versions = 0;
-my $what_no_browser = 1;
-my $cdrw = 0;
-my $dvdr = 0;
-my $dvdram = 0;
-my $net_proto = '';
-my $host_path = '';
-my $login_user = '';
-my $daemon = 0;
-my $backend_only = 0;
-my $daemon_media = '';
-my $hd_quota = 0;
-
-#- 7/4/2002 SB - consolidate net methods
-my $where_use_net = 0;
-
-my $where_net = 0;
-my $where_hd = 1;
-my $del_hd_files = 0;
-my $where_cd = 0;
-my $where_tape = 0;
-my $cd_time = 650;
-my $when_space;
-my $cd_with_install_boot = 0;
-my $cd_device = '';
-my $host_name = '';
-my $backupignore = 0;
-my $remember_pass = 0;
-my $passwd_user = '';
-my $tape_device;
-my $media_erase = 0;
-my $media_eject = 0;
-my $multi_session = 0;
-my $session_offset = '';
-my $tape_norewind = 0;
-my $no_critical_sys = 1;
-my $send_mail = 0;
-my $user_mail;
-my $scp_port = 22;
-my $use_expect = 0;
-my $xfer_keys = 0;
-my $user_keys = 1;
-my $user_home = $ENV{"HOME"};
-my $backup_key = $user_home . "/.ssh/identity-drakbackup";
-my $nonroot_user = 0;
-my $not_warned = 0;
-my $media_problem = 0;
-my $vol_name = 'Drakbackup';
-my $good_restore_path = 1;
-
-# allow not-root user with own config
-if ($ENV{USER} ne 'root') {
- $cfg_dir = "$user_home/.drakbackup/";
- $save_path = $cfg_dir . "backups";
- -d $save_path or mkdir_p $save_path;
- $nonroot_user = 1;
- $not_warned = 1;
- $backup_sys = 0;
- $backup_daemon = 0;
- $daemon = 0;
- @user_list = ("$ENV{USER}");
-}
-my $cfg_file = $cfg_dir . "drakbackup.conf";
-
-foreach (@ARGV) {
-
- /--default/ and backend_mode();
- /--daemon/ and daemon_mode();
- /--show-conf/ and show_conf();
- /--config-info/ and explain_conf();
- /--cd-info/ and get_cd_info(), exit(0);
- /--debug/ and $DEBUG = 1, next;
-}
-
-sub show_conf {
- print "DrakBackup configuration:\n\n";
- read_conf_file();
- system_state();
- print $system_state . "\n";
- exit(0);
-}
-
-sub explain_conf {
- print "\nConfiguration File Options: \n\n";
- print "Configuration file is located in:\n";
- print " Root Mode: /etc/drakxtools/drakbackup/drakbackup.conf.\n";
- print " User Mode: ~/.drakbackup/drakbackup.conf.\n\n";
- print "SYS_FILES= Space seperated list of system directories to backup.\n";
- print "HOME_FILES= Space seperated list of user home directories to backup.\n";
- print "OTHER_FILES= Space seperated list of other files to backup.\n";
- print "PATH_TO_SAVE= Default Hard Drive path to create backup files in.\n";
- print " Root Mode: default is /var/lib/drakbackup.\n";
- print " User Mode: default is ~/.drakbackup/backups.\n";
- print "NO_SYS_FILES Don't backup system files.\n";
- print "NO_USER_FILES Don't backup user files.\n";
- print "OPTION_COMP Compression option - TAR.GZ or TAR.BZ2 (tar.gz is default).\n";
- print "BROWSER_CACHE Backup web browser cache also.\n";
- print "CDRW Backup media is re-writable CD.\n";
- print "DVDR Backup media is recordable DVD (not fully supported yet).\n";
- print "DVDRAM Backup media is DVDRAM (not fully supported yet).\n";
- print "NET_PROTO= Network protocol to use for remote backups: \n";
- print " ftp, rsync, ssh, or webdav.\n";
- print "HOST_NAME= Remote backup host.\n";
- print "HOST_PATH= Backup storage path or module on remote host.\n";
- print "REMEMBER_PASS Remember password on remote host in config file.\n";
- print "USER_KEYS Ssh keys are already setup for communicating with remote host.\n";
- print "DRAK_KEYS Use special drakbackup generated host keys.\n";
- print " (requires perl-Expect, disabled).\n";
- print "USE_EXPECT Use expect to do the whole scp transfer, without keys.\n";
- print " (requires perl-Expect, disabled).\n";
- print "LOGIN= Remote host login name.\n";
- print "PASSWD= Password on remote host (if REMEMBER_PASS is enabled).\n";
- print "DAEMON_MEDIA= Daemon mode backup via given media.\n";
- print " (hd, cd, tape, ftp, rsync, ssh, or webdav).\n";
- print "HD_QUOTA Use quota to limit hard drive space used for backups.\n";
- print " (not supported yet).\n";
- print "USE_HD Use Hard Drive for backups (currently all modes use HD also).\n";
- print "USE_CD Use CD for backups.\n";
- print "USE_NET Use network for backups (driven by NET_PROTO).\n";
- print "USE_TAPE Use tape for backup.\n";
- print "DEL_HD_FILES Delete local hard drive tar files after backup to other media.\n";
- print "TAPE_NOREWIND Use non-rewinding tape device.\n";
- print "CD_TIME= Length of CD media (not currently utilized).\n";
- print "DAEMON_TIME_SPACE= Interval between daemon backup runs (hourly, daily, weekly)..\n";
- print "CD_WITH_INSTALL_BOOT Build a bootable restore CD (currently not utilized).\n";
- print "CD_DEVICE= Cdrecord style CD device name (ie: 1,3,0).\n";
- print "USER_MAIL= User to send backup results to via email.\n";
- print "SEND_MAIL Do send backup results via email.\n";
- print "TAPE_DEVICE Device to use for tape backup (ie: /dev/st0).\n";
- print "MEDIA_ERASE Erase media before new backup (applies to tape, CD).\n";
- print "MEDIA_EJECT Eject media after backup completes.\n";
- print "MULTI_SESSION Allow muliple sessions to be written to CD media.\n";
- print "SYS_INCREMENTAL_BACKUPS Do incremental backups of system files.\n";
- print "USER_INCREMENTAL_BACKUPS Do imcremental backups of user files.\n";
- print "OTHER_INCREMENTAL_BACKUPS Do incremental backups if other files.\n";
- print "NO_CRITICAL_SYS Do not backup critical system files:\n";
- print " passwd, fstab, group, mtab\n";
- print "CRITICAL_SYS Do backup above system files.\n";
- exit(0);
-}
-
-sub backend_mode {
- $backend_only = 1;
- build_backup_files();
- exit(0);
-}
-
-sub daemon_mode {
- $daemon = 1;
- build_backup_files();
- exit(0);
-}
-
-interactive_mode();
-
-sub all_user_list {
- my ($username) = @_;
- my $passwdfile = "/etc/passwd";
- my $user;
- my $uid;
- @all_user_list = ();
-
- open (PASSWD, $passwdfile) or exit 1;
- while (defined(my $line = <PASSWD>)) {
- chomp($line);
- ($user, $uid) = (split(/:/, $line))[0, 2];
- if ($uid >= 500 || $uid == 0) {
- push @all_user_list, $user;
- }
- }
- close (PASSWD);
- if ($DEBUG) {
- print "/-- User list --/ \n";
- print " -> $_\n" foreach (@all_user_list);
- print "\n";
- }
-}
-
-sub the_time {
- $the_time = "_";
- $the_time .= localtime->year() + 1900;
- if (localtime->mon() < 9) { $the_time .= "0" }
- $the_time .= localtime->mon() +1;
- if (localtime->mday() < 10) { $the_time .= "0" }
- $the_time .= localtime->mday();
- $the_time .= "_";
- if (localtime->hour() < 10) { $the_time .= "0" }
- $the_time .= localtime->hour();
- if (localtime->min() < 10) { $the_time .= "0" }
- $the_time .= localtime->min();
- if (localtime->sec() < 10) { $the_time .= "0" }
- $the_time .= localtime->sec();
-}
-
-sub get_tape_info {
- my @line_data;
- my $info = "/tmp/dmesg";
- @tape_devices = ();
- system("dmesg | grep 'st[0-9] at' > $info");
-
- open(INFO, $info) || warn("Can't open $info\n");
- while (<INFO>) {
- @line_data = split(/[ \t,]+/, $_);
- push @tape_devices, "/dev/" . $line_data[3];
- }
- close(INFO);
- unlink($info);
-}
-
-sub get_cd_info {
- my @cd_info = cat_("/proc/sys/dev/cdrom/info");
- my @line_data;
- my @drive_names;
- my $i;
- my $key;
- my $info;
-
- #- kind of ugly - I'm sure Pixel could improve this, but it works
- #- parse /proc/sys/dev/cdrom/info and get all the cd device capabilities
- 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" if (!$interactive);
- }
- chop($line_data[$cd_drives]) if $cd_drives;
- if ($line_data[0] eq "drive speed") {
- for ($i = 1; $i <= $cd_drives; $i++) {
- $cd_devices{$drive_names[$i]}{speed} = $line_data[$i];
- }
- }
- if ($line_data[0] eq "Can change speed") {
- for ($i = 1; $i <= $cd_drives; $i++) {
- $cd_devices{$drive_names[$i]}{chg_speed} = $line_data[$i];
- }
- }
- if ($line_data[0] eq "Can read multisession") {
- for ($i = 1; $i <= $cd_drives; $i++) {
- $cd_devices{$drive_names[$i]}{multisession} = $line_data[$i];
- }
- }
- if ($line_data[0] eq "Can write CD-R") {
- for ($i = 1; $i <= $cd_drives; $i++) {
- $cd_devices{$drive_names[$i]}{cdr} = $line_data[$i];
- }
- }
- if ($line_data[0] eq "Can write CD-RW") {
- for ($i = 1; $i <= $cd_drives; $i++) {
- $cd_devices{$drive_names[$i]}{cdrw} = $line_data[$i];
- }
- }
- if ($line_data[0] eq "Can write DVD-R") {
- for ($i = 1; $i <= $cd_drives; $i++) {
- $cd_devices{$drive_names[$i]}{dvdr} = $line_data[$i];
- }
- }
- if ($line_data[0] eq "Can write DVD-RAM") {
- for ($i = 1; $i <= $cd_drives; $i++) {
- $cd_devices{$drive_names[$i]}{dvdram} = $line_data[$i];
- }
- }
- }
-
- #- now we know all the capabilities, we need the cdrecord device id
- #- this is scsi-channel, id, lun from /dev/scsi/host*
- #- oops - can't count on devfs - use dmesg
-
- $info = "/tmp/dmesg";
- system("dmesg | grep sr[0-9] > $info");
-
- open(INFO, $info) || warn("Can't open $info\n");
- while (<INFO>) {
- if (/sr[0-9] at/) {
- @line_data = split(/[ \t,]+/, $_);
- chop($line_data[11]);
- $line_data[5] =~ s/scsi//;
- $cd_devices{$line_data[3]}{rec_dev} = $line_data[5] . "," . $line_data[9] . "," . $line_data[11];
- }
- }
- close(INFO);
- unlink($info);
-
- #- should we also try to get the human readable name for display purposes?
-
- #- now just report the data if we called --cd-info from the command line
- if (!$interactive) {
- foreach $key (keys %cd_devices) {
- 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 {
- #- in non-interactive mode we just let all the devices through
- #- as a general purpose probe - in reality we want only burners
- foreach $key (keys %cd_devices) {
- delete $cd_devices{$key} if ($cd_devices{$key}{rec_dev} eq '')
- }
- }
-}
-
-sub save_conf_file {
-
- write_sitecopyrc() if ($net_proto eq 'webdav');
- write_password_file() if (($net_proto eq 'rsync') && ($passwd_user ne ''));
-
- my @cfg_list = ("SYS_FILES=@sys_files\n",
- "HOME_FILES=@user_list\n",
- "OTHER_FILES=@list_other\n",
- "PATH_TO_SAVE=$save_path\n",
- "HOST_PATH=$host_path\n",
- "NET_PROTO=$net_proto\n",
- "CD_TIME=$cd_time\n",
- "USER_MAIL=$user_mail\n",
- "DAEMON_TIME_SPACE=$when_space\n",
- "CD_DEVICE=$cd_device\n",
- "LOGIN=$login_user\n",
- "TAPE_DEVICE=$tape_device\n",
- "HOST_NAME=$host_name\n"
- );
- $no_critical_sys and push @cfg_list, "NO_CRITICAL_SYS\n" ;
- $no_critical_sys or push @cfg_list, "CRITICAL_SYS\n" ;
- $send_mail and push @cfg_list, "SEND_MAIL\n";
- $backup_sys_versions and push @cfg_list, "SYS_INCREMENTAL_BACKUPS\n" ;
- $backup_user_versions and push @cfg_list, "USER_INCREMENTAL_BACKUPS\n" ;
- $backup_other_versions and push @cfg_list, "OTHER_INCREMENTAL_BACKUPS\n" ;
- $media_erase and push @cfg_list, "MEDIA_ERASE\n" ;
- $media_eject and push @cfg_list, "MEDIA_EJECT\n" ;
- $multi_session and push @cfg_list, "MULTI_SESSION\n" ;
- $remember_pass and push @cfg_list, "LOGIN=$login_user\n" ;
- $remember_pass and push @cfg_list, "PASSWD=$passwd_user\n" ;
- $remember_pass and push @cfg_list, "REMEMBER_PASS\n" ;
- $user_keys and push @cfg_list, "USER_KEYS\n" ;
- $xfer_keys and push @cfg_list, "DRAK_KEYS\n" ;
- $use_expect and push @cfg_list, "USE_EXPECT\n" ;
- $cd_with_install_boot and push @cfg_list, "CD_WITH_INSTALL_BOOT\n" ;
- ($daemon_media eq 'ssh') and $backup_daemon and push @cfg_list, "DAEMON_MEDIA=ssh\n" ;
- ($daemon_media eq 'ftp') and $backup_daemon and push @cfg_list, "DAEMON_MEDIA=ftp\n" ;
- ($daemon_media eq 'hd') and $backup_daemon and push @cfg_list, "DAEMON_MEDIA=hd\n" ;
- ($daemon_media eq 'cd') and $backup_daemon and push @cfg_list, "DAEMON_MEDIA=cd\n" ;
- ($daemon_media eq 'tape') and $backup_daemon and push @cfg_list, "DAEMON_MEDIA=tape\n" ;
- ($daemon_media eq 'webdav') and $backup_daemon and push @cfg_list, "DAEMON_MEDIA=webdav\n" ;
- ($daemon_media eq 'rsync') and $backup_daemon and push @cfg_list, "DAEMON_MEDIA=rsync\n" ;
- $hd_quota and push @cfg_list, "HD_QUOTA\n" ;
- $where_hd and push @cfg_list, "USE_HD\n" ;
- $where_cd and push @cfg_list, "USE_CD\n" ;
- $where_tape and push @cfg_list, "USE_TAPE\n" ;
- $tape_norewind and push @cfg_list, "TAPE_NOREWIND\n" ;
- $where_net and push @cfg_list, "USE_NET\n" ;
- $cdrw and push @cfg_list, "CDRW\n";
- $dvdr and push @cfg_list, "DVDR\n";
- $dvdram and push @cfg_list, "DVDRAM\n";
- $what_no_browser or push @cfg_list, "BROWSER_CACHE\n" ;
- $backup_sys or push @cfg_list, "NO_SYS_FILES\n";
- if ($comp_mode) {
- push @cfg_list, "OPTION_COMP=TAR.BZ2\n";
- } else {
- push @cfg_list, "OPTION_COMP=TAR.GZ\n";
- }
- $del_hd_files and push @cfg_list, "DEL_HD_FILES\n" ;
- output_p($cfg_file, @cfg_list);
- chmod(0600, $cfg_file);
- save_cron_files() if ($backup_daemon);
-}
-
-sub read_cron_files {
- my $daemon_found = 0;
- foreach (qw(hourly daily weekly monthly)) {
- if (-f "/etc/cron.$_/drakbackup") {
- $when_space = $_;
- $daemon_found = 1;
- last;
- }
- }
- !$daemon_found and $backup_daemon = 0;
-}
-
-sub save_cron_files {
- if ($nonroot_user) {
- show_warning("w", __("Cron not available yet as non-root")) if ($not_warned);
- $not_warned = 0;
- $backup_daemon = 0;
- return(1);
- }
- my @cron_file = ("#!/bin/sh\n", "export TERM=xterm\n", "/usr/sbin/drakbackup --daemon > /dev/null 2>&1\n");
-
- if ($backup_daemon) {
- foreach (qw(hourly daily weekly monthly)) {
- -f "/etc/cron.$_/drakbackup" and rm_rf("/etc/cron.$_/drakbackup");
- }
- output_p("/etc/cron.$when_space/drakbackup", @cron_file);
- system("chmod +x /etc/cron.$when_space/drakbackup");
- } else {
- foreach (qw(hourly daily weekly monthly)) {
- -f "/etc/cron.$_/drakbackup" and rm_rf("/etc/cron.$_/drakbackup");
- }
- }
-}
-
-sub read_conf_file {
- if (-e $cfg_file) {
- open (CONF_FILE, "<". $cfg_file) || print "You must be root to read configuration file. \n";
- while (<CONF_FILE>) {
- next unless /\S/;
- next if /^#/;
- chomp;
- if (/^SYS_FILES/) { s/^SYS_FILES=//gi; @sys_files = split(' ', $_) }
- if (/^HOME_FILES/) { s/^HOME_FILES=//gi; @user_list = split(' ', $_) }
- if (/^OTHER_FILES/) { s/^OTHER_FILES=//gi; @list_other = split(' ', $_) }
- if (/^PATH_TO_SAVE/) { s/^PATH_TO_SAVE=//gi; $save_path = $_ }
- if (/^NO_SYS_FILES/) { $backup_sys = 0 }
- if (/^NO_USER_FILES/) { $backup_user = 0 }
- if (/^OPTION_COMP/) { s/^OPTION_COMP=//gi; /TAR.GZ/ and $comp_mode = 0; /TAR.BZ2/ and $comp_mode = 1 }
- if (/^BROWSER_CACHE/) { $what_no_browser = 0 }
- if (/^CDRW/) { $cdrw = 1 }
- if (/^DVDR/) { $dvdr = 1 }
- if (/^DVDRAM/) { $dvdram = 1 }
- if (/^NET_PROTO/) { s/^NET_PROTO=//gi; $net_proto = $_ }
- if (/^HOST_PATH/) { s/^HOST_PATH=//gi; $host_path = $_ }
- if (/^DAEMON_MEDIA/) { s/^DAEMON_MEDIA=//gi; $daemon_media = $_ }
- if (/^HD_QUOTA/) { $hd_quota = 1 }
- if (/^USE_HD/) { $where_hd = 1 }
- if (/^USE_CD/) { $where_cd = 1 }
- if (/^USE_NET/) { $where_net = 1 }
- if (/^USE_TAPE/) { $where_tape = 1 }
- if (/^TAPE_NOREWIND/) { $tape_norewind = 1 }
- if (/^CD_TIME/) { s/^CD_TIME=//gi; $cd_time = $_ }
- if (/^DAEMON_TIME_SPACE/) { s/^DAEMON_TIME_SPACE=//gi; $when_space = $_ }
- if (/^CD_WITH_INSTALL_BOOT/) { $cd_with_install_boot = 1 }
- if (/^CD_DEVICE/) { s/^CD_DEVICE=//gi; $cd_device = $_ }
- if (/^HOST_NAME/) { s/^HOST_NAME=//gi; $host_name = $_ }
- if (/^REMEMBER_PASS/) { $remember_pass = 1 }
- if (/^USER_KEYS/) { $user_keys = 1 }
- if (/^DRAK_KEYS/) { $xfer_keys = 1; $user_keys = 0 }
- if (/^USE_EXPECT/) { $use_expect = 1; $user_keys = 0 }
- if (/^LOGIN/) { s/^LOGIN=//gi; $login_user = $_ }
- if (/^PASSWD/) { s/^PASSWD=//gi; $passwd_user = $_; $remember_pass = 1 }
- if (/^USER_MAIL/) { s/^USER_MAIL=//gi; $user_mail = $_ }
- if (/^SEND_MAIL/) { $send_mail = 1 }
- if (/^TAPE_DEVICE/) { s/TAPE_DEVICE=//gi; $tape_device = $_ }
- if (/^MEDIA_ERASE/) { $media_erase = 1 }
- if (/^MEDIA_EJECT/) { $media_eject = 1 }
- if (/^MULTI_SESSION/) { $multi_session = 1 }
- if (/^SYS_INCREMENTAL_BACKUPS/) { $backup_sys_versions = 1 }
- if (/^USER_INCREMENTAL_BACKUPS/) { $backup_user_versions = 1 }
- if (/^OTHER_INCREMENTAL_BACKUPS/) { $backup_other_versions = 1 }
- if (/^NO_CRITICAL_SYS/) { $no_critical_sys = 1 }
- if (/^CRITICAL_SYS/) { $no_critical_sys = 0 }
- if (/^DEL_HD_FILES/) { $del_hd_files = 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
- $backup_sys_versions = 1;
- $backup_user_versions = 1;
- }
- close CONF_FILE;
-}
-
-sub write_sitecopyrc {
- #- FIXME - how to deal with existing sitecopyrc
- my @cfg_list = ("site drakbackup\n",
- "\tserver $host_name\n",
- "\tremote /$host_path\n",
- "\tlocal $save_path\n",
- "\tusername $login_user\n",
- "\tpassword $passwd_user\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", "$passwd_user\n");
- chmod(0600, "$cfg_dir/rsync.user");
-}
-
-sub show_warning {
- my ($mode, $warning) = @_;
- $mode = __("WARNING") if ($mode eq "w");
- $mode = __("FATAL") if ($mode eq "f");
- $mode = __("INFO") if ($mode eq "i");
- if ($interactive) {
- $in->ask_warn('',translate("$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 DrakBackup Report \n\n");
- $daemon and $results .= _("\n DrakBackup Daemon Report\n\n\n");
- $results .= "***********************************************************************\n\n";
- $results .= $system_state;
- $results .= "\n\n***********************************************************************\n\n";
- $results .= _("\n DrakBackup Report Details\n\n\n");
- $results .= "***********************************************************************\n\n";
-}
-
-sub ftp_client {
- use Net::FTP;
- my $ftp;
-
- $DEBUG and print "file list to send: $_\n " foreach @file_list_to_send_by_ftp;
- if ($DEBUG && $interactive) { $ftp = Net::FTP->new($host_name, Debug => 1) or return(1) }
- elsif ($interactive) { $ftp = Net::FTP->new($host_name, Debug => 0) or return(1) }
- else { $ftp = Net::FTP->new($host_name, Debug => 0) or return(1) }
- $ftp->login($login_user, $passwd_user);
- $ftp->cwd($host_path);
- foreach (@file_list_to_send_by_ftp) {
- $interactive and $pbar->set_value(0);
- $interactive and progress($pbar, 0.5, $_);
- $interactive and $pbar->set_show_text($_);
- $ftp->put($_);
- $interactive and progress($pbar, 0.5, $_);
- $interactive and $pbar->set_show_text($_);
- $interactive and progress($pbar3, 1/@file_list_to_send_by_ftp, _("Total progess"));
- }
- $ftp->quit;
- return(0);
-}
-
-#- this is just here to get around Expect for the moment
-sub exp_continue {
- 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, $filename) = @_;
-
- #- move this to the top? - problem is need for perl-Expect (in contribs)
-
-#- temporarily disabled
-# use Expect;
-show_warning("w", __("Sorry, perl-Expect is not installed/enabled. To use\nthis feature, install perl-Expect and comment lines 702-704,\n as well as 718,719. Then uncomment line 717."));
-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 $timeout = 20;
-
- my $exp_command;
- my @send_files = ("$backup_key.pub");
-
- @send_files = @file_list_to_send_by_ftp if ($mode eq "backup");
-
- $interactive and $pbar->set_value(0);
- $interactive and $pbar3->set_value(0);
- $interactive and progress($pbar, 0.5, "File Transfer...");
-
- foreach (@send_files) {
- $exp_command = "scp -P $scp_port $_ $login_user\@$host_name:$host_path" if ($mode eq "backup");
- $exp_command = "ssh-copy-id -i $_ $login_user\@$host_name" if ($mode eq "sendkey");
-
- if ((-e $backup_key) && ($mode eq "sendkey")) {
- if ($in->ask_yesorno('', _("%s exists, delete?\n\nWarning: If 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('',_("This may take a moment to generate the keys."));
- cursor_wait();
- #- not using a passphrase for the moment
- system("ssh-keygen -P '' -t dsa -f $backup_key");
- cursor_norm();
- }
-
- my $exp = Expect->spawn($exp_command) or $in->ask_warn('',_("ERROR: Cannot spawn %s.", $exp_command));
-
- $interactive and progress($pbar3, 1/@send_files, _("Total progess"));
- $interactive 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("$passwd_user\n");
- exp_continue } ],
- [ '-re', 'please try again', sub { $bad_passwd = 1; exp_continue } ],
- [ '-re', 'Permission denied', sub { $no_perm = 1; exp_continue } ],
- [ '-re', 'No such file or directory', sub { $bad_dir = 1; exp_continue } ],
-# [ '-re', '%', sub { update_scp_progress(); exp_continue; } ],
- [ eof => sub {
- if (!$spawn_ok) { show_warning("f","No password prompt on $host_name at port $scp_port") }
- if ($bad_passwd) { show_warning("f", "Bad password on $host_name") }
- if ($no_perm) { show_warning("f", "Permission denied transferring $_ to $host_name") }
- if ($bad_dir) { show_warning("f", "Can't find $host_path on $host_name") }
- }
- ],
- [ timeout => sub { show_warning("f", "$host_name not responding") } ],
- );
-
- my $exit_stat = $exp->exitstatus;
- $in->ask_warn('',_("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, $login_user, $host_name)) if (($exit_stat eq 0) && ($mode eq "sendkey"));
- $log_buff .= "$_\n" if (($exit_stat eq 0) && ($mode eq "backup"));
- $exp->hard_close();
- }
- $interactive and progress($pbar, 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 ($user_keys) {
- $command = "scp -P $scp_port $_ $login_user\@$host_name:$host_path";
- } else {
- $command = "scp -P $scp_port -i $backup_key $_ $login_user\@$host_name:$host_path";
- }
- $interactive and $pbar->set_value(0);
- $interactive and progress($pbar, 0.5, "File Transfer...");
- $interactive and $stext->set_text($_);
- $log_buff .= $command . "\n\n";
- open TMP, "$command 2>&1 |";
- while ($value = <TMP>) {
- $log_buff .= $value;
- }
- close TMP;
- $log_buff .= "\n";
- $interactive and progress($pbar, 0.5, "Done...");
- $interactive and progress($pbar3, 1/@file_list_to_send_by_ftp, _("Total progess"));
- }
- 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 $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", __("WebDAV remote site already in sync!"));
- return(1);
- }
- if ($log_buff !~ /Update completed successfully/) {
- show_warning("f", __("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 $save_path/* ";
- $rsync_cmd = $rsync_cmd . "--password-file=$cfg_dir/rsync.user " if ($passwd_user ne '');
- $rsync_cmd = $rsync_cmd . "$login_user\@" if ($login_user ne '');
- $rsync_cmd = $rsync_cmd . "$host_name\:\:$host_path";
- spawn_progress($rsync_cmd, "Running rsync");
- return(0);
-}
-
-sub check_for_cd {
- #- check for a cd
- my $command = "cdrecord dev=$cd_device -atip";
- spawn_progress($command, "Check for media in drive");
- if ($log_buff =~ /No disk/) {
- show_warning("f", __("No CDR/DVDR in drive!"));
- return(1);
- }
- if ($log_buff !~ /ATIP info from disk/) {
- show_warning("f", __("Does not appear to be recordable media!"));
- return(1);
- }
- if (($log_buff =~ /Is not erasable/) && ($media_erase)) {
- show_warning("f", __("Not erasable media!"));
- return(1);
- }
-
- if ($multi_session) {
- $command = "cdrecord dev=$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/) {
- $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=$cd_device -data ";
- #- only blank if it's the first session
- $command .= "blank=fast " if (($media_erase) && ($session_offset eq ''));
- #- multi-session mode
- $command .= "-multi -pad " if ($multi_session);
- $command .= "$save_path/drakbackup.iso";
-
- spawn_progress($command, "Running cdrecord");
- unlink("$save_path/drakbackup.iso");
-}
-
-sub erase_cdrw {
- #- we can only hit this via interactive
- $interactive = 0;
- $in->ask_warn('',_("This may take a moment to erase the media."));
- cursor_wait();
- my $command = "cdrecord dev=$cd_device -blank=fast";
- spawn_progress($command, "Erasing CDRW...");
- cursor_norm();
- $interactive = 1;
-}
-
-sub spawn_progress {
- my ($command, $descr) = @_;
- my $value;
- my $timer;
-
- $interactive and progress($pbar3, 0, _($descr));
- $interactive and $pbar3->set_activity_mode(1);
- $interactive and ($pbar3->set_value(0));
- $interactive and ($timer = Gtk->timeout_add(2, \&progress_timeout));
-
- $log_buff .= "\n" . $descr . ":\n";
- $log_buff .= $command . "\n\n";
-
- open TMP, "$command 2>&1 |";
- while ($value = <TMP>) {
- $log_buff .= $value;
- if ($interactive) {
- $stext->set_text($value);
- Gtk->main_iteration while (Gtk->events_pending);
- }
- }
- close TMP;
- $interactive and $pbar3->set_activity_mode(0);
- $interactive and Gtk->timeout_remove($timer);
-}
-
-sub progress_timeout {
- my $new_val;
- my $adj;
- $new_val = $pbar3->get_value() + 1;
- $adj = $pbar3->adjustment;
- $new_val = $adj->lower if ($new_val > $adj->upper);
- $pbar3->set_value($new_val);
- return(1);
-}
-
-sub get_cd_device {
- my $check_device = "/dev/cdrom";
- get_cd_info();
- foreach (keys %cd_devices) {
- if ($cd_devices{$_}{rec_dev} eq $cd_device) {
- s/sr/scd/;
- $check_device = "/dev/" . $_;
- }
- }
- $check_device;
-}
-
-sub get_cd_volname {
- #- we want the volname for the catalog
- my $check_device = get_cd_device();
- open TMP, "volname $check_device 2>&1 |";
- while (<TMP>) {
- $vol_name = $_;
- }
- close TMP;
- $vol_name =~ s/[ \t]+\n$//;
- $vol_name;
-}
-
-sub build_iso {
- if (($multi_session) && ($session_offset ne '')) {
- $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 $cd_device " if (($multi_session) && ($session_offset ne ''));
- $command .= "-o $save_path/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", __("Permission problem accessing CD."));
- $media_problem = 1;
- return(1);
- } else {
- write_on_cd();
- }
- }
-}
-
-sub get_tape_label {
- my ($device) = @_;
- cursor_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];
- cursor_norm();
- $vol_name;
-}
-
-sub build_tape {
- my $command;
- #- do we have a tape?
- $command = "mt -f $tape_device status";
- spawn_progress($command, "Checking for tape");
- if ($log_buff =~ /DR_OPEN/) {
- show_warning("f", "No tape in $tape_device!");
- return(1);
- }
-
- #- try to roll to the end of the data if we're not erasing
- if (!$media_erase) {
- $command = "mt -f $tape_device rewind";
- spawn_progress($command, "Rewind to find tape label");
- $command = "tar -tf $tape_device";
- spawn_progress($command, "Check for label");
- if ($log_buff =~ /drakbackup.label/) {
- if ($tape_norewind) {
- $command = "mt -f $tape_device rewind";
- spawn_progress($command, "Rewind to get tape label");
- }
- $command = "tar -C $cfg_dir -xf $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 $tape_device eod";
- spawn_progress($command, "Running mt to find eod");
- } else {
- $command = "mt -f $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 (!$tape_norewind) {
- $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 $tape_device drakbackup.label;";
- spawn_progress($command, "Creating tape label");
- unlink $f;
- if (!$tape_norewind) {
- $tape_device =~ s/\/nst/\/st/;
- }
- }
-
- #- do the backup
- $command = "tar -cvf $tape_device @file_list_to_send_by_ftp";
- spawn_progress($command, "Running tar to tape");
-
- #- eject the tape?
- if ($media_eject) {
- $command = "mt -f $tape_device rewoff";
- spawn_progress($command, "Running mt to eject tape");
- }
-}
-
-sub send_mail {
- my ($result) = @_;
- my $datem = `date`;
-
- open F, "|/usr/sbin/sendmail -f$user_mail $user_mail" or return(1);
- print F "From: drakbackup\n";
- print F "To: $user_mail \n";
- print F "Subject: DrakBackup report on $datem \n";
- print F "\n";
- print F "$result\n";
- close F or return(1);
- return(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 $vartemp;
- my $base_sys_exist = 0;
- my $base_user_exist = 0;
- my $base_other_exist = 0;
- my @list_temp ;
- my @list_other_;
- my @dir_content;
- my $file_date;
- $results = "";
- $log_buff = "";
- #- flush this 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 = ();
-
- $interactive and cursor_wait();
- read_conf_file();
- the_time();
- $send_mail and complete_results();
- -d $save_path or mkdir_p ($save_path);
- if ($comp_mode) {
- $DEBUG and $tar_cmd = "tar cv --use-compress-program /usr/bin/bzip2 ";
- $DEBUG or $tar_cmd = "tar c --use-compress-program /usr/bin/bzip2 ";
- $tar_ext = "tar.bz2" ;
- } else {
- $DEBUG and $tar_cmd = "tar cvpz ";
- $DEBUG or $tar_cmd = "tar cpz ";
- $tar_ext = "tar.gz"
- }
- $tar_cmd_sys = $tar_cmd;
- $tar_cmd_user = $tar_cmd;
- $tar_cmd_other = $tar_cmd;
- $no_critical_sys and $tar_cmd_sys .= "--exclude passwd --exclude fstab --exclude group --exclude mtab";
- $what_no_browser and $tar_cmd_user .= "--exclude NewCache --exclude Cache --exclude cache";
- $nonroot_user and $tar_cmd_user .= " --exclude .drakbackup";
-
- -d $save_path and @dir_content = all($save_path);
- grep (/^backup\_base\_sys/, @dir_content) and $base_sys_exist = 1;
-
- if (($where_hd && !$daemon) || ($daemon && ($daemon_media eq 'hd'))) {
- $interactive and progress($pbar, 0.5, _("Backup system files..."));
- if ($backup_sys) {
- if ($backup_sys_versions) {
- #- 8/19/2002 - changed these greps to look at the list, rather than the tar file
- #- we retain the list for other media backups, but the tar file goes away, potentially
- if (grep /^list\_incr\_sys/, @dir_content) {
- my @more_recent = grep /^list\_incr\_sys/, sort @dir_content;
- $more_recent = pop @more_recent;
- $DEBUG and print "more recent file: $more_recent\n";
- system("find @sys_files -cnewer $save_path/$more_recent \! -type d -print > $save_path/list_incr_sys$the_time.txt");
- if (!cat_("$save_path/list_incr_sys$the_time.txt")) {
- system("rm $save_path/list_incr_sys$the_time.txt");
- } else {
- system("$tar_cmd_sys -f $save_path/backup_incr_sys$the_time.$tar_ext -T $save_path/list_incr_sys$the_time.txt");
- push @file_list_to_send_by_ftp, "$save_path/backup_incr_sys$the_time.$tar_ext";
- push @file_list_to_send_by_ftp, "$save_path/list_incr_sys$the_time.txt";
- $results .= "\nfile: $save_path/backup_incr_sys$the_time.$tar_ext\n";
- $results .= cat_("$save_path/list_incr_sys$the_time.txt");
- }
- } elsif (grep /^list_base\_sys/, @dir_content) {
- my @more_recent = grep /^list\_base\_sys/, sort @dir_content;
- $more_recent = pop @more_recent;
- $DEBUG and print "more recent file: $more_recent\n";
- system("find @sys_files -cnewer $save_path/$more_recent \! -type d -print > $save_path/list_incr_sys$the_time.txt");
- if (!cat_("$save_path/list_incr_sys$the_time.txt")) {
- system("rm $save_path/list_incr_sys$the_time.txt");
- } else {
- system("$tar_cmd_sys -f $save_path/backup_incr_sys$the_time.$tar_ext -T $save_path/list_incr_sys$the_time.txt");
- push @file_list_to_send_by_ftp, "$save_path/backup_incr_sys$the_time.$tar_ext";
- push @file_list_to_send_by_ftp, "$save_path/list_incr_sys$the_time.txt";
- $results .= "\nfile: $save_path/backup_incr_sys$the_time.$tar_ext\n";
- $results .= cat_("$save_path/list_incr_sys$the_time.txt");
- }
- } else {
- #- need this for the first pass too, if we're offloading the backups to other media (sb)
- system("find $path_name \! -type d -print > $save_path/list_base_sys$the_time.txt");
- system("$tar_cmd_sys -f $save_path/backup_base_sys$the_time.$tar_ext @sys_files");
- push @file_list_to_send_by_ftp, "$save_path/backup_base_sys$the_time.$tar_ext";
- push @file_list_to_send_by_ftp, "$save_path/list_base_sys$the_time.txt";
- $results .= "\nfile: $save_path/backup_base_sys$the_time.$tar_ext\n";
- }
- } else {
- system("cd $save_path && rm -f backup_sys* backup_base_sys* backup_incr_sys*");
- system("$tar_cmd_sys -f $save_path/backup_sys$the_time.$tar_ext @sys_files");
- push @file_list_to_send_by_ftp, "$save_path/backup_sys$the_time.$tar_ext";
- $results .= "\nfile: $save_path/backup_sys$the_time.$tar_ext\n";
- }
- }
-
- $interactive and progress($pbar, 0.5, _("Backup system files..."));
- $interactive and progress($pbar3, 0.3, _("Hard Disk Backup files..."));
-
- if (@list_other) {
- system("cd $save_path && rm -f backup_other* ");
- system("$tar_cmd_other -f $save_path/backup_other$the_time.$tar_ext @list_other");
- push @file_list_to_send_by_ftp, "$save_path/backup_other$the_time.$tar_ext";
- $results .= "\nfile: $save_path/backup_other$the_time.$tar_ext\n";
- #old foreach (@list_other) { push @list_other_, $_ . "\n"; }
- @list_other_ = map { "$_\n" } @list_other;
- output_p($save_path . '/list_other', @list_other_);
- }
-
- $interactive and progress($pbar1, 1, _("Backup User files..."));
- $interactive and progress($pbar3, 0.3, _("Hard Disk Backup Progress..."));
-
- if ($backup_user) {
- foreach (@user_list) {
- my $user = $_;
- $path_name = return_path($user);
- if ($backup_user_versions) {
- #- 8/19/2002 - changed these greps to look at the list, rather than the tar file
- #- we retain the list for other media backups, but the tar file goes away, potentially
- if (grep(/^list\_incr\_user\_$user\_/, @dir_content)) {
- my @more_recent = grep /^list\_incr\_user\_$user\_/, sort @dir_content;
- $more_recent = pop @more_recent;
- $DEBUG and print "more recent file: $more_recent\n";
- system("find $path_name -cnewer $save_path/$more_recent \! -type d -print > $save_path/list_incr_user_$user$the_time.txt");
- if (!cat_("$save_path/list_incr_user_$user$the_time.txt")) {
- system("rm $save_path/list_incr_user_$user$the_time.txt");
- } else {
- system("$tar_cmd_user -f $save_path/backup_incr_user_$user$the_time.$tar_ext -T $save_path/list_incr_user_$user$the_time.txt");
- push @file_list_to_send_by_ftp, "$save_path/backup_incr_user_$user$the_time.$tar_ext";
- push @file_list_to_send_by_ftp, "$save_path/list_incr_user_$user$the_time.txt";
- $results .= " \nfile: $save_path/backup_incr_user_$user$the_time.$tar_ext\n";
- $results .= cat_("$save_path/list_incr_user_$user$the_time.txt");
- }
- } elsif (grep /^list\_base\_user\_$user\_/, @dir_content) {
- my @more_recent = grep /^list\_base\_user\_$user\_/, sort @dir_content;
- $more_recent = pop @more_recent;
- $DEBUG and print "more recent file: $more_recent\n";
- system("find $path_name -cnewer $save_path/$more_recent \! -type d -print > $save_path/list_incr_user_$user$the_time.txt");
- if (!cat_("$save_path/list_incr_user_$user$the_time.txt")) {
- system("rm $save_path/list_incr_user_$user$the_time.txt");
- } else {
- system("$tar_cmd_user -f $save_path/backup_incr_user_$user$the_time.$tar_ext -T $save_path/list_incr_user_$user$the_time.txt");
- push @file_list_to_send_by_ftp, "$save_path/backup_incr_user_$user$the_time.$tar_ext";
- push @file_list_to_send_by_ftp, "$save_path/list_incr_user_$user$the_time.txt";
- $results .= "\nfile: $save_path/backup_incr_user_$user$the_time.$tar_ext\n";
- $results .= cat_("$save_path/list_incr_user_$user$the_time.txt");
- }
- } else {
- #- need this for the first pass too, if we're offloading the backups to other media (sb)
- system("find $path_name \! -type d -print > $save_path/list_base_user_$user$the_time.txt");
- system("$tar_cmd_user -f $save_path/backup_base_user_$user$the_time.$tar_ext $path_name");
- push @file_list_to_send_by_ftp, "$save_path/backup_base_user_$user$the_time.$tar_ext";
- push @file_list_to_send_by_ftp, "$save_path/list_base_user_$user$the_time.txt";
- $results .= "\nfile: $save_path/backup_base_user_$user$the_time.$tar_ext\n";
- }
- } else {
- system("cd $save_path && rm -f backup_user_$_* backup_base_user_$_* backup_incr_user_$_*");
- system("$tar_cmd_user -f $save_path/backup_user_$_$the_time.$tar_ext $path_name");
- push @file_list_to_send_by_ftp, "$save_path/backup_user_$_$the_time.$tar_ext";
- $results .= "\nfile: $save_path/backup_user_$user$the_time.$tar_ext\n";
- }
- }
- }
- $interactive and progress($pbar2, 1, _("Backup Other files..."));
- $interactive and progress($pbar3, 0.4, _("Hard Disk Backup files..."));
- }
-
- my $filecount = @file_list_to_send_by_ftp;
- if (!$filecount) {
- show_warning("w", __("No changes to backup!"));
- $interactive and cursor_norm();
- $interactive and show_status();
- return(1);
- }
-
- #- should hit this block if running daemon mode only
- if ($daemon && ($daemon_media ne '')) {
-# ftp_client() if $ftp_daemon;
- rsync_client() if ($daemon_media eq 'rsync');
- ssh_client() if (($daemon_media eq 'ssh') && !($use_expect));
- do_expect("backup", "") if (($daemon_media eq 'ssh') && ($use_expect));
- webdav_client() if ($daemon_media eq 'webdav');
- build_cd() if ($daemon_media eq 'cd');
- build_tape() if ($daemon_media eq 'tape');
-
- $results .= _("\nDrakbackup activities via %s:\n\n", $daemon_media) ;
- $results .= $log_buff;
- }
-
- #- leave this one alone for now - works well
- #- integrate with other methods later
- if (($where_net && !$daemon && ($net_proto eq 'ftp')) || ($daemon && ($daemon_media eq 'ftp'))) {
- $results .= _("file list sent by FTP: %s\n ", $_) foreach @file_list_to_send_by_ftp;
- $interactive and build_backup_ftp_status();
- if (ftp_client()) {
- $results .= _("\n FTP connection problem: It was not possible to send your backup files by FTP.\n");
- $interactive and client_ftp_pb();
- }
- }
-
- #- consolidate all the other methods under here - interactive and --default should land here
- if (!$daemon) {
-
- if ($where_net && ($net_proto ne '') && ($net_proto ne 'ftp')) {
- rsync_client() if ($net_proto eq 'rsync');
- ssh_client() if (($net_proto eq 'ssh') && !($use_expect));
- do_expect("backup", "") if (($net_proto eq 'ssh') && ($use_expect));
- webdav_client() if ($net_proto eq 'webdav');
- $results .= _("\nDrakbackup activities via %s:\n\n", $net_proto);
- }
-
- if ($where_cd) {
- build_cd();
- $results .= _("\nDrakbackup activities via CD:\n\n");
- }
-
- if ($where_tape) {
- build_tape();
- $results .= _("\nDrakbackup activities via tape:\n\n");
- }
- $results .= $log_buff;
-
- }
-
- if ($send_mail) {
- if (send_mail($results)) {
- $interactive and send_mail_pb();
- $interactive or print _(" Error during mail sending. \n");
- }
- }
-
- #- write our catalog file
- if (!$media_problem) {
- my $catalog = substr($the_time, 1);
- if ((!$where_net) && (!$where_tape) && (!$where_cd)) {
- $catalog .= ":HD:localhost:$save_path";
- $net_proto = '';
- }
- $catalog .= ":$net_proto:$login_user\@$host_name:$host_path" if ($net_proto ne '');
- $catalog .= ":CD:$vol_name:$cd_device" if ($where_cd);
- $catalog .= ":Tape:$vol_name:$tape_device" if ($where_tape);
- $catalog .= ":System" if ($backup_sys);
- $catalog .= ":I" if (($backup_sys_versions) && ($backup_sys));
- $catalog .= ":F" if ((!$backup_sys_versions) && ($backup_sys));
- $catalog .= ":Users=(@user_list)" if ($backup_user);
- $catalog .= ":I" if (($backup_user_versions) && ($backup_user));
- $catalog .= ":F" if ((!$backup_user_versions) && ($backup_user));
- $catalog .= ":Other=(@list_other)" if (@list_other);
- $catalog .= ":I" if (($backup_other_versions) && (@list_other));
- $catalog .= ":F" if ((!$backup_other_versions) && (@list_other));
- $catalog .= "\n";
-
- open(CATALOG, ">> $cfg_dir/drakbackup_catalog") || show_warning("w", __("Can't create catalog!"));
- print(CATALOG $catalog);
- close(CATALOG);
- }
-
- #- clean up HD files if del_hd_files and media isn't hd
- if (($del_hd_files) && (($where_cd) || ($where_tape) || ($where_net)) && ($daemon_media ne 'hd')) {
- foreach (@file_list_to_send_by_ftp) {
-# unlink($_) if ((/$tar_ext$/) && (!/backup_base/));
- unlink($_) if (/$tar_ext$/);
- }
- }
-
- #- if we had a media problem then get rid of the text log of the backed up files too
- if ($media_problem) {
- system("rm $save_path/list\*$the_time.txt");
- }
-
- $interactive and cursor_norm();
- $interactive and show_status();
-}
-
-my @list_of_rpm_to_install;
-sub require_rpm {
- my $all_rpms_found = 1;
- my $res;
- my @file_cache = cat_("/var/log/rpmpkgs");
- @list_of_rpm_to_install = ();
-#- reverted to old method - /var/log/rpmpkgs is not always accurate
-# my($pkg) = @_;
- foreach my $pkg (@_) {
-# $res = grep /$pkg/, @file_cache;
- $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 = '';
- if ($where_net) {
- $extra_pkg = 'rsync' if ($net_proto eq 'rsync');
- $extra_pkg = 'sitecopy wget' if ($net_proto eq 'webdav');
- $extra_pkg = 'perl-Expect' if (($net_proto eq 'ssh') && ($use_expect));
- }
- $extra_pkg = 'mt-st' if ($where_tape);
- if ($extra_pkg ne '') {
- if (require_rpm($extra_pkg)) {
- return(0);
- } else {
- #- this isn't entirely good, but it's the only way we get here currently
- #- was getting strange return behavior before
- #- still a problem, we can also get here from the cron screen
- install_rpm(\&advanced_where);
- return(1);
- }
- }
-}
-
-sub cursor_wait {
- # turn the cursor to a watch
- $window1->window->set_cursor(new Gtk::Gdk::Cursor(150));
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-sub cursor_norm {
- # restore normal cursor
- $window1->window->set_cursor(new Gtk::Gdk::Cursor(68));
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-sub show_status {
- #- just a generic routine to display an array of text in the GUI screen
-
- my $text = new Gtk::Text(undef, undef);
-
- $table->destroy();
-
- gtkpack($advanced_box,
- $table = gtkpack_(new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::HBox(0,0),
- 1, gtktext_insert(gtkset_editable($text, 0), $results),
- 0, new Gtk::VScrollbar($text->vadj),
- ),
- ),
- );
- $central_widget = \$table;
- $table->show_all();
-}
-
-sub list_remove {
- my($widget, $list) = @_;
- my @to_remove;
- push @to_remove, $list->child_position($_) foreach ($list->selection);
- splice @list_other, $_, 1 foreach (reverse sort @to_remove);
- $list->remove_items($list->selection);
-}
-
-sub file_ok_sel {
- my ($widget, $file_selection) = @_;
- my $file_name = $file_selection->get_filename();
- if (!member($file_name, @list_other)) {
- push(@list_other, $file_name);
- $list_other->add(gtkshow(new Gtk::ListItem($file_name)));
- }
-}
-
-sub filedialog_where_hd {
- my $file_dialog;
-
- $file_dialog = gtksignal_connect(new Gtk::FileSelection(_("File Selection")), destroy => sub { $file_dialog->destroy() } );
- $file_dialog->ok_button->signal_connect(clicked => sub {
- $save_path_entry->set_text($file_dialog->get_filename());
- $file_dialog->destroy() });
- $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy() });
- $file_dialog->show();
-}
-
-sub filedialog_restore_find_path {
- my $file_dialog;
-
- $file_dialog = gtksignal_connect(new Gtk::FileSelection(_("File Selection")), destroy => sub { $file_dialog->destroy() } );
- $file_dialog->ok_button->signal_connect(clicked => sub {
- $restore_find_path_entry->set_text($file_dialog->get_filename());
- $file_dialog->destroy() });
- $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy() });
- $file_dialog->show();
-}
-
-sub filedialog_generic {
- #- a more generic file dialog, expect a flag for fileops visible or not
- #- a title prompt, the widget to get updated and the variable to update
- my ($fileops, $prompt, $widget, $set_var) = @_;
- my $file_dialog;
-
- $file_dialog = gtksignal_connect(new Gtk::FileSelection(_("%s",$prompt)), destroy => sub { $file_dialog->destroy() } );
- $file_dialog->ok_button->signal_connect(clicked => sub {
- ${$set_var} = ($file_dialog->get_filename());
- ${$widget}->set_text(${$set_var});
- $file_dialog->destroy()
- });
- $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy() });
- $file_dialog->hide_fileop_buttons() if (!$fileops);
- $file_dialog->show();
-}
-
-sub filedialog {
- my $file_dialog;
-
- $file_dialog = gtksignal_connect(new Gtk::FileSelection(_("File Selection")), destroy => sub { $file_dialog->destroy() } );
- $file_dialog->ok_button->signal_connect(clicked => \&file_ok_sel, $file_dialog);
- $file_dialog->ok_button->child->set(_("Add"));
- $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy() });
- $file_dialog->cancel_button->child->set(_("Close"));
- $file_dialog->set_filename(_("Select the files or directories and click on 'Add'"));
- $file_dialog->show();
-}
-
-################################################ ADVANCED ################################################
-
-sub check_list {
- foreach (@_) {
- my $ref = $_->[1];
- gtksignal_connect(gtkset_active($_->[0], ${$ref}), toggled => sub {
- invbool $ref;
- ${$central_widget}->destroy();
- $current_widget->();
- });
- }
-}
-
-sub fonction_env {
- ($central_widget, $current_widget, $previous_widget, $custom_help, $next_widget) = @_;
-}
-
-# sub redraw_during_check {
-# my ($tmp1, $tmp2) = @_;
-# gtksignal_connect(gtkset_active($tmp1, $tmp2), toggled => sub {
-# # invbool \$tmp2;
-# print "tmp2 bef = $tmp2\n";
-# $tmp2 = $tmp2 ? 0 : 1;
-# ${$central_widget}->destroy();
-# print "tmp2 after = $tmp2\n";
-# $current_widget->();
-# return ($tmp2);
-# });
-# }
-
-sub advanced_what_sys {
- my $box_what_sys;
-
- gtkpack($advanced_box,
- $box_what_sys = gtkpack_(new Gtk::VBox(0, 15),
- 1, _("\nPlease check all options that you need.\n"),
- 1, _("These options can backup and restore all files in your /etc directory.\n"),
- 0, my $check_what_sys = new Gtk::CheckButton(_("Backup your System files. (/etc directory)")),
- 0, my $check_what_versions = new Gtk::CheckButton(_("Use incremental backup (do not replace old backups)")),
- 0, my $check_what_critical = new Gtk::CheckButton(_("Do not include critical files (passwd, group, fstab)")),
- 0, _("With this option you will be able to restore any version\n of your /etc directory."),
- 1, new Gtk::VBox(0, 15),
- ),
- );
- check_list([$check_what_sys, \$backup_sys], [$check_what_critical, \$no_critical_sys], [$check_what_versions, \$backup_sys_versions]);
- fonction_env(\$box_what_sys, \&advanced_what_sys, \&advanced_what, "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_(new Gtk::VBox(0, 15),
- 0, _("Please check all users that you want to include in your backup."),
- 0, new Gtk::HSeparator,
- 1, createScrolledWindow(
- gtkpack__(new Gtk::VBox(0,0),
- map { my $name = $_;
- my @user_list_tmp;
- my $b = new Gtk::CheckButton($name);
- if (grep /^$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 } (@all_user_list)
- ),
- ),
- 0, my $check_what_browser = new Gtk::CheckButton(_("Do not include the browser cache")),
- 0, my $check_what_user_versions = new Gtk::CheckButton(_("Use Incremental Backups (do not replace old backups)")),
- ),
- );
- check_list([$check_what_browser, \$what_no_browser], [$check_what_user_versions, \$backup_user_versions]);
- if ($previous_function) { fonction_env(\$box_what_user, \&advanced_what_user, \&$previous_function, "what", \&$previous_function) }
- else { fonction_env(\$box_what_user, \&advanced_what_user, \&advanced_what, "what") }
- $up_box->show_all();
-}
-
-sub advanced_what_other {
- my $box_what_other;
- $list_other = new Gtk::List();
- $list_other->set_selection_mode(-extended);
- $list_other->add(gtkshow(new Gtk::ListItem($_))) foreach (@list_other);
-
- gtkpack($advanced_box,
- $box_what_other = gtkpack_(new Gtk::VBox(0, 15),
- 1, gtkpack_(new Gtk::HBox(0,4),
- 1, createScrolledWindow($list_other),
- ),
- 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread),
- gtksignal_connect(new Gtk::Button(_("Add")), clicked => sub { filedialog() }),
- gtksignal_connect(new Gtk::Button(_("Remove Selected")), clicked => \&list_remove, $list_other),
- ),
- 0, gtkset_sensitive(my $check_what_other_versions = new Gtk::CheckButton(_("Use Incremental Backups (do not replace old backups)") ), 0),
- ),
- );
- check_list([$check_what_other_versions, \$backup_other_versions]);
- fonction_env(\$box_what_other, \&advanced_what_other, \&advanced_what, "what");
- $up_box->show_all();
-}
-
-sub advanced_what_entire_sys{
- my $box_what;
-
- my ($pix_user_map, $pix_user_mask) = gtkcreate_png("user");
- my ($pix_other_map, $pix_other_mask) = gtkcreate_png("net_u");
- my ($pix_sys_map, $pix_sys_mask) = gtkcreate_png("bootloader");
-
- gtkpack($advanced_box,
- $box_what = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtksignal_connect(my $button_what_other = new Gtk::Button(),
- clicked => sub { ${$central_widget}->destroy(); message_underdevel() }),
- 1, gtksignal_connect(my $button_what_all = new Gtk::Button(),
- clicked => sub { ${$central_widget}->destroy(); message_underdevel() }),
- 1, new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- $button_what_other->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_sys_map, $pix_sys_mask),
- new Gtk::Label(_("Linux")),
- new Gtk::HBox(0, 5)
- ));
- $button_what_all->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_user_map, $pix_user_mask),
- new Gtk::Label(_("Windows (FAT32)")),
- new Gtk::HBox(0, 5)
- ));
- fonction_env(\$box_what, \&advanced_what_entire_sys, \&advanced_what, "");
- $up_box->show_all();
-}
-
-sub advanced_what{
- my $box_what;
- my ($pix_user_map, $pix_user_mask) = gtkcreate_png("ic82-users-40");
- my ($pix_other_map, $pix_other_mask) = gtkcreate_png("ic82-others-40");
- my ($pix_sys_map, $pix_sys_mask) = gtkcreate_png("ic82-system-40");
- my ($pix_sysp_map, $pix_sysp_mask) = gtkcreate_png("ic82-systemeplus-40");
-
- gtkpack($advanced_box,
- $box_what = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtksignal_connect(my $button_what_sys = new Gtk::Button(),
- clicked => sub { $box_what->destroy(); advanced_what_sys() }),
- 1, gtksignal_connect(my $button_what_user = new Gtk::Button(),
- clicked => sub { ${$central_widget}->destroy(); advanced_what_user() }),
- 1, gtksignal_connect(my $button_what_other = new Gtk::Button(),
- clicked => sub { ${$central_widget}->destroy(); advanced_what_other() }),
-# 1, gtksignal_connect(my $button_what_all = new Gtk::Button(),
-# clicked => sub { ${$central_widget}->destroy(); advanced_what_entire_sys(); }),
- 1, new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- $button_what_sys->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_sys_map, $pix_sys_mask),
- new Gtk::Label(_("System")),
- new Gtk::HBox(0, 5)
- ));
- $button_what_user->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_user_map, $pix_user_mask),
- new Gtk::Label(_("Users")),
- new Gtk::HBox(0, 5)
- ));
- $button_what_other->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_other_map, $pix_other_mask),
- new Gtk::Label(_("Other")),
- new Gtk::HBox(0, 5)
- ));
-# $button_what_all->add(gtkpack(new Gtk::HBox(0,10),
-# new Gtk::Pixmap($pix_sysp_map, $pix_sysp_mask),
-# new Gtk::Label(_("An Entire System")),
-# new Gtk::HBox(0, 5)
-# ));
-
- 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_(new Gtk::VBox(0, 10),
- 0, new Gtk::HSeparator,
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, my $check_where_use_net = new Gtk::CheckButton(_("Use network connection to backup") ),
- 1, new Gtk::HBox(0,10),
- 0, new Gtk::Label("Net Method:"),
- 0, gtkset_sensitive(my $entry_net_type = new Gtk::Combo(), $where_net),
- ),
- 0, gtkpack_(new Gtk::HBox(0,5),
- 0, gtkset_sensitive(my $check_use_expect = new Gtk::CheckButton(_("Use Expect for SSH")), ($where_net && ($net_proto eq 'ssh'))),
- 0, gtkset_sensitive(my $check_xfer_keys = new Gtk::CheckButton(_("Create/Transfer\nbackup keys for SSH")), ($where_net && ($net_proto eq 'ssh'))),
- 0, gtkset_sensitive(my $button_xfer_keys = new Gtk::Button(_(" Transfer \nNow")), $xfer_keys),
- 0, gtkset_sensitive(my $check_user_keys = new Gtk::CheckButton(_("Keys in place already")), ($where_net && ($net_proto eq 'ssh'))),
- ),
- 0, new Gtk::HSeparator,
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the host name or IP.")), $where_net),
- 1, new Gtk::HBox(0,10),
- 0, gtkset_sensitive(my $host_name_entry = new Gtk::Entry(), $where_net),
- ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the directory (or module) to\n put the backup on this host.")), $where_net),
- 1, new Gtk::HBox(0,10),
- 0, gtkset_sensitive(my $host_path_entry = new Gtk::Entry(), $where_net),
- ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter your login")), $where_net),
- 1, new Gtk::HBox(0,10),
- 0, gtkset_sensitive(my $login_user_entry = new Gtk::Entry(), $where_net),
- ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter your password")), $where_net),
- 1, new Gtk::HBox(0,10),
- 0, gtkset_sensitive(my $passwd_user_entry = new Gtk::Entry(), $where_net),
- ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 1, new Gtk::HBox(0,10),
- 0, gtkset_sensitive(my $check_remember_pass = new Gtk::CheckButton(_("Remember this password")), $where_net),
- ),
- ),
- );
- $entry_net_type->set_popdown_strings(@net_methods);
- $entry_net_type->entry->set_text($net_proto);
- $entry_net_type->entry->editable(0);
- $button_xfer_keys->signal_connect('clicked', sub {
- if (($passwd_user ne '') && ($login_user ne '') && ($host_name ne '')) {
- do_expect("sendkey", $backup_key);
- } else {
- $in->ask_warn('',_("Need hostname, username and password!"));
- }
- });
- $passwd_user_entry->set_visibility(0);
- $passwd_user_entry->set_text($passwd_user);
- $passwd_user_entry->signal_connect('changed', sub { $passwd_user = $passwd_user_entry->get_text() });
- $host_path_entry->set_text($host_path);
- $host_name_entry->set_text($host_name);
- $login_user_entry->set_text($login_user);
- $host_name_entry->signal_connect('changed', sub { $host_name = $host_name_entry->get_text() });
- $host_path_entry->signal_connect('changed', sub { $host_path = $host_path_entry->get_text() });
- $login_user_entry->signal_connect('changed', sub { $login_user = $login_user_entry->get_text() });
- $entry_net_type->entry->signal_connect('changed', sub {
- $net_proto = $entry_net_type->entry->get_text();
- my $sensitive = 0;
- $sensitive = 1 if ($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, \$remember_pass]);
- gtksignal_connect(gtkset_active($check_where_use_net, $where_net), toggled => sub {
- invbool \$where_net;
- #- assure other methods disabled
- if ($where_net eq 1) {
- $where_cd = 0;
- $where_tape = 0;
- }
- $net_proto = '' if ($where_net eq 0);
- ${$central_widget}->destroy();
- $current_widget->();
- });
- gtksignal_connect(gtkset_active($check_use_expect, $use_expect), toggled => sub {
- invbool \$use_expect;
- #- assure other methods disabled
- if ($use_expect eq 1) {
- $xfer_keys = 0;
- $user_keys = 0;
- }
- ${$central_widget}->destroy();
- $current_widget->();
- });
- gtksignal_connect(gtkset_active($check_xfer_keys, $xfer_keys), toggled => sub {
- invbool \$xfer_keys;
- #- assure other methods disabled
- if ($xfer_keys eq 1) {
- $use_expect = 0;
- $user_keys = 0;
- }
- ${$central_widget}->destroy();
- $current_widget->();
- });
- gtksignal_connect(gtkset_active($check_user_keys, $user_keys), toggled => sub {
- invbool \$user_keys;
- #- assure other methods disabled
- if ($user_keys eq 1) {
- $xfer_keys = 0;
- $use_expect = 0;
- }
- ${$central_widget}->destroy();
- $current_widget->();
- });
- if ($previous_function) {
- fonction_env (\$box_where_net, \&advanced_where_net_types, \&$previous_function, "net");
- } else {
- fonction_env (\$box_where_net, \&advanced_where_net_types, \&advanced_where, "net");
- }
- $up_box->show_all();
-}
-
-sub advanced_where_cd {
- my ($previous_function) = @_;
- my $box_where_cd;
-
- get_cd_info();
-
- my $combo_where_cd_device = new Gtk::Combo();
- $combo_where_cd_device->set_popdown_strings (sort keys %cd_devices) if (keys %cd_devices);
-
- my $combo_where_cd_time = new Gtk::Combo();
- $combo_where_cd_time->set_popdown_strings ("650","700", "750", "800");
-
- my $combo_where_cdrecord_device = new Gtk::Combo();
- my @dev_codes;
- my $key;
-
- foreach $key (keys %cd_devices) {
- push(@dev_codes, $cd_devices{$key}{rec_dev});
- }
-
- $combo_where_cdrecord_device->set_popdown_strings (@dev_codes) if (keys %cd_devices);
-
- gtkpack($advanced_box,
- $box_where_cd = gtkpack_(new Gtk::VBox(0, 6),
- 0, my $check_where_cd = new Gtk::CheckButton(_("Use CD/DVDROM to backup")),
- 0, new Gtk::HSeparator,
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please choose your CD/DVD device\n(Press Enter to propogate settings to other fields.\nThis field isn't necessary, only a tool to fill in the form.)")), $where_cd),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(gtkset_usize ($combo_where_cd_device, 200, 20), $where_cd),
- ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please choose your CD/DVD media size")), $where_cd),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(gtkset_usize ($combo_where_cd_time, 200, 20), $where_cd),
- ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please check for multisession CD")), $where_cd),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(my $check_multisession = new Gtk::CheckButton(), $where_cd),
- ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please check if you are using CDRW media")), $where_cd),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(my $check_cdrw = new Gtk::CheckButton(), $where_cd),
- ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please check if you want to erase your RW media (1st Session)")), $cdrw && $where_cd),
- 0, gtkset_sensitive(my $button_erase_now = new Gtk::Button(_(" Erase Now ")), $cdrw),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(my $check_cdrw_erase = new Gtk::CheckButton(), $cdrw && $where_cd),
- ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please check if you are using a DVDR device")), $where_cd),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(my $check_dvdr = new Gtk::CheckButton(), $where_cd),
- ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please check if you are using a DVDRAM device")), $where_cd),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(my $check_dvdram = new Gtk::CheckButton(), $where_cd),
- ),
-# don't know what this is about - hold off for now (SB)
-# 0, new Gtk::VBox(0, 5),
-# 0, gtkpack_(new Gtk::HBox(0,10),
-# 0, gtkset_sensitive(new Gtk::Label(_("Please check if you want to include\n install boot on your CD.")), $where_cd),
-# 1, new Gtk::VBox(0, 5),
-# 0, gtkset_sensitive(my $check_cd_with_install_boot = new Gtk::CheckButton(), $where_cd),
-# ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter your CD Writer device name\n ex: 0,1,0")), $where_cd),
- 1, new Gtk::VBox(0, 5),
-# 0, gtkset_usize (gtkset_sensitive($cd_device_entry = new Gtk::Entry(), $where_cd), 200, 20),
- 0, gtkset_sensitive(gtkset_usize ($combo_where_cdrecord_device, 200, 20), $where_cd),
- ),
- ),
- );
-
-# foreach ([$check_cdrw_erase, \$media_erase], [$check_cd_with_install_boot, \$cd_with_install_boot ]) {
- foreach ([$check_cdrw_erase, \$media_erase], [$check_dvdr, \$dvdr], [$check_dvdram, \$dvdram], [$check_multisession, \$multi_session]) {
- my $ref = $_->[1];
- gtksignal_connect(gtkset_active($_->[0], ${$ref}), toggled => sub { ${$ref} = ${$ref} ? 0 : 1 })
- }
- gtksignal_connect(gtkset_active($check_where_cd, $where_cd), toggled => sub {
- $where_cd = $where_cd ? 0 : 1;
- #- toggle where_net, where_tape off
- if ($where_cd eq 1) {
- $where_net = 0;
- $where_tape = 0;
- }
- ${$central_widget}->destroy();
- $current_widget->();
- });
- gtksignal_connect(gtkset_active($check_cdrw, $cdrw), toggled => sub {
- $cdrw = $cdrw ? 0 : 1;
- $check_cdrw_erase->set_sensitive($cdrw);
- ${$central_widget}->destroy();
- $current_widget->();
- });
- $button_erase_now->signal_connect('clicked', sub {
- if ($cd_device ne '') {
- erase_cdrw();
- } else {
- $in->ask_warn('',_("No CD device defined!"));
- }
- });
- $combo_where_cdrecord_device->entry->set_text($cd_device);
- $combo_where_cdrecord_device->entry->signal_connect('changed', sub { $cd_device = $combo_where_cdrecord_device->entry->get_text() });
-
- $combo_where_cd_time->entry->set_text($cd_time);
- $combo_where_cd_time->entry->signal_connect('changed', sub { $cd_time = $combo_where_cd_time->entry->get_text() });
-
- #- this one drives changes in the other entries
- #- still not getting quite the desired behavior, but combo box signals seem to be limited
- #- tried to trigger from the selection, but it either does nothing or crashes!
-
-#- $combo_where_cd_device->entry->set_text($std_device);
- $combo_where_cd_device->entry->signal_connect('activate', sub {
- $std_device = $combo_where_cd_device->entry->get_text();
- $combo_where_cdrecord_device->entry->set_text($cd_devices{$std_device}{rec_dev});
- $check_dvdr->set_active($cd_devices{$std_device}{dvdr});
- $check_dvdram->set_active($cd_devices{$std_device}{dvdram});
- #- do this one last or the widget destory mucks up the others
- $check_cdrw->set_active($cd_devices{$std_device}{cdrw});
- });
-
- if ($previous_function) {
- fonction_env(\$box_where_cd, \&advanced_where_cd, \&$previous_function, "");
- } 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 = new Gtk::Combo();
- $combo_where_tape_device->set_popdown_strings (@tape_devices) if (@tape_devices);
-
- my $box_where_tape;
- my $button;
- my $adj = new Gtk::Adjustment 550.0, 1.0, 10000.0, 1.0, 5.0, 0.0;
- #my ($pix_fs_map, $pix_fs_mask) = gtkcreate_png("filedialog");
-
- gtkpack($advanced_box,
- $box_where_tape = gtkpack_(new Gtk::VBox(0, 6),
- 0, new Gtk::HSeparator,
- 0, my $check_where_tape = new Gtk::CheckButton(_("Use tape to backup") ),
- 0, new Gtk::HSeparator,
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the device name to use for backup")), $where_tape),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_sensitive(gtkset_usize ($combo_where_tape_device, 200, 20), $where_tape),
- ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please check if you want to use the non-rewinding device.")), $where_tape),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(my $check_tape_rewind = new Gtk::CheckButton(), $where_tape),
- ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please check if you want to erase your tape before the backup.")), $where_tape),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(my $check_tape_erase = new Gtk::CheckButton(), $where_tape),
- ),
- 0, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please check if you want to eject your tape after the backup.")), $where_tape),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(my $check_tape_eject = new Gtk::CheckButton(), $where_tape),
- ),
- 0, new Gtk::VBox(0, 6),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the maximum size\n allowed for Drakbackup")), $where_tape),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_usize (gtkset_sensitive(my $spinner = new Gtk::SpinButton($adj, 0, 0), $where_tape), 200, 20),
- ),
- 0, gtkpack_(new Gtk::HBox(0,10),),
- ),
- );
- gtksignal_connect(gtkset_active($check_where_tape, $where_tape), toggled => sub {
- $where_tape = $where_tape ? 0 : 1;
- #- assure other methods are off
- if ($where_tape eq 1) {
- $where_net = 0;
- $where_cd = 0;
- }
- ${$central_widget}->destroy();
- $current_widget->();
- });
- gtksignal_connect(gtkset_active($check_tape_rewind, $tape_norewind), toggled => sub {
- $tape_norewind = $tape_norewind ? 0 : 1;
- $_ = $tape_device;
- if ($tape_norewind) {
- $tape_device =~ s/\/st/\/nst/;
- } else {
- $tape_device =~ s/\/nst/\/st/;
- }
- $combo_where_tape_device->entry->set_text($tape_device);
- ${$central_widget}->destroy();
- $current_widget->();
-
- });
- gtksignal_connect(gtkset_active($check_tape_erase, $media_erase), toggled => sub {
- $media_erase = $media_erase ? 0 : 1;
- ${$central_widget}->destroy();
- $current_widget->();
- });
- gtksignal_connect(gtkset_active($check_tape_eject, $media_eject), toggled => sub {
- $media_eject = $media_eject ? 0 : 1;
- ${$central_widget}->destroy();
- $current_widget->();
- });
- $combo_where_tape_device->entry->set_text($tape_device);
- $combo_where_tape_device->entry->signal_connect('changed', sub {
- $tape_device = $combo_where_tape_device->entry->get_text();
- });
- if ($previous_function) {
- fonction_env(\$box_where_tape, \&advanced_where_tape, \&$previous_function, "");
- } 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;
- my $adj = new Gtk::Adjustment 550.0, 1.0, 10000.0, 1.0, 5.0, 0.0;
- my ($pix_fs_map, $pix_fs_mask) = gtkcreate_png("ic82-dossier-32");
-
- gtkpack($advanced_box,
- $box_where_hd = gtkpack_(new Gtk::VBox(0, 6),
- 0, new Gtk::HSeparator,
-# 0, my $check_where_hd = new Gtk::CheckButton( _("Use Hard Disk to backup") ),
-# 0, new Gtk::HSeparator,
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the directory to save to:")), $where_hd),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_usize (gtkset_sensitive($save_path_entry = new Gtk::Entry(), $where_hd), 152, 20),
- 0, gtkset_sensitive($button = gtksignal_connect(new Gtk::Button(), clicked => sub {
- filedialog_where_hd()
- }), $where_hd),
- ),
- 0, new Gtk::VBox(0, 6),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the maximum size\n allowed for Drakbackup")), $where_hd),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_usize (gtkset_sensitive(my $spinner = new Gtk::SpinButton($adj, 0, 0), $where_hd), 200, 20),
- ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_sensitive(my $check_where_hd_quota = new Gtk::CheckButton(_("Use quota for backup files.")), $where_hd),
- 0, new Gtk::VBox(0, 6),
- ),
- ),
- );
- foreach ([$check_where_hd_quota, \$hd_quota]) {
- my $ref = $_->[1];
- gtksignal_connect(gtkset_active($_->[0], ${$ref}), toggled => sub { ${$ref} = ${$ref} ? 0 : 1 })
- }
-# gtksignal_connect(gtkset_active($check_where_hd, $where_hd), toggled => sub {
-# $where_hd = $where_hd ? 0 : 1;
-# $where_hd = 1;
-# ${$central_widget}->destroy();
-# $current_widget->();
-# });
- $button->add(gtkpack(new Gtk::HBox(0,10), new Gtk::Pixmap($pix_fs_map, $pix_fs_mask)));
- $save_path_entry->set_text($save_path);
- $save_path_entry->signal_connect('changed', sub { $save_path = $save_path_entry->get_text() });
- if ($previous_function) {
- fonction_env(\$box_where_hd, \&advanced_where_hd, \&$previous_function, "");
- } else {
- fonction_env(\$box_where_hd, \&advanced_where_hd, \&advanced_where, "");
- }
- $up_box->show_all();
-}
-
-sub advanced_where{
- my $box_where;
- my ($pix_net_map, $pix_net_mask) = gtkcreate_png("ic82-network-40");
- my ($pix_cd_map, $pix_cd_mask) = gtkcreate_png("ic82-CD-40");
- my ($pix_hd_map, $pix_hd_mask) = gtkcreate_png("ic82-discdurwhat-40");
- my ($pix_tape_map, $pix_tape_mask) = gtkcreate_png("ic82-tape-40");
-
- gtkpack($advanced_box,
- $box_where = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtksignal_connect(my $button_where_net = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy();
- advanced_where_net_types();
- }),
- 1, gtksignal_connect(my $button_where_cd = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy();
- if (require_rpm("mkisofs", "cdrecord")) {
- advanced_where_cd();
- } else {
- ${$central_widget}->destroy();
- install_rpm(\&advanced_where);
- }
- }),
- 1, gtksignal_connect(my $button_where_hd = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy();
- advanced_where_hd();
- }),
- 1, gtksignal_connect(my $button_where_tape = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy();
- # message_underdevel();
- advanced_where_tape() }),
- 1, new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- $button_where_net->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_net_map, $pix_net_mask),
- new Gtk::Label(_("Network")),
- new Gtk::HBox(0, 5)
- ));
- $button_where_cd->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_cd_map, $pix_cd_mask),
- new Gtk::Label(_("CDROM / DVDROM")),
- new Gtk::HBox(0, 5)
- ));
- $button_where_hd->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_hd_map, $pix_hd_mask),
- new Gtk::Label(_("HardDrive / NFS")),
- new Gtk::HBox(0, 5)
- ));
- $button_where_tape->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_tape_map, $pix_tape_mask),
- new Gtk::Label(_("Tape")),
- new Gtk::HBox(0, 5)
- ));
- fonction_env(\$box_where, \&advanced_where, \&advanced_box, "");
- $up_box->show_all();
-}
-
-#- 7/7/2002 - S.Benedict reworked when - drop all the checkboxes and use a list
-#- chances that we want to do backups via multiple medias in cron are slim
-sub advanced_when{
- my $box_when;
-# $daemon_media = '';
- my ($pix_time_map, $pix_time_mask) = gtkcreate_png("ic82-when-40");
- my $combo_when_space = new Gtk::Combo();
- my %trans = (_("hourly") => 'hourly',
- _("daily") => 'daily',
- _("weekly") => 'weekly',
- _("monthly") => 'monthly');
- my %trans2 = ('hourly' => _("hourly"),
- 'daily' => _("daily"),
- 'weekly' => _("weekly"),
- 'monthly' => _("monthly"));
- $combo_when_space->set_popdown_strings (_("hourly"),_("daily"),_("weekly"),_("monthly"));
-
- #- drop down list of possible medias - default to config value
- my $entry_media_type = new Gtk::Combo();
- $entry_media_type->set_popdown_strings(@media_types, @net_methods);
-# $entry_media_type->set_value_in_list(1, 0);
- $entry_media_type->entry->set_text($daemon_media);
-
- gtkpack($advanced_box,
- $box_when = gtkpack_(new Gtk::VBox(0, 15),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 1, new Gtk::HBox(0,10),
- 1, new Gtk::Pixmap($pix_time_map, $pix_time_mask),
- 0, my $check_when_daemon = new Gtk::CheckButton(_("Use daemon") ),
- 1, new Gtk::HBox(0,10),
- ),
- 0, new Gtk::HSeparator,
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please choose the time \ninterval between each backup")), $backup_daemon),
- 1, new Gtk::HBox(0,10),
- 0, gtkset_sensitive($combo_when_space, $backup_daemon),
- ),
- 0, new Gtk::HBox(0,10),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please choose the\nmedia for backup.")), $backup_daemon),
- 1, new Gtk::HBox(0,10),
- 0, gtkpack_(new Gtk::VBox(0,10),
- 0, gtkset_sensitive($entry_media_type, $backup_daemon),
- ),
- ),
- 0, new Gtk::HSeparator,
- 1, gtkset_sensitive(new Gtk::Label(_("Please be sure that the cron daemon is included in your services.
-\nNote that currently all 'net' medias also use the hard drive.")), $backup_daemon),
- ),
- );
-
- gtksignal_connect(gtkset_active($check_when_daemon, $backup_daemon), toggled => sub {
- $backup_daemon = $backup_daemon ? 0 : 1;
- ${$central_widget}->destroy();
- advanced_when();
- });
- $combo_when_space->entry->set_text($trans2{$when_space});
- $combo_when_space->entry->signal_connect('changed', sub { $when_space = $trans{$combo_when_space->entry->get_text()} });
- $entry_media_type->entry->signal_connect('changed', sub {
- $daemon_media = $entry_media_type->entry->get_text();
- });
- fonction_env(\$box_when, \&advanced_when, \&advanced_box, "");
- $up_box->show_all();
-}
-
-sub advanced_options{
- my $box_options;
- my ($pix_options_map, $pix_options_mask) = gtkcreate_png("ic82-moreoption-40");
-
- gtkpack($advanced_box,
- $box_options = gtkpack_(new Gtk::VBox(0, 15),
-# 0, gtkpack_(new Gtk::HBox(0,10),
-# 1, new Gtk::VBox(0,10),
-# 1, new Gtk::Pixmap($pix_options_map, $pix_options_mask),
-# 1, _("Please choose correct options to backup."),
-# 1, new Gtk::VBox(0,10),
-# ),
-# 0, new Gtk::HSeparator,
-# 0, gtkpack_(new Gtk::VBox(0,10),
-# 0, gtkset_sensitive(my $check_tar_bz2 = new Gtk::CheckButton( _("Use Tar and bzip2 (very slow) [Please be careful if you\n (un)select this option, as all your old backups will be deleted.]") ), 0),
-# 0, gtkset_sensitive(my $check_backupignore = new Gtk::CheckButton( _("Use .backupignore files")), 0),
- 0, new Gtk::VBox(0,10),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, my $check_mail = new Gtk::CheckButton(_("Send mail report after each backup to:")),
- 1, new Gtk::HBox(0,10),
- 0, my $mail_entry = new Gtk::Entry(),
- ),
-# ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, my $check_del_hd_files = new Gtk::CheckButton(_("Delete Hard Drive tar files after backup to other media.")),
- ),
- ),
- );
- check_list([$check_mail, \$send_mail], [$check_del_hd_files, \$del_hd_files]);
-# check_list([$check_mail, \$send_mail], [$check_tar_bz2, \$comp_mode], [$check_backupignore, \$backupignore]);
- $mail_entry->set_text($user_mail);
- $mail_entry->signal_connect('changed', sub { $user_mail = $mail_entry->get_text() });
- fonction_env(\$box_options, \&advanced_options, \&advanced_box, "options");
- $up_box->show_all();
-}
-
-sub advanced_box{
- my $box_adv;
- my ($pix_hd_map, $pix_hd_mask) = gtkcreate_png("ic82-discdurwhat-40");
- my ($pix_time_map, $pix_time_mask) = gtkcreate_png("ic82-when-40");
- my ($pix_net_map, $pix_net_mask) = gtkcreate_png("ic82-where-40");
- my ($pix_options_map, $pix_options_mask) = gtkcreate_png("ic82-moreoption-40");
-
- gtkpack($advanced_box,
- $box_adv = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtksignal_connect(my $button_what = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy(); advanced_what() }),
- 1, gtksignal_connect(my $button_where = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy(); advanced_where() }),
- 1, gtksignal_connect(my $button_when = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy(); advanced_when() }),
- 1, gtksignal_connect(my $button_options = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy(); advanced_options() }),
- 1, new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- $button_what->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_hd_map, $pix_hd_mask),
- new Gtk::Label(_("What")),
- new Gtk::HBox(0, 5)
- ));
- $button_where->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_net_map, $pix_net_mask),
- new Gtk::Label(_("Where")),
- new Gtk::HBox(0, 5)
- ));
- $button_when->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_time_map, $pix_time_mask),
- new Gtk::Label(_("When")),
- new Gtk::HBox(0, 5)
- ));
- $button_options->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_options_map, $pix_options_mask),
- new Gtk::Label(_("More Options")),
- new Gtk::HBox(0, 5)
- ));
- fonction_env(\$box_adv, \&advanced_box, \&interactive_mode_box, "");
- $up_box->show_all();
-}
-
-################################################ WIZARD ################################################
-
-sub wizard_step3 {
- my $box2;
- my $text = new Gtk::Text(undef, undef);
- system_state();
- gtktext_insert($text, $system_state);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, gtkpack_(new Gtk::VBox(0,10),
- 0, _("Drakbackup Configuration"),
- 1, createScrolledWindow($text),
- ),
- ),
- );
- fonction_env(\$box2, \&wizard_step3, \&wizard_step2, "");
- button_box_wizard_end();
- $up_box->show_all();
-}
-
-sub wizard_step2 {
- my $box2;
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 0, _("Please choose where you want to backup"),
- 0, gtkpack_(new Gtk::HBox(0, 15),
- 0, my $check_wizard_hd = new Gtk::CheckButton(_("on Hard Drive")),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("Configure")), clicked => sub {
- ${$central_widget}->destroy();
- to_ok();
- advanced_where_hd(\&wizard_step2);
- to_normal();
- }), $where_hd),
- ),
- 0, gtkpack_(new Gtk::HBox(0, 15),
- 0, my $check_wizard_net = new Gtk::CheckButton(_("across Network")),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("Configure")), clicked => sub {
- ${$central_widget}->destroy();
- to_ok();
- advanced_where_net_types(\&wizard_step2);
- to_normal();
- }), $where_net),
- ),
- 0, gtkpack_(new Gtk::HBox(0, 15),
- 0, my $check_wizard_cd = new Gtk::CheckButton(_("on CDROM")),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("Configure")), clicked => sub {
- ${$central_widget}->destroy();
- advanced_where_cd(\&wizard_step2);
- }), $where_cd),
- ),
- 0, gtkpack_(new Gtk::HBox(0, 15),
- 0, my $check_wizard_tape = new Gtk::CheckButton(_("on Tape Device")),
- 1, new Gtk::VBox(0, 5),
- 0, gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("Configure")), clicked => sub {
- ${$central_widget}->destroy();
- advanced_where_tape(\&wizard_step2);
- }), $where_tape),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- foreach ([$check_wizard_hd, \$where_hd],
- [$check_wizard_cd, \$where_cd],
- [$check_wizard_tape, \$where_tape],
- [$check_wizard_net, \$where_net]) {
- my $ref = $_->[1];
- gtksignal_connect(gtkset_active($_->[0], ${$ref}), toggled => sub {
- ${$ref} = ${$ref} ? 0 : 1;
- $where_hd = 1;
- if (!$where_hd && !$where_cd && !$where_net) {
- $next_widget = \&message_noselect_box
- } else {
- $next_widget = \&wizard_step3
- }
- ${$central_widget}->destroy();
- wizard_step2();
- })
- }
- if (!$where_hd && !$where_cd && !$where_net) { fonction_env(\$box2, \&wizard_step2, \&wizard, "", \&message_noselect_box) }
- else { fonction_env(\$box2, \&wizard_step2, \&wizard, "", \&wizard_step3) }
- button_box_wizard();
- $up_box->show_all();
-}
-
-sub wizard {
- my $box2;
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 0, _("Please choose what you want to backup"),
- 0, my $check_wizard_sys = new Gtk::CheckButton(_("Backup system")),
- 0, my $check_wizard_user = new Gtk::CheckButton(_("Backup Users")),
- 0, gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 0, gtksignal_connect(new Gtk::Button(_("Select user manually")), clicked => sub {
- ${$central_widget}->destroy();
- advanced_what_user(\&wizard);
- }),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- foreach ([$check_wizard_sys, \$backup_sys], [$check_wizard_user, \$backup_user]) {
- my $ref = $_->[1];
- gtksignal_connect(gtkset_active($_->[0], ${$ref}), toggled => sub {
- ${$ref} = ${$ref} ? 0 : 1;
- if ($backup_sys || $backup_user && @user_list) {
- $next_widget = \&wizard_step2
- } else {
- $next_widget = \&message_noselect_what_box }
- })
- }
- if ($backup_sys || $backup_user && @user_list) { fonction_env(\$box2, \&wizard, \&interactive_mode_box, "", \&wizard_step2) }
- else { fonction_env(\$box2, \&wizard, \&interactive_mode_box, "", \&message_noselect_what_box) }
- button_box_wizard();
- $up_box->show_all();
-}
-
-################################################ RESTORE ################################################
-
-sub find_backup_to_restore {
- my @list_backup;
- my @list_backup_tmp2;
- my $to_put;
- @sys_backuped = ();
- my @list_backup_tmp;
- my @user_backuped_tmp;
-
- @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 , $_;
- }
- if (grep /^backup_other/, @list_backup) { $other_backuped = 1 }
- if (grep /^backup_sys/, @list_backup) { $sys_backuped = 1 }
- foreach (grep /^backup_sys_/, @list_backup) {
- chomp;
- s/^backup_sys_//gi;
- s/.tar.gz$//gi;
- s/.tar.bz2$//gi;
- my ($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);
- $to_put = "$day/$month/$year $hour:$min $_";
- push @sys_backuped , $to_put;
- }
- $restore_step_sys_date = $to_put;
- foreach (grep /^backup_user_/, @list_backup) {
- chomp;
- s/^backup_user_//gi;
- s/.tar.gz$//gi;
- s/.tar.bz2$//gi;
- my ($nom, $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);
-# my $to_put = " $nom, (date: $date, hour: $heure)";
- $to_put = "$_ user: $nom, date: $day/$month/$year, hour: $hour:$min";
- push @user_backuped , $to_put;
- grep (/^$nom$/, @user_list_backuped) or push @user_list_backuped, $nom;
- }
-}
-
-sub system_state {
- $system_state = ();
-
- if ($cfg_file_exist) {
- $system_state .= _("\nBackup Sources: \n");
- $backup_sys and $system_state .= _("\n- System Files:\n");
- $backup_sys and $system_state .= "\t\t$_\n" foreach @sys_files;
- $backup_user and $system_state .= _("\n- User Files:\n");
- $backup_user and $system_state .= "\t\t$_\n" foreach @user_list;
- @list_other and $system_state .= _("\n- Other Files:\n");
- @list_other and $system_state .= "\t\t$_\n" foreach @list_other;
- $where_hd and $system_state .= _("\n- Save on Hard drive on path: %s\n", $save_path);
-
- if (($del_hd_files) && (($where_cd) || ($where_tape) || ($where_net)) && ($daemon_media ne 'hd')) {
- $system_state .= _("\n- Delete hard drive tar files after backup.\n");
- }
-
- #- tape and CDRW share some features
- my $erase_media = 'NO';
- $erase_media = 'YES' if (($media_erase) && ($where_cd || $where_tape));
- $where_cd and $system_state .= _("\n- Burn to CD");
- $where_cd and $cdrw and $system_state .= _("RW");
- $where_cd and $system_state .= _(" on device: %s", $cd_device);
- $where_cd and $multi_session and $system_state .= _(" (multi-session)");
- $where_tape and $system_state .= _("\n- Save to Tape on device: %s", $tape_device);
- (($where_cd || $where_tape) && $media_erase) and $system_state .= _("\t\tErase=%s", $erase_media);
- ($where_cd || $where_tape) and $system_state .= "\n";
-
- $where_net and $system_state .= _("\n- Save via %s on host: %s\n", $net_proto, $host_name);
- $where_net and $system_state .= _("\t\t user name: %s\n\t\t on path: %s \n", $login_user, $host_path);
- $system_state .= _("\n- Options:\n");
- $backup_sys or $system_state .= _("\tDo not include System Files\n");
-
- if ($comp_mode) {
- $system_state .= _("\tBackups use tar and bzip2\n");
- } else {
- $system_state .= _("\tBackups use tar and gzip\n");
- }
-
- $daemon_media and $system_state .= _("\n- Daemon (%s) include:\n", $when_space);
- ($daemon_media eq 'hd') and $system_state .= _("\t-Hard drive.\n");
- ($daemon_media eq 'cd') and $system_state .= _("\t-CDROM.\n");
- ($daemon_media eq 'tape') and $system_state .= _("\t-Tape \n");
- ($daemon_media eq 'ftp') and $system_state .= _("\t-Network by FTP.\n");
- ($daemon_media eq 'ssh') and $system_state .= _("\t-Network by SSH.\n");
- ($daemon_media eq 'rsync') and $system_state .= _("\t-Network by rsync.\n");
- ($daemon_media eq 'webdav') and $system_state .= _("\t-Network by webdav.\n");
- } else {
- $system_state = _("No configuration, please click Wizard or Advanced.\n");
- }
-}
-
-sub restore_state {
- my @tmp = split(' ', $restore_step_sys_date);
- $restore_state = _("List of data to restore:\n\n");
- if ($restore_sys) { $restore_state .= "- Restore System Files.\n";
- $restore_state .= " - from date: $tmp[0] $tmp[1]\n";
- }
- if ($restore_user) {
- $restore_state .= "- 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 .= "- Restore Other Files: \n";
- -f "$path_to_find_restore/list_other" and $restore_state .= "\t\t$_\n" foreach split("\n", cat_("$path_to_find_restore/list_other"));
- }
- if ($restore_other_path) {
- $restore_state .= "- Path to Restore: $restore_path \n";
- }
-}
-
-sub select_most_recent_selected_of {
- my ($user_name) = @_;
- my @list_tmp2;
- my @tmp = sort @user_list_to_restore2;
- foreach (grep /$user_name\_/, sort @tmp) { push @list_tmp2 , $_ }
- 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 = ();
-
- -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/.tar.gz//gi;
- s/.tar.bz2//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;
-
- -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 show_backup_details {
- my ($function, $mode, $name) = @_;
- my $archive_file_detail;
- my $value;
- my $fixed_font = Gtk::Gdk::Font->load("-misc-fixed-medium-r-*-*-*-100-*-*-*-*-*-*");
- my $command2;
- my $tarfile;
-
- # FIXME - only tar.gz at the moment
- my $extension = ".tar.gz";
-
- if ($mode eq "user") {
- #- we've only got a partial filename in this case
- $tarfile = "$path_to_find_restore/backup_*" . $name . $extension;
- }
- 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] . $extension;
- }
- my $command1 = "stat " . $tarfile;
- $command2 = "tar -tzvf " . $tarfile;
-
- open TMP, "$command1 2>&1 |";
- while ($value = <TMP>) {
- $archive_file_detail .= $value;
- }
- close TMP;
- $archive_file_detail .= "\n\n";
- 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 = new Gtk::Text(undef, undef);
- my $advanced_box_archive;
- $text->insert($fixed_font, undef, undef,$archive_file_detail);
- gtkpack($advanced_box,
- $advanced_box_archive = gtkpack_(new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::HBox(0,0),
- 1, $text,
- 0, new Gtk::VScrollbar($text->vadj),
- ),
- 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread),
- gtksignal_connect(new Gtk::Button(_("Done")), clicked => sub {
- ${$central_widget}->destroy();
- $function->() }),
- ),
- )
- );
- $central_widget = \$advanced_box_archive;
- $up_box->show_all();
-}
-
-sub valid_backup_test {
- my (@files_list) = @_;
- @files_corrupted = ();
- my $is_corrupted = 0;
- foreach (@files_list) {
- #- let's quiet this down (SB)
- if (system("gzip -l $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 $button_restore;
- my $text = new Gtk::Text(undef, undef);
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
- my $restore_pbs_state = _("List of data corrupted:\n\n");
- $restore_pbs_state .= "\t\t$_\n" foreach @files_corrupted ;
- $restore_pbs_state .= _("Please uncheck or remove it on next time.");
- gtktext_insert($text, $restore_pbs_state);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $do_restore = gtkpack_(new Gtk::VBox(0,10),
- 0, new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 0, new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- 0, _("Backup files are corrupted"),
- 1, new Gtk::VBox(0, 5),
- ),
- 0, new Gtk::VBox(0,10),
- 1, createScrolledWindow($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 = new Gtk::Text(undef, undef);
- gtktext_insert($text, $restore_state);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $do_restore = gtkpack_(new Gtk::VBox(0,10),
- 1, new Gtk::VBox(0,10),
- 0, _(" All of your selected data have been "),
- 0, _(" Successfuly Restored on %s ", $restore_path),
- 1, new Gtk::VBox(0,10),
- ),
- );
- button_box_build_backup_end();
- $central_widget = \$do_restore;
- $up_box->show_all();
-
-}
-
-sub return_path {
- my ($username) = @_;
- my $usr;
- my $home_dir;
- my $passwdfile = "/etc/passwd";
- open (PASSWD, $passwdfile) or exit 1;
- while (defined(my $line = <PASSWD>)) {
- chomp($line);
- ($usr,$home_dir) = (split(/:/, $line))[0,5];
- last if ($usr eq $username);
- }
- close (PASSWD);
- return $home_dir;
-}
-
-sub restore_backend {
- my $untar_cmd;
- my $exist_problem = 0;
- my $user_dir;
- my $tnom;
- my $username;
- my $theure2;
-
- if (grep /tar.gz$/, all($path_to_find_restore)) {
- $untar_cmd = 0;
- } else {
- $untar_cmd = 1;
- }
-
- 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 ($backup_user_versions) {
- ($tnom, $username, $theure2) = /^(\w+\_\w+\_user_)(.*)_(\d+\_\d+.*)$/;
- } else {
- ($tnom, $username, $theure2) = /^(\w+\_user_)(.*)_(\d+\_\d+.*)$/;
- }
-
- $user_dir = return_path($username);
- -d $user_dir and rm_rf($user_dir) if ($remove_user_before_restore) ;
-
- $DEBUG and print "user name to restore: $username, user directory: $user_dir\n";
- $untar_cmd or system(" tar xfz $path_to_find_restore/$_ -C $restore_path") ;
- $untar_cmd and system("/usr/bin/bzip2 -cd $path_to_find_restore/$_ | tar xf -C $restore_path ") ;
- }
- #- flush this out for another cycle (SB)
- @user_list_to_restore2 = ();
- }
-
- }
-
- if ($restore_sys) {
- if ($backup_sys_versions) {
- select_sys_data_to_restore();
- if (valid_backup_test(@sys_list_to_restore) == -1) {
- $exist_problem = 1;
- restore_aff_backup_problems();
- } else {
- $untar_cmd or system("tar xfz $path_to_find_restore/$_ -C $restore_path ") foreach @sys_list_to_restore;
- $untar_cmd and system("/usr/bin/bzip2 -cd $path_to_find_restore/$_ | tar xf -C $restore_path ") foreach @sys_list_to_restore;
- }
- } else {
- $untar_cmd or system("tar xfz $path_to_find_restore/backup_sys.tar.gz -C $restore_path ");
- $untar_cmd and system("/usr/bin/bzip2 -cd $path_to_find_restore/backup_sys.tar.bz2 | tar xf -C $restore_path ");
- }
- }
- if ($restore_other) {
- $untar_cmd or system("tar xfz $path_to_find_restore/backup_other.tar.gz -C $restore_path ");
- $untar_cmd and system("/usr/bin/bzip2 -cd $path_to_find_restore/backup_other.tar.bz2 | tar xf -C $restore_path ");
- }
- $exist_problem or restore_aff_result();
-}
-
-sub restore_do {
- if ($backup_bef_restore) {
- if ($restore_sys) {
- $backup_sys = 1;
- } else {
- $backup_sys = 0;
- }
- if ($restore_user) {
- $backup_user = 1;
- @user_list = @user_list_to_restore;
- } else {
- $backup_user = 0;
- }
- build_backup_status();
- read_conf_file();
- build_backup_files();
- $table->destroy();
- }
- restore_do2();
-}
-
-sub restore_do2 {
- my $do_restore;
- my $button_restore;
- my $text = new Gtk::Text(undef, undef);
- restore_state();
- gtktext_insert($text, $restore_state);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $do_restore = gtkpack_(new Gtk::VBox(0,10),
- 0, _(" Restore Configuration "),
- 1, createScrolledWindow($text),
- ),
- );
- button_box_restore_end();
- fonction_env(\$do_restore, \&restore_do2, \&restore_box, "restore");
- $up_box->show_all();
-}
-
-sub restore_step_other {
- my $retore_step_other;
- my $text = new Gtk::Text(undef, undef);
- my $other_rest = cat_("$path_to_find_restore/list_other");
- gtktext_insert($text, $other_rest);
- gtkpack($advanced_box,
- $retore_step_other = gtkpack_(new Gtk::VBox(0,10),
- 1, new Gtk::VBox(0,10),
- 1, createScrolledWindow($text),
- 0, my $check_restore_other_sure = new Gtk::CheckButton(_("OK to restore the other files.")),
- 1, new Gtk::VBox(0,10),
- ),
- );
- check_list([$check_restore_other_sure, \$restore_other]);
- fonction_env(\$retore_step_other, \&restore_step_other, \&restore_step2, "restore", \&restore_do);
- $up_box->show_all();
-}
-
-my %check_user_to_restore;
-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_(new Gtk::VBox(0,10),
- 0, new Gtk::VBox(0,10),
- 0, _("User list to restore (only the most recent date per user is important)"),
- 1, createScrolledWindow(gtkpack__(new Gtk::VBox(0,0),
- map { my $name;
- my $var2;
- my $name_complet = $_;
- $name = (split(' ',$name_complet))[0];
- my @user_list_tmp;
- my $restore_row = new Gtk::HBox(0,5);
- my $b = new Gtk::CheckButton($name_complet);
- my $details = new Gtk::Button(" Details ");
-
- $restore_row->pack_start($b, 1, 1, 0);
- $restore_row->pack_end(new Gtk::VBox(1,5), 0, 0, 0);
- $restore_row->pack_end($details, 0, 0, 0);
-
-# this doesn't work - I don't understand why - but you end up with
-# everything selected when you hit the screen a second time, after selecting one
-# if (grep $name_complet, @user_list_to_restore2) {
-# 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;
-# }
-
-# this doesn't work right either - returning to the screen only 1 is selected
-# yet several are scheduled to be restored
- 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 (!grep (/$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 {
- #- we're only passing a portion of the filename to
- #- the subroutine so we need to let it know this
- ${$central_widget}->destroy();
- show_backup_details(\&restore_step_user, "user", $name);
- });
- $restore_row } (@user_backuped)
- ),
- ),
- ),
- );
- if ($restore_other) { fonction_env(\$retore_step_user, \&restore_step_user, "", "restore", \&restore_step_other) }
- elsif ($restore_sys) { fonction_env(\$retore_step_user, \&restore_step_user, \&restore_step_sys, "restore", \&restore_step_other) }
- else{ fonction_env(\$retore_step_user, \&restore_step_user, \&restore_step2, "restore", \&restore_do) }
- $up_box->show_all();
-}
-
-sub restore_step_sys {
- my $restore_step_sys;
- my $combo_restore_step_sys = new Gtk::Combo();
- $combo_restore_step_sys->set_popdown_strings (@sys_backuped);
-
- gtkpack($advanced_box,
- $restore_step_sys = gtkpack_(new Gtk::VBox(0,10),
- 1, new Gtk::VBox(0,10),
- 0, my $check_backup_before = new Gtk::CheckButton(_("Backup the system files before:")),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 1, _("please choose the date to restore"),
- 0, $combo_restore_step_sys,
- 0, my $details = new Gtk::Button(" Details "),
- 0, new Gtk::HBox(0,10),
- ),
- 1, new Gtk::VBox(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
- my $backup_date = $combo_restore_step_sys->entry->get_text();
- ${$central_widget}->destroy();
- show_backup_details(\&restore_step_sys, "sys", $backup_date);
- });
- $combo_restore_step_sys->entry->set_text($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", \&restore_step_user) }
- elsif ($restore_other){ fonction_env(\$restore_step_sys, \&restore_step_sys, \&restore_step2, "restore", \&restore_step_other) }
- else{ fonction_env(\$restore_step_sys, \&restore_step_sys, \&restore_step2, "restore", \&restore_do) }
- $up_box->show_all();
-}
-
-sub restore_other_media_hd {
- my ($previous_function) = @_,
- my $box_where_hd;
- my $button;
- my $adj = new Gtk::Adjustment 550.0, 1.0, 10000.0, 1.0, 5.0, 0.0;
- my ($pix_fs_map, $pix_fs_mask) = gtkcreate_png("ic82-dossier-32");
-
- gtkpack($advanced_box,
- $box_where_hd = gtkpack_(new Gtk::VBox(0, 6),
- 0, new Gtk::HSeparator,
- 0, my $check_where_hd = new Gtk::CheckButton(_("Use Hard Disk to backup") ),
- 0, new Gtk::HSeparator,
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the directory to save:")), $where_hd),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_usize (gtkset_sensitive($save_path_entry = new Gtk::Entry(), $where_hd), 152, 20),
- 0, gtkset_sensitive($button = gtksignal_connect(new Gtk::Button(), clicked => sub {
- filedialog_where_hd() }), $where_hd),
- ),
- 0, new Gtk::VBox(0, 6),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the maximum size\n allowed for Drakbackup")), $where_hd),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_usize (gtkset_sensitive(my $spinner = new Gtk::SpinButton($adj, 0, 0), $where_hd), 200, 20),
- ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_sensitive(my $check_where_hd_quota = new Gtk::CheckButton(_("Use quota for backup files.")), $where_hd),
- 0, new Gtk::VBox(0, 6),
- ),
- ),
- );
- check_list([$check_where_hd_quota, \$hd_quota]);
- gtksignal_connect(gtkset_active($check_where_hd, $where_hd), toggled => sub {
- $where_hd = $where_hd ? 0 : 1;
- ${$central_widget}->destroy();
- $current_widget->();
- });
- $button->add(gtkpack(new Gtk::HBox(0,10), new Gtk::Pixmap($pix_fs_map, $pix_fs_mask)));
- $save_path_entry->set_text($save_path);
- $save_path_entry->signal_connect('changed', sub { $save_path = $save_path_entry->get_text() });
- if ($previous_function) { fonction_env(\$box_where_hd, \&advanced_where_hd, \&$previous_function, "") }
- else { fonction_env(\$box_where_hd, \&advanced_where_hd, \&advanced_where, "") }
- $up_box->show_all();
-}
-
-sub restore_find_net {
- my ($previous_function) = @_,
- my $box_where_net;
-
- gtkpack($advanced_box,
- $box_where_net = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, new Gtk::VBox(0,10),
- 1, gtksignal_connect(new Gtk::Button(_("FTP Connection")), clicked => sub {
- $box_where_net->destroy();
- if ($previous_function) {
- message_underdevel();
- } else {
- }
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Secure Connection")), clicked => sub {
- $box_where_net->destroy();
- if ($previous_function) {
- } else {
- }
- }),
- 1, new Gtk::VBox(0, 5),
- 1, new Gtk::VBox(0,10),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- if ($previous_function) { fonction_env(\$box_where_net, \&advanced_where_net, \&$previous_function, "") }
- else { fonction_env(\$box_where_net, \&advanced_where_net, \&advanced_where, "") }
- $up_box->show_all();
-}
-
-sub restore_other_media {
- my $box_find_restore;
- my $button;
- my $adj = new Gtk::Adjustment 550.0, 1.0, 10000.0, 1.0, 5.0, 0.0;
- my ($pix_fs_map, $pix_fs_mask) = gtkcreate_png("ic82-dossier-32");
-
- gtkpack($advanced_box,
- $box_find_restore = gtkpack_(new Gtk::VBox(0, 6),
- 0, new Gtk::HSeparator,
- 0, my $check_other_media_hd = new Gtk::CheckButton(_("Restore from Hard Disk.") ),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, gtkset_sensitive(new Gtk::Label(_("Please enter the directory where backups are stored")), $other_media_hd),
- 1, new Gtk::VBox(0, 6),
- 0, gtkset_usize (gtkset_sensitive($restore_find_path_entry = new Gtk::Entry(), $other_media_hd), 152, 20),
- 0, gtkset_sensitive($button = gtksignal_connect(new Gtk::Button(), clicked => sub {
- filedialog_restore_find_path();
- }), $other_media_hd),
- ),
- 1, new Gtk::VBox(0, 6),
-# 0, new Gtk::HSeparator,
-# 0, my $check_other_media_net = new Gtk::CheckButton( _("Restore from Network") ),
-# 0, new Gtk::VBox(0, 6),
-# 1, gtkpack(new Gtk::HBox(0,10),
-# new Gtk::VBox(0, 6),
-# gtkset_sensitive(gtksignal_connect(new Gtk::Button("Network"), clicked => sub {
-# ${$central_widget}->destroy();
-# restore_find_net(\&restore_other_media);}), !$other_media_hd ),
-# new Gtk::VBox(0, 6),
-# ),
-# 1, new Gtk::VBox(0, 6),
-# 0, new Gtk::HSeparator,
- 0, new Gtk::VBox(0, 6),
- ),
- );
- gtksignal_connect(gtkset_active($check_other_media_hd, $other_media_hd), toggled => sub {
- $other_media_hd = $other_media_hd ? 0 : 1;
- ${$central_widget}->destroy();
- $current_widget->();
- });
-# gtksignal_connect(gtkset_active($check_other_media_net, !$other_media_hd), toggled => sub {
-# $other_media_hd = $other_media_hd ? 0 : 1;
-# ${$central_widget}->destroy();
-# $current_widget->();
-# });
- $button->add(gtkpack(new Gtk::HBox(0,10), new Gtk::Pixmap($pix_fs_map, $pix_fs_mask)));
- $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() });
-#- not sure if this was the original intent - address the crash at "Next"
- fonction_env(\$box_find_restore, \&restore_other_media, \&restore_step2, "other_media", \&restore_do);
- $up_box->show_all();
-}
-
-sub restore_step2 {
- my $retore_step2;
- my $other_exist;
- my $sys_exist;
- my $user_exist;
-
- my $restore_info_path = $save_path;
- $restore_info_path = $path_to_find_restore if (($where_hd) || ($where_cd));
- my $info_prefix = "backup";
- $info_prefix = "list" if (($where_net) || ($where_tape));
-
- if (-f "$restore_info_path/$info_prefix\_other*") { $other_exist = 1 }
- else { my $other_exist = 0; $restore_other = 0 }
- if (grep /\_sys\_/, grep /^$info_prefix/, all("$restore_info_path/")) { $sys_exist = 1 }
- else { my $sys_exist = 0; $restore_sys = 0 }
- if (grep /\_user\_/, grep /^$info_prefix/, all("$restore_info_path/")) { $user_exist = 1 }
- else { my $user_exist = 0; $restore_user = 0 }
-
-# disabling this (sb) - very nicely wipes out your backup media if the user isn't very careful
-# cycling through the GUI turns it back on for you!!!
-# $backup_sys_versions || $backup_user_versions and $backup_bef_restore = 1;
-
- gtkpack($advanced_box,
- $retore_step2 = gtkpack_(new Gtk::VBox(0,10),
- 1, new Gtk::VBox(0,10),
- 1, new Gtk::VBox(0,10),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, my $check_restore_other_src = new Gtk::CheckButton(_("Select another media to restore from")),
- 1, new Gtk::HBox(0,10),
- 0, gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("Other Media")), clicked => sub {
- ${$central_widget}->destroy();
- restore_other_media();
- }), $restore_other_src),
- ),
- 0, gtkset_sensitive(my $check_restore_sys = new Gtk::CheckButton(_("Restore system")), $sys_exist),
- 0, gtkset_sensitive(my $check_restore_user = new Gtk::CheckButton(_("Restore Users")), $user_exist),
- 0, gtkset_sensitive(my $check_restore_other = new Gtk::CheckButton(_("Restore Other")), $other_exist),
- 0, gtkpack_(new Gtk::HBox(0,10),
- 0, my $check_restore_other_path = new Gtk::CheckButton(_("select path to restore (instead of /)")),
- 1, new Gtk::HBox(0,10),
- 0, gtkset_sensitive(my $restore_path_entry = new Gtk::Entry(), $restore_other_path),
- ),
- 0, gtkset_sensitive(my $check_backup_bef_restore = new Gtk::CheckButton(_("Do new backup before restore (only for incremental backups.)")),
- $backup_sys_versions || $backup_user_versions),
- 0, gtkset_sensitive(my $check_remove_user_dir = new Gtk::CheckButton(_("Remove user directories before restore.")), $user_exist),
- 1, new Gtk::VBox(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 && $backup_sys_versions) { $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;
- ${$central_widget}->destroy();
- $current_widget->();
- });
- gtksignal_connect(gtkset_active($check_restore_other_src, $restore_other_src), toggled => sub {
- $restore_other_src = $restore_other_src ? 0 : 1;
- ${$central_widget}->destroy();
- $current_widget->();
- });
- fonction_env(\$retore_step2, \&restore_step2, \&restore_box, "restore");
- if (!$restore_sys && !$restore_user && !$restore_other) { $next_widget = \&message_norestore_box }
- elsif ($restore_sys && $backup_sys_versions) { $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 }
- $restore_path_entry->set_text($restore_path);
- $restore_path_entry->signal_connect('changed', sub { $restore_path = $restore_path_entry->get_text() });
- $up_box->show_all();
-}
-
-sub catalog_restore {
- my $catalog_box;
- my $label;
- my $cat_entry;
- my @restore_files;
- my $restore_path_entry;
-
- #- catalog info in tree view
- my $tree_catalog = new Gtk::Tree();
-
- # file details in list widget
- my $list_bu_files = new Gtk::List();
- $list_bu_files->set_selection_mode('extended');
-
- #- read the catalog
- my @catalog = cat_("$cfg_dir/drakbackup_catalog");
-
- foreach (@catalog){
- chop;
- my $full_cat_entry = $_;
- my @line_data = split(':', $_);
- my $t = $line_data[0];
- my $t_catalog = new_with_label Gtk::TreeItem($t);
- gtksignal_connect($t_catalog, select => sub {
- $cat_entry = $full_cat_entry;
- @restore_files = ();
- foreach my $filename (my @details = glob("$save_path/list*$t.txt")) {
- my @contents = cat_($filename);
- $list_bu_files->clear_items();
- foreach (@contents) {
- chop;
- my $s = $_;
- my $f_item = $list_bu_files->add(gtkshow(new Gtk::ListItem($s)));
- gtksignal_connect($f_item, select => sub { push @restore_files, $s });
- gtksignal_connect($f_item, deselect => sub { @restore_files = () });
- }
- }
- });
- $tree_catalog->append($t_catalog);
-
- my $c_detail = new Gtk::Tree();
- $t_catalog->set_subtree($c_detail);
-
- 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: Full" if ($_ eq "F");
- $m .= $_ if (($_ ne "I") && ($_ ne "F"));
- my $c_det_cat = new_with_label Gtk::TreeItem($m);
-# gtksignal_connect($k_det_nic, select => sub { $nic = $m;
-# $kernel = $t; });
- $c_detail->append($c_det_cat);
- $c_det_cat->show();
- }
- $indexer++;
- }
- }
-
- gtkpack($advanced_box,
- $catalog_box = gtkpack_(new Gtk::HBox(0,10),
- 0, new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::VBox(0,5),
- 1, gtkpack_(new Gtk::VBox(0, 10),
- 1, createScrolledWindow($tree_catalog),
- 1, createScrolledWindow($list_bu_files),
- ),
- 0, gtkpack_(new Gtk::HBox(1, 10),
- 1, gtksignal_connect(new Gtk::Button(_("Restore Selected\nCatalog Entry")), clicked => sub {
- if ($cat_entry ne '') {
- my $media_check = restore_catalog_entry($cat_entry, ());
- if ($media_check) {
- ${$central_widget}->destroy();
-# button_box_restore();
- interactive_mode_box();
- }
- }
- }),
- 1, gtksignal_connect(new Gtk::Button(_("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 ne '') && ($files != 0)) {
- my $media_check = restore_catalog_entry($cat_entry, @passed_files);
- if ($media_check) {
- ${$central_widget}->destroy();
-# button_box_restore();
- interactive_mode_box();
- }
- }
- }),
- 1, gtkpack_(new Gtk::VBox(0, 5),
- 0, new Gtk::Label("Restore To Path"),
- 0, $restore_path_entry = new Gtk::Entry(),
- ),
- 1, gtksignal_connect(new Gtk::Button(_("Change\nRestore Path")), clicked => sub {
- filedialog_generic(0, "Path To Restore To", \$restore_path_entry, \$restore_path);
- }),
- ),
- 0, new Gtk::VBox(0,10),
- ),
- 0, new Gtk::VBox(0,10),
- ),
- );
-
- $restore_path_entry->set_text($restore_path);
- gtksignal_connect($restore_path_entry, changed => sub { $restore_path = $restore_path_entry->get_text() });
-
- button_box_restore();
- fonction_env(\$catalog_box, \&catalog_restore, \&restore_find_media_box, "restore", \&catalog_restore);
- $central_widget = \$catalog_box;
- $up_box->show_all();
-}
-
-sub restore_catalog_entry {
- #FIXME
- # we're working from a catalog entry, which means we know the
- # the tar file wildcards and some info on where the backup was stored
- # if it's a local device (HD, tape, CD) - prompt for the media
- # for tape, find how many other catalog entries had the same
- # label and calculate the record offset
- # if it's remote storage, display what we know of the connection
- # parameters and get the user's verification, then connect
-
- my ($cat_entry, @restore_files) = @_;
- my $username;
- my $userpass = $passwd_user;
- 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, "@")) {
- my @user_host = split("@", $vol_host);
- $username = $user_host[0];
- $vol_host = $user_host[1];
- } else {
- $username = $login_user;
- }
-
- #- 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 $save_path in the previous step - deal with it anyway
- my @restore_tar_files = glob("$dev_path/*$backup_time*$tar_ext");
- my $matches = @restore_tar_files;
- if ($matches eq 0) {
- show_warning("f", _("Backup files not found at %s.", $dev_path));
- return(0);
- } else {
- my $save_path_org = $save_path;
- $save_path = $dev_path;
- $restore_result = restore_hd_or_cd($cat_entry, $dev_path, @restore_files);
- $save_path = $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(_("Restore From CD"),_("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", _("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 eq '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(_("Restore From Tape"),_("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", _("Not the correct tape label. Tape is labelled %s.", $vol_name));
- return(0);
- } else {
- $restore_result = restore_tape($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
-
- #- the various protocols are going to have different requirements
- #- webdav - it should already be in sitecopyrc - compare it?
- #- ssh - the only method we have enabled at the moment is with keys
- #- - no passwd needed
- #- - if we use expect, it is needed
- #- - if we use drackbackup keys, then a different ssh call is needed
- #- rsync - uses a config file with username - rsync.user
- #- ftp needs all parameters entered
-
- $in->ask_from(_("Restore Via Network"), _("Restore Via Network Protocol: %s", $media),
- [ { label => _("Host Name"), val => \$vol_host },
- { label => _("Host Path or Module"), val => \$dev_path },
- { label => _("Username"), val => \$username },
- { label => _("Password"), val => \$userpass, hidden => 1 },
- ]) or goto return(0);
-
- if (($media eq 'ftp') || ($media eq 'rsync')) {
- if ($userpass eq '') {
- show_warning("f", _("Password required"));
- return(0);
- }
- }
- if (($media eq 'ftp') || ($media eq 'rsync') || ($media eq 'ssh')) {
- if ($username eq '') {
- show_warning("f", _("Username required"));
- return(0);
- } elsif ($vol_host eq '') {
- show_warning("f", _("Hostname required"));
- return(0);
- }
- }
- if ($dev_path eq '') {
- show_warning("f", _("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, $userpass, $media, @restore_files)
- if (($media eq 'rsync') || ($media eq 'ssh') || ($media eq 'webdav'));
- }
-
- # cleanup our restore dir - unlink fails here?
- system("rm -f $cfg_dir/restores/*");
-
- if (!$restore_result) {
- show_warning("i", __("Files Restored..."));
- return(0);
- } else {
- show_warning("f", __("Restore Failed..."));
- 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 eq 0) {
- #- full catalog specified
- foreach (wildcard_to_tarfile($wild_card)) {
- system("tar -C $restore_path -xzf $tarfile_dir/$_");
- }
- } else {
- #- individual files - pull from appropriate catalog
- foreach (@restore_files) {
- my $tarfile = file_to_tarfile($_, $wild_card);
- $_ = substr($_, 1);
- system("tar -C $restore_path -xzf $tarfile_dir/$tarfile $_");
- }
- }
- return(0);
-}
-
-sub restore_tape {
- my ($cat_entry, $dev_path, @restore_files) = @_;
- my $indv_files = @restore_files;
-
- my $wild_card = catalog_to_wildcard($cat_entry);
- $dev_path =~ s/\/st/\/nst/;
-
- if ($indv_files eq 0) {
- #- full catalog specified
- foreach (wildcard_to_tarfile($wild_card)) {
- my $offset = find_tape_offset($cat_entry);
- system("mt -f $dev_path rewind");
- system("mt -f $dev_path fsf $offset");
- system("tar -C cfg_dir/restores -xf $dev_path");
- if (-e "$cfg_dir/restores/$_") {
- system("tar -C $restore_path -xzf $cfg_dir/restores/$_");
- } else {
- return(1);
- }
- }
- } else {
- #- individual files - pull from appropriate catalog
- foreach (@restore_files) {
- my $tarfile = file_to_tarfile($_, $wild_card);
- $_ = substr($_, 1);
- if (!-e "$cfg_dir/restores/$tarfile") {
- my $offset = find_tape_offset($cat_entry);
- system("mt -f $dev_path rewind");
- system("mt -f $dev_path fsf $offset");
- system("tar -C cfg_dir/restores -xf $dev_path");
- }
- if (-e "$cfg_dir/restores/$tarfile") {
- system("tar -C $restore_path -xzf $cfg_dir/restores/$tarfile $_");
- } else {
- return(1);
- }
- }
- }
- 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);
-
- my $wild_card = catalog_to_wildcard($cat_entry);
-
- if ($indv_files eq 0) {
- #- full catalog specified
- foreach (wildard_to_tarfile($wild_card)) {
- $ftp->get($_, "$cfg_dir/restores/$_");
- system("tar -C $restore_path -xzf $cfg_dir/restores/$_");
- }
- } else {
- #- individual files - pull from appropriate catalog
- foreach (@restore_files) {
- my $tarfile = file_to_tarfile($_, $wild_card);
- $_ = substr($_, 1);
- if (!-e "$cfg_dir/restores/$tarfile") {
- $ftp->get($tarfile, "$cfg_dir/restores/$tarfile");
- }
- system("tar -C $restore_path -xzf $cfg_dir/restores/$tarfile $_");
- }
- }
- $ftp->quit;
- return(0);
-}
-
-sub restore_rsync_ssh_webdav {
- my ($cat_entry, $hostname, $hostpath, $username, $userpass, $mode, @restore_files) = @_;
- my $indv_files = @restore_files;
-
- my $wild_card = catalog_to_wildcard($cat_entry);
-
- if ($indv_files eq 0) {
- #- full catalog specified
- foreach (wildcard_to_tarfile($wild_card)) {
- if ($mode eq 'ssh') {
- system("scp $username\@$hostname:$hostpath/$_ $cfg_dir/restores/");
- } elsif ($mode eq 'rsync') {
- system("rsync --password-file=$cfg_dir/rsync.user $username\@$hostname\:\:$hostpath/$_ $cfg_dir/restores/");
- } else {
- system("wget http://$hostname/$hostpath/$_ -P $cfg_dir/restores/");
- }
- if (-e "$cfg_dir/restores/$_") {
- system("tar -C $restore_path -xzf $cfg_dir/restores/$_");
- } else {
- return(1);
- }
- }
- } else {
- #- individual files - pull from appropriate catalog
- foreach (@restore_files) {
- my $tarfile = file_to_tarfile($_, $wild_card);
- $_ = substr($_, 1);
- if (!-e "$cfg_dir/restores/$tarfile") {
- if ($mode eq 'ssh') {
- system("scp $username\@$hostname:$hostpath/$tarfile $cfg_dir/restores/");
- } elsif ($mode eq 'rsync') {
- system("rsync --password-file=$cfg_dir/rsync.user $username\@$hostname\:\:$hostpath/$tarfile $cfg_dir/restores/");
- } else {
- system("wget http://$hostname/$hostpath/$tarfile -P $cfg_dir/restores/");
- }
- }
- if (-e "$cfg_dir/restores/$tarfile") {
- system("tar -C $restore_path -xzf $cfg_dir/restores/$tarfile $_");
- } else {
- return(1);
- }
- }
- }
- return(0);
-}
-
-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 = basename(glob("$save_path/*$wildcard.txt"));
- $tarfile =~ s/txt/$tar_ext/;
- $tarfile =~ s/list/backup/;
- $tarfile;
-}
-
-sub file_to_tarfile {
- my ($restore_file, $wildcard) = @_;
- my $tarfile = `grep -l $restore_file $save_path/*$wildcard.txt`;
- chop $tarfile;
- $tarfile = basename($tarfile);
- $tarfile =~ s/txt/$tar_ext/;
- $tarfile =~ s/list/backup/;
- $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 (instr($_, $label)) {
- if (!instr($_, $cat_entry)) {
- $offset++;
- } else {
- return($offset);
- }
- }
- }
-}
-
-sub restore_box {
- my $retore_box;
- my $retore_box3;
- my $check_restore_sys;
- my $check_restore_user;
- my $check_restore_other;
-
- if ($good_restore_path) {
- $path_to_find_restore = $save_path if ($where_hd);
- $path_to_find_restore = "/mnt/cdrom" if ($where_cd);
- }
-
- find_backup_to_restore();
- button_box_restore_main();
-
- if ($other_backuped || $sys_backuped || @user_backuped) {
- gtkpack($advanced_box,
- $retore_box = gtkpack_(new Gtk::HBox(0,1),
- 1, new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::VBox(0,10),
- 1, new Gtk::VBox(0,10),
- 1, new Gtk::VBox(0,10),
- 1, gtksignal_connect(new Gtk::Button(_("Restore all backups")), clicked => sub {
- $retore_box->destroy();
- button_box_restore();
- @user_list_to_restore2 = sort @user_backuped;
- $restore_sys = 1;
- $restore_other = 1;
- $restore_user = 1;
- restore_do()
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Custom Restore")), clicked => sub {
- $retore_box->destroy();
- button_box_restore();
- restore_step2();
- }),
- 1, new Gtk::VBox(0,10),
- 1, new Gtk::VBox(0,10),
- ),
- 1, new Gtk::HBox(0,10),
- ),
- );
- } else {
- ${$central_widget}->destroy();
- restore_find_media_box(),
- }
- fonction_env(\$retore_box, \&restore_box, \&interactive_mode_box, "restore");
- $central_widget = \$retore_box;
- $up_box->show_all();
-}
-
-sub restore_find_media_box {
-
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
- my $entry_new_path;
- my $mount_media = 1;
- $good_restore_path = 0;
- my $message = "Unable to find backups to restore...\n";
- $message .= "Verify that $path_to_find_restore is the correct path" if (($where_hd) && ($where_cd));
- $message .= " and the CD is in the drive" if ($where_cd);
- if (($where_tape) || ($net_proto ne '')) {
- $message .= "Backups on unmountable media - Use Catalog to restore";
- $mount_media = 0;
- }
- $message .= ".";
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(new Gtk::VBox(0, 5),
- 1, gtkpack(new Gtk::HBox(0, 15),
- new Gtk::VBox(0, 5),
- new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- _($message),
- new Gtk::VBox(0, 5),
- ),
- 1, gtkpack(new Gtk::HBox(0, 15),
- new Gtk::VBox(0, 5),
- gtkpack(new Gtk::VBox(0, 10),
- gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("CD in place - continue.")), clicked => sub {
- $good_restore_path = 1;
- $box2->destroy();
- interactive_mode_box("restore");
- }), $mount_media),
- $new_path_entry = gtkset_sensitive(new Gtk::Entry(), $mount_media),
- gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("Browse to new restore repository.")), clicked => sub {
- filedialog_generic(0, "Directory To Restore From", \$new_path_entry, \$path_to_find_restore);
- }), $mount_media),
- gtksignal_connect(new Gtk::Button(_("Restore From Catalog")), clicked => sub {
- $box2->destroy();
- catalog_restore();
- }),
- ),
- new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- $new_path_entry->set_text($path_to_find_restore);
-
- button_box_find_media($mount_media);
- $up_box->show_all();
-}
-
-################################################ BUTTON_BOX ################################################
-
-# sub generic_button_box {
-# # 1-n - [button name, fonctions associated]
-# $button_box_tmp->destroy();
-# gtkpack($button_box,
-# $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
-# 0, gtksignal_connect(new Gtk::Button($_->[0]), clicked => sub {$_->[1]}) foreach (@_),
-# } ), );
-# }
-
-sub button_box_adv {
- $button_box_tmp->destroy();
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 0, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box();
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget,$custom_help);
- }),
- 1, new Gtk::HBox(0, 1),
- 0, gtksignal_connect(new Gtk::Button(_("Previous")), clicked => sub {
- ${$central_widget}->destroy();
- $previous_widget->();
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Save")), clicked => sub {
- ${$central_widget}->destroy();
- if (!check_pkg_needs()) {
- save_conf_file();
- $previous_widget->();
- }
- }),
- ),
- );
-}
-
-# sub button_box_adv {
-# generic_button_box(["cancel", ${$central_widget}->destroy() ]);
-# }
-
-sub button_box_restore_main {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(gtkpack_(new Gtk::HButtonBox,
- 0, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box()
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget, $custom_help);
- }),
- 1, new Gtk::HBox(0, 1),
- 0, gtksignal_connect(new Gtk::Button(_("Previous")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box()
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Ok")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box() }),
- ),
- ),
- );
-}
-
-sub button_box_backup_end {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 0, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box()
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget,$custom_help)
- }),
- 1, new Gtk::HBox(0, 1),
- 0, gtksignal_connect(new Gtk::Button(_("Previous")), clicked => sub {
- ${$central_widget}->destroy();
- $previous_widget->()
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Build Backup")), clicked => sub {
- ${$central_widget}->destroy();
- build_backup_status();
- build_backup_files();
- }),
- ),
- );
-}
-
-sub button_box_wizard_end {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 0, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box();
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget,$custom_help);
- }),
- 1, new Gtk::HBox(0, 1),
- 0, gtksignal_connect(new Gtk::Button(_("Previous")), clicked => sub {
- ${$central_widget}->destroy();
- $previous_widget->();
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Save")), clicked => sub {
- ${$central_widget}->destroy();
- save_conf_file();
- interactive_mode_box();
- }),
- ),
- );
-}
-
-sub button_box_restore_end {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 0, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box();
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget,$custom_help);
- }),
- 1, new Gtk::HBox(0, 1),
- 0, gtksignal_connect(new Gtk::Button(_("Previous")), clicked => sub {
- ${$central_widget}->destroy();
- $previous_widget->();
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Restore")), clicked => sub {
- ${$central_widget}->destroy();
- restore_backend();
- }),
- ),
- );
-}
-
-sub button_box_build_backup_end {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 1, new Gtk::HBox(0, 5),
- 1, new Gtk::HBox(0, 5),
- 0, gtksignal_connect(new Gtk::Button(_("Ok")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box();
- }),
- ),
- );
-}
-
-sub button_box_restore_pbs_end {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 1, new Gtk::HBox(0, 5),
- 1, new Gtk::HBox(0, 5),
- 1, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget,$custom_help);
- }),
- 0, gtksignal_connect(new Gtk::Button(_("Ok")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box();
- }),
- ),
- );
-}
-
-sub button_box_build_backup {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 1, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box();
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget,$custom_help);
- }),
- 1, new Gtk::HBox(0, 0),
- 0, gtksignal_connect(new Gtk::Button(_("Previous")), clicked => sub {
- ${$central_widget}->destroy();
- $previous_widget->();
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Next")), clicked => sub {
- ${$central_widget}->destroy();
- $next_widget->();
- }),
- ),
- );
-}
-
-sub button_box_restore {
-
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 1, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box();
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget,$custom_help);
- }),
- 1, new Gtk::HBox(0, 0),
- 0, gtksignal_connect(new Gtk::Button(_("Previous")), clicked => sub {
- ${$central_widget}->destroy();
- $previous_widget->();
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Next")), clicked => sub {
- ${$central_widget}->destroy();
- $next_widget->();
- }),
- ),
- );
-}
-
-sub button_box_find_media {
-
- my ($mount_media) = @_;
-
- #- $central_widget is not known yet?
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 1, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- $box2->destroy();
- interactive_mode_box();
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- $box2->destroy();
- adv_help(\&$current_widget,$custom_help);
- }),
- 1, new Gtk::HBox(0, 0),
- 0, gtksignal_connect(new Gtk::Button(_("Previous")), clicked => sub {
- $box2->destroy();
- interactive_mode_box();
- }),
- 1, gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("Next")), clicked => sub {
- $box2->destroy();
- interactive_mode_box("restore");
- }), $mount_media),
- ),
- );
-}
-
-sub button_box_wizard {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack_(new Gtk::HButtonBox,
- 1, gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub {
- ${$central_widget}->destroy();
- interactive_mode_box()
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&$current_widget,$custom_help)
- }),
- 1, new Gtk::HBox(0, 0),
- 0, gtksignal_connect(new Gtk::Button($next_widget ? _("Previous") : _("OK")), clicked => sub {
- ${$central_widget}->destroy();
- $previous_widget ? $previous_widget->() : $next_widget->();
- }),
- if_($next_widget, 1, gtksignal_connect(new Gtk::Button(_("Next")), clicked => sub {
- ${$central_widget}->destroy();
- $next_widget ? $next_widget->() : $previous_widget->();
- })),
- ),
- );
-}
-
-sub button_box_main {
- $button_box_tmp->destroy();
-
- gtkpack($button_box,
- $button_box_tmp = gtkpack(gtkset_layout(new Gtk::HButtonBox, -start),
- gtksignal_connect(new Gtk::Button(_("Close")), clicked => sub {
- Gtk->main_quit()
- }),
- gtksignal_connect(new Gtk::Button(_("Help")), clicked => sub {
- ${$central_widget}->destroy();
- adv_help(\&interactive_mode_box,$custom_help)
- }),
- ),
- );
-}
-
-################################################ MESSAGES ################################################
-
-sub send_mail_pb {
- $table->destroy();
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0, 15),
- 0, new Gtk::VBox(0, 5),
- 0, new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- 0, _("Error during sendmail.
- Your report mail was not sent.
- Please configure sendmail"),
- ),
- 0, new Gtk::VBox(0, 5),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- button_box_restore_main();
- $custom_help = "mail_pb";
- $central_widget = \$box2;
- $up_box->show_all();
-}
-
-sub install_rpm {
- my ($previous_function) = @_;
- #- catch a crash when calling help
- #- this GUI control technique is kind of funky
- if ($previous_function eq '') {
- $previous_function = \&advanced_where;
- }
- my $box_what_user;
- gtkpack($advanced_box,
- $box_what_user = gtkpack_(new Gtk::VBox(0, 15),
- 0, _("The following packages need to be installed:\n @list_of_rpm_to_install"),
- 0, new Gtk::HSeparator,
- 0, gtksignal_connect(new Gtk::Button(_("Install")), clicked => sub {
- system("urpmi --X @list_of_rpm_to_install");
- ${$central_widget}->destroy();
- $previous_widget->();
- }),
- ),
- );
- fonction_env(\$box_what_user, \&install_rpm, \&$previous_function, "what");
- $up_box->show_all();
-}
-
-sub client_ftp_pb {
- $table->destroy();
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 0, gtkpack_(new Gtk::HBox(0, 15),
- 0, new Gtk::VBox(0, 5),
- 0, new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- 0, _("Error during sending file via FTP.
- Please correct your FTP configuration."),
- ),
- 0, new Gtk::VBox(0, 5),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- button_box_restore_main();
- $custom_help = "mail_pb";
- $central_widget = \$box2;
- $up_box->show_all();
-}
-
-sub message_norestore_box {
- $box2->destroy();
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack(new Gtk::HBox(0, 15),
- new Gtk::VBox(0, 5),
- new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- _("Please select data to restore..."),
- new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- button_box_restore_main();
- $central_widget = \$box2;
- $up_box->show_all();
-}
-
-sub message_noselect_box {
- $box2->destroy();
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack(new Gtk::HBox(0, 15),
- new Gtk::VBox(0, 5),
- new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- _("Please select media for backup..."),
- new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- $previous_widget = \&wizard_step2;
- $next_widget = \&wizard_step2;
- $central_widget = \$box2;
- $up_box->show_all();
-}
-
-sub message_noselect_what_box {
- $box2->destroy();
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack(new Gtk::HBox(0, 15),
- new Gtk::VBox(0, 5),
- new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- _("Please select data to backup..."),
- new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- $previous_widget = \&wizard;
- $next_widget = \&wizard;
- $central_widget = \$box2;
- $up_box->show_all();
-}
-
-sub message_noconf_box {
- $box2->destroy();
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack(new Gtk::HBox(0, 15),
- new Gtk::VBox(0, 5),
- new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- _("No configuration file found \nplease click Wizard or Advanced."),
- new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- button_box_restore_main();
- $central_widget = \$box2;
- $up_box->show_all();
-}
-
-sub message_underdevel {
- $box2->destroy();
- my ($pix_warn_map, $pix_warn_mask) = gtkcreate_png('warning');
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack(new Gtk::HBox(0, 15),
- new Gtk::VBox(0, 5),
- new Gtk::Pixmap($pix_warn_map, $pix_warn_mask),
- _("Under Devel ... please wait."),
- new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- $central_widget = \$box2;
- $up_box->show_all();
-}
-
-################################################ BUILD_BACKUP ################################################
-
-sub progress {
- my ($progressbar, $incr, $label_text) = @_;
- my($new_val) = $progressbar->get_current_percentage;
- $new_val += $incr;
- if ($new_val > 1) { $new_val = 1 }
- $progressbar->update($new_val);
- $progressbar->{label}->set($label_text);
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-sub find_backup_to_put_on_cd {
- my @list_backup_tmp;
- my @data_backuped_tmp;
- @data_backuped = ();
- -d $save_path and my @list_backup = all($save_path);
- foreach (grep /^backup_other/, @list_backup) {
- $other_backuped = 1;
- chomp;
- my $tail = (split(' ',`du $save_path/$_`))[0] ;
- s/^backup_other//gi;
- s/.tar.gz$//gi;
- s/.tar.bz2$//gi;
- my @user_date = split(/\_20/,$_);
- my @user_date2 = split(/\_/,$user_date[1]);
- my $to_put = " other_data, (tail: $tail ko, date: 20$user_date2[0], hour: $user_date2[1])";
- push @data_backuped , $to_put;
- }
- foreach (grep /_sys_/, @list_backup) {
- $sys_backuped = 1;
- chomp;
- my $tail = (split(' ',`du $save_path/$_`))[0] ;
- s/^backup_other//gi;
- s/.tar.gz$//gi;
- s/.tar.bz2$//gi;
- my @user_date = split(/\_20/,$_);
- my @user_date2 = split(/\_/,$user_date[1]);
- my $to_put = " system, (tail: $tail ko, date: 20$user_date2[0], hour: $user_date2[1])";
- push @data_backuped , $to_put;
- }
- foreach (grep /user_/, @list_backup) {
- chomp;
- my $tail = (split(' ',`du $save_path/$_`))[0] ;
- s/^backup_user_//gi;
- s/.tar.gz$//gi;
- s/.tar.bz2$//gi;
- my @user_date = split(/\_20/,$_);
- my @user_date2 = split(/\_/,$user_date[1]);
- my $to_put = " $user_date[0], (tail: $tail ko, date: 20$user_date2[0], hour: $user_date2[1])";
- push @data_backuped , $to_put;
- }
-}
-
-sub build_backup_status {
- $pbar = new Gtk::ProgressBar;
- $pbar1 = new Gtk::ProgressBar;
- $pbar2 = new Gtk::ProgressBar;
- $pbar3 = new Gtk::ProgressBar;
- $stext = new Gtk::Label("");
- button_box_build_backup_end();
- gtkpack($advanced_box,
- $table = gtkpack(new Gtk::VBox(0, 5),
- create_packtable({ col_spacings => 10, row_spacings => 5 },
- [""],
- [""],
- [""],
- [""],
- [""],
- [""],
- [""],
- [_("Backup system files")],
- [ $pbar, $pbar->{label} = new Gtk::Label(' ') ],
- [_("Backup user files") ],
- [$pbar1,$pbar1->{label} = new Gtk::Label(' ') ],
- [_("Backup other files")],
- [ $pbar2, $pbar2->{label} = new Gtk::Label(' ') ],
- [_("Total Progress")],
- [$pbar3,$pbar3->{label} = new Gtk::Label(' ') ],
- ),
- $stext,
- ),
- );
- $custom_help = "options";
- $central_widget = \$table;
- $up_box->show_all();
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-
-sub build_backup_ftp_status {
- $pbar = new Gtk::ProgressBar;
- $pbar3 = new Gtk::ProgressBar;
- $table->destroy();
- button_box_build_backup_end();
- $pbar->set_value(0);
- $pbar3->set_value(0);
-
-
- gtkpack($advanced_box,
- $table = gtkpack_(new Gtk::VBox(0, 15),
- 1, _("files sending by FTP"),
- 1, new Gtk::VBox(0, 15),
- 1, create_packtable ({ col_spacings => 10, row_spacings => 5 },
-# [ $pbar->set_show_text( $show_text );
- [_("Sending files...")],
- [""],
- [ $pbar->{label} = new Gtk::Label(' ') ],
- [ $pbar],
- [""],
- [_("Total Progress")],
- [ $pbar3->{label} = new Gtk::Label(' ') ],
- [$pbar3],
- ),
- 1, new Gtk::VBox(0, 15),
- ),
- );
- $custom_help = "options";
- $central_widget = \$table;
- $up_box->show_all();
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-sub build_backup_box_see_conf {
- my $box2;
- my $text = new Gtk::Text(undef, undef);
- system_state();
- gtktext_insert($text, $system_state);
- button_box_restore_main();
-
- gtkpack($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, gtkpack_(new Gtk::VBox(0,10),
- 0, _("Drakbackup Configuration"),
- 1, createScrolledWindow($text),
- ),
- ),
- );
- button_box_backup_end();
- $custom_help = "";
- $central_widget = \$box2;
- $current_widget = \&build_backup_box_see_conf;
- $previous_widget =\&build_backup_box;
- $up_box->show_all();
-}
-
-sub build_backup_box_progress {
-# build_backup_files();
-}
-
-sub aff_total_tail {
- my @toto ;
- my $total = 0;
- push @toto, (split (",", $_))[1] foreach @list_to_build_on_cd;
- foreach (@toto) {
- s/\s+\(tail://gi;
- s/\s+//gi;
- s/ko//gi;
- $total += $_;
- }
- $label_tail->set("total tail: $total ko");
-}
-
-sub build_backup_box {
- $box2->destroy();
- my ($pix_cd_map, $pix_cd_mask) = gtkcreate_png("ic82-CD-40");
- my ($pix_hd_map, $pix_hd_mask) = gtkcreate_png("ic82-discdurwhat-40");
- my ($pix_options_map, $pix_options_mask) = gtkcreate_png("ic82-moreoption-40");
-
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtksignal_connect(my $button_from_conf_file = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy();
- build_backup_box_see_conf();
- }),
- 0, new Gtk::VBox(0, 5),
- 1, gtksignal_connect(my $button_see_conf = new Gtk::Button(), clicked => sub {
- ${$central_widget}->destroy();
- build_backup_box_see_conf();
- }),
- 1, new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
-
- $button_from_conf_file->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_hd_map, $pix_hd_mask),
- new Gtk::Label(_("Backup Now from configuration file")),
- new Gtk::HBox(0, 5)
- ));
- $button_see_conf->add(gtkpack(new Gtk::HBox(0,10),
- new Gtk::Pixmap($pix_options_map, $pix_options_mask),
- new Gtk::Label(_("View Backup Configuration.")),
- new Gtk::HBox(0, 5)
- ));
-
- button_box_restore_main();
- fonction_env(\$box2, \&build_backup_box, \&interactive_mode_box, "options");
- $up_box->show_all();
-}
-
-################################################ INTERACTIVE ################################################
-
-sub interactive_mode_box {
- $box2->destroy();
- my ($mode) = @_;
-
- read_conf_file();
- gtkadd($advanced_box,
- $box2 = gtkpack_(new Gtk::HBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtkpack_(new Gtk::VBox(0, 15),
- 1, new Gtk::VBox(0, 5),
- 1, gtksignal_connect(new Gtk::Button(_("Wizard Configuration")), clicked => sub {
- ${$central_widget}->destroy();
- read_conf_file();
- wizard();
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Advanced Configuration")), clicked => sub {
- button_box_adv();
- ${$central_widget}->destroy();
- advanced_box();
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Backup Now")), clicked => sub {
- ${$central_widget}->destroy();
- if ($cfg_file_exist) {
- build_backup_box();
- } else {
- message_noconf_box();
- }
- }),
- 1, gtksignal_connect(new Gtk::Button(_("Restore")), clicked => sub {
- ${$central_widget}->destroy();
- restore_box();
- }),
- 1, new Gtk::VBox(0, 5),
- ),
- 1, new Gtk::VBox(0, 5),
- ),
- );
- button_box_main();
- $custom_help = "main";
- $central_widget = \$box2;
- $up_box->show_all();
- if ($mode eq "restore") {
- ${$central_widget}->destroy();
- restore_box();
- }
-}
-
-sub interactive_mode {
- $interactive = 1;
- my $box;
- $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel;
- init Gtk;
- $window1->signal_connect (delete_event => sub { Gtk->exit(0) });
- $window1->set_position(1);
- $window1->set_title(_("Drakbackup"));
- my ($pix_u_map, $pix_u_mask) = gtkcreate_png("drakbackup.540x57");
- read_conf_file();
-
- gtkadd($window1,
- gtkpack(new Gtk::VBox(0,0),
- gtkpack(gtkset_usize ($up_box = new Gtk::VBox(0, 5), 540, 400),
- $box = gtkpack_(new Gtk::VBox(0, 3),
- 0, new Gtk::Pixmap($pix_u_map, $pix_u_mask),
- 1, gtkpack_(new Gtk::HBox(0, 3),
- 1, gtkpack_(new Gtk::HBox(0, 15),
- 0, new Gtk::HBox(0, 5),
- 1, $advanced_box = gtkpack_(new Gtk::HBox(0, 15),
- 1, $box2 = gtkpack_(new Gtk::VBox(0, 15),),
- ),
- 0, new Gtk::HBox(0, 5),
- ),
- ),
- 0, new Gtk::HSeparator,
- 0, $button_box = gtkpack(new Gtk::VBox(0, 15),
- $button_box_tmp = gtkpack(new Gtk::VBox(0, 0),),
- ),
- ),
- ),
- ),
- );
- interactive_mode_box();
- $custom_help = "main";
- button_box_main();
- $central_widget = \$box2;
- $window1->show_all;
- $window1->realize;
- $window1->show_all();
- Gtk->main;
- Gtk->exit(0);
-}
-
-################################################ HELP & ABOUT ################################################
-
-
-sub adv_help {
- my ($function, $custom_help) = @_,
- my $text = new Gtk::Text(undef, undef);
- my $advanced_box_help;
-
-################################################ help definition ##############################################
-
- my %custom_helps = (
- "options" =>
- _("options description:
-
- In this step Drakbackup allow you to change:
-
- - The compression mode:
-
- If you check bzip2 compression, you will compress
- your data better than gzip (about 2-10 %).
- This option is not checked by default because
- this compression mode needs more time (about 1000% more).
-
- - The update mode:
-
- This option will update your backup, but this
- option is not really useful because you need to
- decompress your backup before you can update it.
-
- - the .backupignore mode:
-
- Like with cvs, Drakbackup will ignore all references
- included in .backupignore files in each directories.
- ex:
- #> cat .backupignore
- *.o
- *~
- ...
-
-
-"),
- "mail_pb" =>
- _("
- Some errors during sendmail are caused by
- a bad configuration of postfix. To solve it you have to
- set myhostname or mydomain in /etc/postfix/main.cf
-
-"),
-
- "what" =>
- _("options description:
-
- - Backup system files:
-
- This option allows you to backup your /etc directory,
- which contains all configuration files. Please be
- careful during the restore step to not overwrite:
- /etc/passwd
- /etc/group
- /etc/fstab
-
- - Backup User files:
-
- This option allows you select all users that you want
- to backup.
- To preserve disk space, it is recommended that you
- do not include web browser's cache.
-
- - Backup Other files:
-
- This option allows you to add more data to save.
- With the other backup it's not possible at the
- moment to select incremental backup.
-
- - Incremental Backups:
-
- The incremental backup is the most powerful
- option for backup. This option allows you
- to backup all your data the first time, and
- only the changed afterward.
- Then you will be able, during the restore
- step, to restore your data from a specified
- date.
- If you have not selected this option all
- old backups are deleted before each backup.
-
-
-"),
- "restore" =>
- _("restore description:
-
-Only the most recent date will be used, because with incremental
-backups it is necessary to restore one by one each older backup.
-
-So if you don't want to restore a user please unselect all their
-check boxes.
-
-Otherwise, you are able to select only one of these.
-
- - Incremental Backups:
-
- The incremental backup is the most powerful
- option to use. This option allows you to
- backup all of your data the first time, and
- only the changed data after.
- So you will be able, during the restore
- step, to restore your data from a specified
- date.
- If you have not selected this option all
- old backups are deleted before each backup.
-
-
-
-"),
- "main" =>
- _(" Copyright (C) 2001 MandrakeSoft by DUPONT Sebastien <dupont_s\@epita.fr>") .
-"\n" .
-_(" updates 2002 MandrakeSoft by Stew Benedict <sbenedict\@mandrakesoft.com>") .
-"\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" .
-_("Description:
-
- Drakbackup is used to backup your system.
- During the configuration you can select:
- - System files,
- - Users files,
- - Other files.
- or All your system ... and Other (like Windows Partitions)
-
- Drakbackup allows you to backup your system on:
- - Harddrive.
- - NFS.
- - CDROM (CDRW), DVDROM (with autoboot, rescue and autoinstall.).
- - FTP.
- - Rsync.
- - Webdav.
- - Tape.
-
- Drakbackup allows you to restore your system to
- a user selected directory.
-
- Per default all backup will be stored on your
- /var/lib/drakbackup directory
-
- Configuration file:
- /etc/drakconf/drakbackup/drakbakup.conf
-
-
-Restore Step:
-
- During the restore step, DrakBackup will remove
- your original directory and verify that all
- backup files are not corrupted. It is recommended
- you do a last backup before restoring.
-
-
-"),
- "ftp" =>
- _("options description:
-
-Please be careful when you are using ftp backup, because only
-backups that are already built are sent to the server.
-So at the moment, you need to build the backup on your hard
-drive before sending it to the server.
-
-"),
- "restore_pbs" =>
- _("
-Restore Backup Problems:
-
-During the restore step, Drakbackup will verify all your
-backup files before restoring them.
-Before the restore, Drakbackup will remove
-your original directory, and you will loose all your
-data. It is important to be careful and not modify the
-backup data files by hand.
-")
-);
-
- my $default_help = _(" Copyright (C) 2001 MandrakeSoft by DUPONT Sebastien <dupont_s\@epita.fr>") .
-"\n" .
-_(" updates 2002 MandrakeSoft by Stew Benedict <sbenedict\@mandrakesoft.com>") .
-"\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" .
-_("Description:
-
- Drakbackup is used to backup your system.
- During the configuration you can select
- - System files,
- - Users files,
- - Other files.
- or All your system ... and Other (like Windows Partitions)
-
- Drakbackup allows you to backup your system on:
- - Harddrive.
- - NFS.
- - CDROM (CDRW), DVDROM (with autoboot, rescue and autoinstall.).
- - FTP.
- - Rsync.
- - Webdav.
- - Tape.
-
- Drakbackup allows you to restore your system to
- a user selected directory.
-
- Per default all backup will be stored on your
- /var/lib/drakbackup directory
-
- Configuration file:
- /etc/drakconf/drakbackup/drakbakup.conf
-
-Restore Step:
-
- During the restore step, Drakbackup will remove
- your original directory and verify that all
- backup files are not corrupted. It is recommended
- you do a last backup before restoring.
-
-
-");
-
-################################################ help function ##############################################
-
- gtktext_insert($text, $custom_helps{$custom_help} || $default_help);
- gtkpack($advanced_box,
- $advanced_box_help = gtkpack_(new Gtk::VBox(0,10),
- 1, gtkpack_(new Gtk::HBox(0,0),
- 1, $text,
- 0, new Gtk::VScrollbar($text->vadj),
- ),
- 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread),
- gtksignal_connect(new Gtk::Button(_("OK")), clicked => sub {
- ${$central_widget}->destroy(); $function->() }),
- ),
- )
- );
- $central_widget = \$advanced_box_help;
- $up_box->show_all();
-}
-
-sub to_ok {
- $sav_next_widget = $next_widget;
- $next_widget = undef;
- button_box_wizard();
-}
-
-sub to_normal {
- $next_widget = $sav_next_widget;
-}
diff --git a/perl-install/standalone/drakboot b/perl-install/standalone/drakboot
deleted file mode 100755
index ade6207de..000000000
--- a/perl-install/standalone/drakboot
+++ /dev/null
@@ -1,62 +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;
-use bootloader;
-use detect_devices;
-use fsedit;
-use fs;
-use c;
-
-local $_ = join '', @ARGV;
-
-/-h/ and die "usage: drakboot [--expert] [--testing]\n";
-
-$::expert = /-expert/;
-$::testing = /-testing/;
-
-my $in = 'interactive'->vnew('su', 'bootloader');
-
-$::lilo_choice = \&lilo_choice;
-
-if ($in->isa('interactive::gtk')) {
- require 'bootlook.pm';
-} else {
- lilo_choice();
-}
-
-!$::isEmbedded and $in->exit(0);
-kill('USR1', $::CCPID);
-goto ask;
-
-sub lilo_choice
-{
- my $bootloader = bootloader::read();
- local ($_) = `detectloader`;
- $bootloader->{methods} = { lilo => 1, grub => !!/grub/i, if_(arch() =~ /ppc/, yaboot => 1) };
-
- my ($all_hds) = fsedit::get_hds();
- my $fstab = [ fsedit::get_all_fstab($all_hds) ];
- fs::merge_info_from_fstab($fstab);
-
- $::expert=1;
-
- ask:
- local $::isEmbedded = 0;
- any::setupBootloader($in, $bootloader, $all_hds, $fstab, $ENV{SECURE_LEVEL}) or return;
- eval { bootloader::install($bootloader, $fstab, $all_hds->{hds}) };
-
- my $loader = arch() =~ /ppc/ ? "Yaboot" : "LILO";
- if ($@) {
- $in->ask_warn('',
- [ _("Installation of %s failed. The following error occured:", $loader),
- grep { !/^Warning:/ } cat_("/tmp/.error") ]);
- unlink "/tmp/.error";
- goto ask;
- }
-}
diff --git a/perl-install/standalone/drakbug b/perl-install/standalone/drakbug
deleted file mode 100755
index 754408112..000000000
--- a/perl-install/standalone/drakbug
+++ /dev/null
@@ -1,198 +0,0 @@
-#!/usr/bin/perl
-
-# Drak Bug Report
-# C$opyright (C) 2002 MandrakeSoft (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 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;
-use interactive;
-use MDK::Common;
-require Gtk;
-require Gtk::Gdk::ImlibImage;
-use my_gtk qw(:helpers :wrappers :ask);
-use Config;
-
-Gtk::Gdk::ImlibImage->init;
-
-my $in = 'interactive'->vnew;
-
-$::bugzilla_url = "https://qa.mandrakesoft.com";
-my $version = "0.9.0";
-my $prog;
-my $incident=1;
-
-sub usage {
- print STDERR _("drakbug version %s
-Copyright (C) 2002 MandrakeSoft.
-This is free software and may be redistributed under the terms of the GNU GPL.
-
-usage: drakbug [OPTIONS] [PROGRAM_NAME]
-
-OPTIONS:
-", $version) . _(" --help - print this help message.
-") . "\n" . _(" --report - program should be one of mandrake tools
-") . "\n" . _(" --incident - program should be one of mandrake tools
-");
- exit(0);
-}
-
-while (defined($_ = shift @ARGV)) {
- /^--help$/ and do { usage; next };
- /^--report$/ and do { $prog = shift @ARGV };
- /^--incident$/ and do {$incident = 1 ; $prog = shift @ARGV };
-}
-
-my $window_g = new Gtk::Window -toplevel;
-$window_g->set_policy($false,$false,$true);
-$window_g->set_position(1);
-$window_g->border_width(5);
-$window_g->set_title(_("Mandrake Bug Report Tool"));
-#$window_g->set_usize(540, 350);
-$window_g->signal_connect("delete_event", \&quit_global);
-
-my $mdk_app = {
- _("Mandrake Control Center") => 'drakconf',
- _("First Time Wizard") => 'drakfw',
- _("Synchronization tool") => 'draksync',
- _("Standalone Tools") => ['adduserdrake','diskdrake','drakautoinst','drakbackup','drakboot','drakbug','drakfloppy','drakfont','drakgw','drakconnect','drakxservices','drakxtv','keyboardrake','logdrake','mousedrake','net_monitor','printerdrake','scannerdrake','tinyfirewall','XFdrake'],
- _("HardDrake") => 'harddrake2',
- _("Mandrake Online") => 'mdkonline',
- _("Menudrake") => 'menudrake',
- _("Msec") => 'msec',
- _("Remote Control") => 'rfbdrake',
- _("Software Manager") => 'rpmdrake',
- _("Urpmi") => 'urpmi',
- _("Windows Migration tool") => 'transfugdrake',
- _("Userdrake") => 'userdrake',
- _("Configuration Wizards") => 'wizdrake',
- };
-my @generic_tool = keys %{$mdk_app};
-my @all_drakxtools = @ { $mdk_app->{_("Standalone Tools")} };
-push(@generic_tool,@all_drakxtools);
-
-my $kernel_release = chomp_(`uname -r`);
-$kernel_release.="";
-my $mdk_release = chomp_(cat_("/etc/mandrake-release"));
-
-my $table = new Gtk::Table(4,2,'TRUE');
-#$table->set_border_width(5);
-$table->set_row_spacings(10);
-$table->set_col_spacings(5);
-$table->attach(new Gtk::Label(_("Application:")), 0, 1, 0, 1,'fill', 'fill',20,0);
-$table->attach(new Gtk::Label(_("Package: ")), 0, 1, 1, 2, 'fill', 'fill',0,0);
-$table->attach(new Gtk::Label(_("Kernel:")), 0, 1, 2, 3, 'fill', 'fill',0,0);
-$table->attach(new Gtk::Label(_("Release: ")), 0, 1, 3, 4, 'fill', 'fill',0,0);
-$table->attach(my $comb_app = new Gtk::Combo(), 1, 2, 0, 1, 'fill', 'fill',0,0);
-$comb_app->set_usize(270,undef);
-$comb_app->set_popdown_strings("",sort(@generic_tool));
-$table->attach(my $package = new Gtk::Entry(), 1, 2, 1, 2, 'fill', 'fill',0,0);
-$package->set_text("...");
-$table->attach(my $kernel_rel = new Gtk::Entry(), 1, 2, 2, 3, 'fill', 'fill',0,0);
-$kernel_rel->set_text("$kernel_release");
-$table->attach(my $mdk_rel = new Gtk::Entry(), 1, 2, 3, 4, 'fill', 'fill',0,0);
-$mdk_rel->set_text("$mdk_release");
-
-gtkpack2__(
- gtkpack2__(my $vbx = new Gtk::VBox(0,5),
- gtkadd($table),
- gtkpack(new Gtk::HBox(0,0),
- gtkpack(gtkset_justify(new Gtk::Label(_("\n\nTo submit a bug report, click on the button report.\nThis will open a web browser window on https://www.bugzilla.com\n where you'll find a form to fill in.The information displayed above will be \ntransferred to that server\n\n")),"left")),
- ),
- gtkpack(new Gtk::HSeparator),
-
- ),
- );
-
-if (defined $prog) {
- update_app($prog);
- $comb_app->entry->set_text("$prog");
-};
-
-$comb_app->entry->signal_connect('changed', sub { update_app($comb_app->entry->get_text()) });
-my $kernel = $kernel_rel->get_chars(0,-1);
-my $hbx = new Gtk::HBox(0,0);
-my $Close_Button = new Gtk::Button(_("Close"));
-$Close_Button->signal_connect(clicked => sub { Gtk->exit(0) });
-$hbx->pack_start($Close_Button,0,0,0);
-my $options = "mdkwizard=1";
-$options.="";
-
-my $Report_Button = new Gtk::Button(_("Report"));
-$Report_Button->signal_connect(clicked => sub { connect_bugzilla("$::bugzilla_url/wizard?"."$options") });
-$hbx->pack_end($Report_Button,0,0,0);
-$vbx->pack_start($hbx,0,0,0);
-$window_g->add($vbx);
-
-$window_g->show_all();
-Gtk->main();
-Gtk->exit(0);
-in->exit(0);
-
-sub update_app {
- my ($text) = @_;
- my $app_choice;
- $ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";
- if (member($text,@all_drakxtools) || $text eq _("Standalone Tools")) {
- $app_choice = chomp_(`rpm -q drakxtools`) ;
- } elsif (member($text,keys %{$mdk_app}) && $text ne _("Standalone Tools")) {
- $app_choice = get_package($mdk_app->{$text});
- } else {
- LOOP: while (($key,$value) = each %{$mdk_app}) {
- next if $key eq _("Standalone Tools");
- if ($value eq $text) {
- $app_choice = get_package($text);
- $prog = $key;
- last LOOP;
- }
- }
-
- }
- $app_choice ne '' ? $package->set_text("$app_choice") : $package->set_text(_("Not installed"));
-}
-
-sub get_package {
- my ($executable) = @_;
- my ($rpm_package, $which_app);
- $which_app = chomp_(`which '$executable'`);
- $rpm_package = chomp_(`rpm -qf '$which_app' 2>1&`);
- $rpm_package;
-}
-
-sub parse_release {
- my ($rel) = cat_('/etc/mandrake-release') =~ /release\s(\S+\s\(.*\))/;
-
-}
-sub connect_bugzilla {
- my($url) = @_;
- my $w = $in->wait_message('',_("connecting to Bugzilla wizard ..."));
- sleep(2);
- exec $ENV{BROWSER},$url if exists $ENV{BROWSER} ;
- my @browser = qw (mozilla konqueror galeon);
- foreach (@browser) {
- if (-e "/usr/bin/$_") { print "execing $_ : $url\n "; exec $_,$url }
- }
- $in->ask_warn('', _("No browser available! Please install one"));
-}
-
-sub read_app_context {
- my ($name) = @_;
-}
-
-sub quit_global {
- Gtk->exit(0);
-}
diff --git a/perl-install/standalone/drakbug_report b/perl-install/standalone/drakbug_report
deleted file mode 100755
index 6b70acb35..000000000
--- a/perl-install/standalone/drakbug_report
+++ /dev/null
@@ -1,14 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-
-use MDK::Common;
-use any;
-
-my %other = (
- 'rpm -qa' => join('', sort `rpm -qa`),
- 'mandrake version' => cat_('/etc/redhat-release'),
- 'df' => join('', `df`),
-);
-
-print any::report_bug('', %other);
diff --git a/perl-install/standalone/drakconnect b/perl-install/standalone/drakconnect
deleted file mode 100755
index 903d9d0b3..000000000
--- a/perl-install/standalone/drakconnect
+++ /dev/null
@@ -1,693 +0,0 @@
-#!/usr/bin/perl
-
-# DrakConnect
-
-# Copyright (C) 1999-2002 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 common;
-use network::netconnect;
-use network::ethernet;
-use network::tools;
-use network;
-use c;
-use MDK::Common;
-use any;
-use network::isdn;
-use network::adsl;
-use MDK::Common::Globals "network", qw($in $prefix $disconnect_file $connect_prog $connect_file $disconnect_file);
-
-my $xpm_path = "/usr/share/libDrakX/pixmaps";
-$::isWizard = "@ARGV" =~ /--wizard/;
-$::expert = "@ARGV" =~ /--expert/;
-local $_ = join '', @ARGV;
-
-#/-h/ and die "usage: drakconnect[--xf3] [--beginner] [--expert] [--auto] [--noauto] [--skiptest] [--testing]\n";
-
-my $netcnx = {};
-my $netc = {};
-my $intf = {};
-my @conx_type = ('modem', 'isdn_internal', 'isdn_external', 'adsl', 'cable', 'lan');
-
-#$::wizard_xpm = "/usr/share/pixmaps/internet.xpm";
-
-my $in = 'interactive'->vnew('su', 'network');
-!$::isEmbedded && $in->isa('interactive::gtk') and $::isWizard = 1;
-$::Wizard_pix_up = "wiz_drakconnect.png";
-$::Wizard_title = "Network & Internet Configuration";
-
-MDK::Common::Globals::init(
- in => $in,
- prefix => '',
- connect_file => "/etc/sysconfig/network-scripts/net_cnx_up",
- disconnect_file => "/etc/sysconfig/network-scripts/net_cnx_down",
- connect_prog => "/etc/sysconfig/network-scripts/net_cnx_pg"
- );
-
-$::isEmbedded && ref($in) =~ /gtk/ or goto dd;
-require Gtk;
-init Gtk;
-require my_gtk;
-import my_gtk qw(:helpers :wrappers);
-my $expert_mode = 0;
-network::netconnect::read_net_conf('', $netcnx, $netc);
-any::load_category_no_message('net', undef);
-my @all_cards = network::ethernet::conf_network_card_backend ($netc, $intf, undef, undef, undef, undef);
-network::netconnect::load_conf($netcnx, $netc, $intf);
-
-my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel;
-$window1->signal_connect (delete_event => sub { Gtk->exit(0) });
-$window1->set_position(1);
-$window1->set_title(_("Network configuration (%d adapters)", @all_cards));
-$window1->border_width(10);
-$::isEmbedded or $window1->set_usize(500, 400);
-my $vbox1 = new Gtk::VBox(0,10);
-$window1->add($vbox1);
-my $hbox1 = new Gtk::HBox(0,0);
-$vbox1->pack_start($hbox1,0,0,0);
-$hbox1->pack_start(new Gtk::Label(_("Profile: ")),0,0,0);
-
-my $combo1 = new Gtk::Combo;
-$combo1->set_popdown_strings (network::netconnect::get_profiles());
-my $old_profile = $netcnx->{PROFILE};
-$combo1->entry->set_text($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default");
-$combo1->entry->set_editable(0);
-$hbox1->pack_start($combo1,0,0,0);
-my $button_del = new Gtk::Button(_("Del profile..."));
-$button_del->signal_connect(clicked => sub {
- my $dialog = new Gtk::Dialog();
- $dialog->set_position(1);
- $dialog->vbox->set_border_width(10);
- $dialog->signal_connect (delete_event => sub { Gtk->main_quit() });
- $dialog->vbox->pack_start(new Gtk::Label(_("Profile to delete:")),1,1,0);
- my $combo_dialog = new Gtk::Combo;
- $combo_dialog->set_popdown_strings (grep { ! /default/ } network::netconnect::get_profiles());
- $combo_dialog->entry->set_editable(0);
- $dialog->vbox->pack_start($combo_dialog,1,1,0);
- my $bbox_dialog = new Gtk::HButtonBox;
- $dialog->action_area->add($bbox_dialog);
- $bbox_dialog->set_layout(-end);
- my $button_ok = new Gtk::Button _("OK");
- $button_ok->signal_connect (clicked => sub {
- network::netconnect::del_profile($netcnx, $combo_dialog->entry->get_text());
- $netcnx->{PROFILE} eq $combo_dialog->entry->get_text() and $netcnx->{PROFILE} = "default";
- Gtk->main_quit();
- });
- $bbox_dialog->add($button_ok);
- my $button_cancel = new Gtk::Button _("Cancel");
- $button_cancel->signal_connect (clicked => sub { Gtk->main_quit() });
- $bbox_dialog->add($button_cancel);
- $dialog->show_all;
- $dialog->set_modal(1);
- Gtk->main();
- $dialog->destroy;
- $combo1->entry->set_text((-e "/etc/sysconfig/network-scripts/drakconnect_conf." . $combo1->entry->get_text) ? $combo1->entry->get_text : "default");
- $combo1->set_popdown_strings(network::netconnect::get_profiles());
- apply();
- });
-$hbox1->pack_start($button_del,0,0,5);
-$button_del->set_sensitive(network::netconnect::get_profiles() > 1);
-my $button_new = new Gtk::Button(_("New profile..."));
-$button_new->signal_connect(clicked => sub {
- my $dialog = new Gtk::Dialog();
- $dialog->set_position(1);
- $dialog->vbox->set_border_width(10);
- $dialog->signal_connect (delete_event => sub { Gtk->main_quit() });
- $dialog->vbox->pack_start(new Gtk::Label(_("Name of the profile to create (the new profile is created as a copy of the current one) :")),1,1,0);
- my $entry_dialog = new Gtk::Entry;
- $dialog->vbox->pack_start($entry_dialog,1,1,0);
- my $bbox_dialog = new Gtk::HButtonBox;
- $dialog->action_area->add($bbox_dialog);
- $bbox_dialog->set_layout(-end);
- my $button_ok = new Gtk::Button _("OK");
- $button_ok->signal_connect (clicked => sub {
- network::netconnect::add_profile($netcnx, $entry_dialog->get_text());
- $netcnx->{PROFILE} = $entry_dialog->get_text();
- Gtk->main_quit();
- });
- $bbox_dialog->add($button_ok);
- my $button_cancel = new Gtk::Button _("Cancel");
- $button_cancel->signal_connect (clicked => sub { Gtk->main_quit() });
- $bbox_dialog->add($button_cancel);
- $dialog->show_all;
- $dialog->set_modal(1);
- Gtk->main();
- $dialog->destroy;
- $combo1->entry->set_text((-e "/etc/sysconfig/network-scripts/drakconnect_conf." . $netcnx->{PROFILE}) ? $netcnx->{PROFILE} : "default");
- $combo1->set_popdown_strings(network::netconnect::get_profiles());
-});
-$hbox1->pack_start($button_new,0,0,5);
-my $hbox2 = new Gtk::HBox(0,0);
-$vbox1->pack_start($hbox2,0,0,0);
-$hbox2->pack_start(new Gtk::Label(_("Hostname: ")),0,0,0);
-my $hostname = chomp_(`hostname`);
-my $label_host = new Gtk::Label($hostname);
-$hbox2->pack_start($label_host,0,0,0);
-
-#$vbox1->pack_start(new Gtk::HSeparator,1,1,5);
-
-my $frame1 = new Gtk::Frame (_("Internet access"));
-$vbox1->pack_start($frame1,1,1,0);
-my $vbox_frame1 = new Gtk::VBox(0,0);
-$vbox_frame1->set_border_width(5);
-$frame1->add($vbox_frame1);
-my $table1 = new Gtk::Table (3,3, 0);
-$table1->set_border_width(5);
-$table1->set_row_spacings(5);
-$table1->set_col_spacings(5);
-#$table1->border_width(10);
-$vbox_frame1->pack_start($table1,1,1,0);
-#attach (table, child, left_attach, right_attach, top_attach, bottom_attach, xoptions, yoptions, xpadding, ypadding)
-#$table->attach($button[0], 0, 1, 0, 1, {expand=>1,fill=>1}, {expand=>1,fill=>1},0,0);
-$table1->attach(new Gtk::Label(_("Type:")), 0, 1, 0, 1, 'fill', 'fill',0,0);
-my $label4 = new Gtk::Label($netcnx->{type});
-$table1->attach($label4, 1, 2, 0, 1, 'fill', 'fill',0,0);
-my $label5 = new Gtk::Label($netcnx->{type} eq 'lan' ? _("Gateway:") : _("Interface:"));
-$table1->attach($label5, 0, 1, 1, 2, 'fill', 'fill',0,0);
-my $label6 = new Gtk::Label($netcnx->{type} eq 'lan' ? $netc->{GATEWAY} : $netcnx->{NET_INTERFACE});
-$table1->attach($label6, 1, 2, 1, 2, 'fill', 'fill',0,0);
-my $isconnected = -1;
-#-sub connected_local {
-#- print "in connected local\n";
-#- my $w = $in->wait_message('', _("Testing your connection..."), 1);
-#- Gtk->main_iteration while Gtk->events_pending;
-#- $isconnected = connected();
-#-}
-my $label7 = new Gtk::Label(_("Status:"));
-$table1->attach($label7, 0, 1, 2, 3, 'fill', 'fill',0,0);
-my $label8 = new Gtk::Label(_("Testing your connection..."));
-$table1->attach($label8, 1, 2, 2, 3, 'fill', 'fill',0,0);
-
-my $warning_label1 = new Gtk::Label("");
-$vbox_frame1->pack_start($warning_label1,0,0,0);
-my $button2 = new Gtk::Button(_("Wait please"));
-$button2->set_sensitive(0);
-$button2->signal_connect(clicked => sub {
- if (!$isconnected && cat_($connect_prog) =~ m|/usr/bin/kppp| && -e '/usr/bin/kppp') {
- run_program::rooted($prefix, "/usr/bin/kppp &");
- } elsif (!$isconnected) {
- connect_backend();
- } else {
- disconnect_backend();
- }
- update2();
- });
-
-$table1->attach($button2, 2, 3, 2, 3, 'fill', 'fill',0,0);
-
-#$table1->attach($button1, 2, 3, 1, 2, 'fill', 'fill',0,0);
-
-my $hbox_frame1_button = new Gtk::HBox(0,0);
-my $button1 = new Gtk::Button(_("Configure Internet Access..."));
-$button1->signal_connect(clicked => [ \&configure_net, '', $netcnx, $netc, $intf]);
-$hbox_frame1_button->pack_start($button1, 0, 0, 0);
-$vbox_frame1->pack_start($hbox_frame1_button,0,0,0);
-
-#$vbox1->pack_start(new Gtk::HSeparator,1,1,5);
-
-my $frame2 = new Gtk::Frame (_("LAN configuration"));
-$vbox1->pack_start($frame2,1,1,0);
-my $vbox2 = new Gtk::VBox(0,0);
-$vbox2->set_border_width(5);
-$frame2->add($vbox2);
-my $clist1 = new_with_titles Gtk::CList("", _("Interface"), _("IP address"), _("Protocol"), _("Driver"), _("State"));
-$clist1->set_column_auto_resize($_,1) foreach (0..4);
-$clist1->column_titles_passive();
-$clist1->set_shadow_type('etched_out');
-$vbox2->pack_start($clist1, 0, 0, 5);
-#$scrolled1->add_with_viewport($table2);
-
-my $ip_regexp = qr/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/;
-
-build_clist();
-
-my $hbox3 = new Gtk::HBox(0,0);
-my $button3 = new Gtk::Button(_("Configure Local Area Network..."));
-$button3->signal_connect(clicked => [ \&configure_lan, '', $netcnx, $netc, $intf]);
-$hbox3->pack_start($button3, 0, 0, 0);
-$vbox2->pack_start($hbox3, 0, 0, 0);
-
-#$vbox1->pack_start(new Gtk::HSeparator,0,0,5);
-
-my $bbox0 = new Gtk::HButtonBox;
-$vbox1->pack_start($bbox0,0,0,0);
-$bbox0->set_layout(-end);
-
-
-$bbox0->add(new Gtk::Label(_("Click here to launch the wizard ->")));
-my $button_wizard = new Gtk::Button _("Wizard...");
-$button_wizard->signal_connect(clicked => sub {
- $::isWizard = 1;
- system("drakconnect --wizard");
-# netconnect::intro('', $netcnx, $in);
- $combo1->entry->set_text((-e "/etc/sysconfig/network-scripts/drakconnect_conf." . $combo1->entry->get_text) ? $combo1->entry->get_text : "default");
- network::netconnect::load_conf($netcnx, $netc, $intf);
- update();
- });
-$bbox0->add($button_wizard);
-
-$vbox1->pack_start(new Gtk::HSeparator,0,0,5);
-
-my $bbox1 = new Gtk::HButtonBox;
-$vbox1->pack_start($bbox1,0,0,0);
-$bbox1->set_layout(-end);
-#$bbox1->set_border_width(5);
-
-my $button_expert = new Gtk::Button _("Expert Mode");
-$button_expert->signal_connect (clicked => sub {
- foreach ($button1, $button3) { $expert_mode ? $_->hide() : $_->show() }
- $button_expert->child->set($expert_mode ? _("Expert Mode") : _("Normal Mode"));
- $expert_mode = !$expert_mode;
- });
-$bbox1->add($button_expert);
-
-my $button_apply = new Gtk::Button _("Apply");
-$button_apply->signal_connect (clicked => sub {
- apply();
- });
-$button_apply->set_sensitive(0);
-$bbox1->add($button_apply);
-
-my $button_cancel = new Gtk::Button _("Cancel");
-$button_cancel->signal_connect (clicked => sub {
- $combo1->entry->set_text($old_profile);
- update();
- quit_global();
- });
-$bbox1->add($button_cancel);
-my $button_ok = new Gtk::Button _("OK");
-$button_ok->signal_connect (clicked => sub {
- my $dialog = new Gtk::Dialog();
- $dialog->set_position(1);
- $dialog->vbox->set_border_width(10);
- my $label = new Gtk::Label(_("Please Wait... Applying the configuration"));
- $dialog->signal_connect (delete_event => sub { Gtk->main_quit() });
- $dialog->vbox->pack_start($label,1,1,20);
- $dialog->show_all;
- Gtk->main_iteration while Gtk->events_pending;
- apply();
- $dialog->destroy;
- update();
- quit_global();
- });
-$bbox1->add($button_ok);
-$combo1->entry->signal_connect('changed', sub {
-# connected() and disconnect_backend();
- network::netconnect::set_profile($netcnx, $combo1->entry->get_text());
- network::netconnect::load_conf($netcnx, $netc, $intf);
- $netcnx->{$_} = $netc->{$_} foreach qw(NET_DEVICE NET_INTERFACE);
- network::netconnect::set_net_conf($netcnx, $netc);
- update();
- $button_apply->set_sensitive(1);
- });
-
-$window1->show_all();
-$_->hide foreach ($button1, $button3);
-Gtk->main_iteration while Gtk->events_pending;
-$::isEmbedded and kill 'USR2', $::CCPID;
-my $tag = Gtk->timeout_add(4000, \&update2);
-Gtk->main;
-Gtk->exit(0);
-
-dd:
-network::netconnect::intro('', $netcnx, $in);
-$in->exit(0);
-
-sub build_clist {
- foreach my $i (0..$#all_cards) {
- my $ip;
- if (-e "/sbin/ifconfig") {
- local $_ = `LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C /sbin/ifconfig "eth$i"`;
- /inet addr\:$ip_regexp/; $ip = if_($1 && $2 && $3, "$1.$2.$3.$4");
- $_ = `LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C /sbin/ifconfig`;
- $state = /eth$i/ ? "up" : "down";
- } else { $ip = $intf->{"eth$_"}{IPADDR}; $state = "n/a" }
- $clist1->append("", "eth$i", $ip , $intf->{"eth$i"}{BOOTPROTO}, $all_cards[$i]->[1], $state);
- $clist1->set_pixmap ($i, 0, gtkcreate_png("eth_card_mini2.png"));
-
- $clist1->set_selectable($i, 0);
- }
-}
-
-sub apply {
- $old_profile = $netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default";
- network::netconnect::save_conf($netcnx, $netc, $intf);
-
- $netcnx->{type} eq 'modem' and any::pppConfig($in, $netcnx->{$netcnx->{type}}, '');
- $netcnx->{type} eq 'isdn_internal' and network::isdn::isdn_write_config_backend($netcnx->{$netcnx->{type}}, 1, $netc, $netcnx); #$light
- $netcnx->{type} eq 'isdn_external' and any::pppConfig($in, $netcnx->{$netcnx->{type}}, '');
- my $a = $netcnx->{type};
- $a =~ s/adsl_//;
- $netcnx->{type} =~ 'adsl' and network::adsl::adsl_conf_backend($netcnx->{$netcnx->{type}}, $netc, $a, $netcnx);
-
- $netcnx->{dhcp_client} and $netc->{dhcp_client} = $netcnx->{dhcp_client};
- network::configureNetwork2($in, $prefix, $netc, $intf);
- $netcnx->{type} =~ /adsl/ or system("/sbin/chkconfig --del adsl 2> /dev/null");
- $netcnx->{type} !~ /adsl_p/ and system("$prefix/etc/rc.d/init.d/network restart");
- $button_apply->set_sensitive(0);
-}
-
-sub ethisup { `LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C /sbin/ifconfig` =~ /eth$_[0]/ }
-
-my $to_update;
-sub update {
- my $h = chomp_(`hostname`);
- $label_host->set ($h);
- $label4->set($netcnx->{type});
- $label5->set($netcnx->{type} eq 'lan' ? _("Gateway:") : _("Interface:"));
- $label6->set($netcnx->{type} eq 'lan' ? $netc->{GATEWAY} : $netcnx->{NET_INTERFACE});
- $clist1->freeze();
- $clist1->clear();
- build_clist();
- $clist1->thaw();
- $button_del->set_sensitive(network::netconnect::get_profiles() > 1);
- $isconnected !=-1 or return 1;
- $label8->set($isconnected ? _("Connected") : _("Not connected"));
- $button2->child->set($isconnected ? _("Disconnect...") : _("Connect..."));
- $button2->set_sensitive(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(_("Warning, another Internet connection has been detected, maybe using your network"));
- $isconnected = 0;
- } else { $warning_label1->set("") }
- $label8->set($isconnected ? _("Connected") : _("Not connected"));
- $button2->child->set($isconnected ? _("Disconnect...") : _("Connect..."));
- $button2->set_sensitive(1);
- }
- }
- update();
- 1;
-}
-
-sub quit_global {
- $::isEmbedded ? kill('USR1', $::CCPID) : Gtk->exit(0);
-}
-
-sub configure_lan {
- my (undef, $prefix, $netcnx, $netc, $intf) = @_;
- my $window = new Gtk::Window -toplevel;
-
- my @card_tab;
-
- if (@all_cards < 1) {
- my $dialog = new Gtk::Dialog();
- $dialog->set_position(1);
- $dialog->vbox->set_border_width(10);
- $dialog->signal_connect (delete_event => sub { Gtk->main_quit() });
- $dialog->vbox->pack_start(new Gtk::Label(_("You don't have any configured interface.
-Configure them first by clicking on 'Configure'")),1,1,0);
- my $bbox_dialog = new Gtk::HButtonBox;
- $dialog->action_area->add($bbox_dialog);
- $bbox_dialog->set_layout(-end);
- my $button_ok = new Gtk::Button _("OK");
- $button_ok->signal_connect (clicked => sub { Gtk->main_quit() });
- $bbox_dialog->add($button_ok);
- $dialog->show_all;
- $dialog->set_modal(1);
- Gtk->main();
- $dialog->destroy;
- return;
- }
-
- $window->set_policy (1, 1, 1);
- $window->signal_connect (delete_event => sub { Gtk->main_quit });
- $window->set_position(1);
- $window->set_title(_("LAN configuration"));
- $window->border_width(10);
- my $vbox1 = new Gtk::VBox(0,0);
- $window->add($vbox1);
- $vbox1->pack_start(new Gtk::Label(_("LAN Configuration")),0,1,0);
- my $notebook = new Gtk::Notebook;
- $vbox1->pack_start($notebook,0,1,0);
- my @eth_data;
- foreach (0..$#all_cards) {
- my @infos;
- my @conf_data;
- $card_tab[2*$_] = \@infos;
- $card_tab[2*$_+1] = \@conf_data;
- my $vbox_local = new Gtk::VBox(0,0);
- $vbox_local->set_border_width(10);
- $vbox_local->pack_start(new Gtk::Label(_("Adapter %s: %s", $_+1 , "eth$_")),1,1,0);
- # Eth${_}Hostname = $netc->{HOSTNAME}
- # Eth${_}HostAlias = " . do { $netc->{HOSTNAME} =~ /([^\.]*)\./; $1 } . "
- # Eth${_}Driver = $all_cards[$_]->[1]
- @conf_data = ([_("IP address"), \$intf->{"eth$_"}{IPADDR}],
- [_("Netmask"), \$intf->{"eth$_"}{NETMASK}],
- [_("Boot Protocol"), \$intf->{"eth$_"}{BOOTPROTO}, ["static", "dhcp", "bootp"]],
- [_("Started on boot"), \$intf->{"eth$_"}{ONBOOT} , ["yes", "no"]],
- [_("DHCP client"), \$netcnx->{dhcp_client}]
- );
- my $i = 0;
- foreach my $j (@conf_data) {
- $infos[2*$i] = new Gtk::HBox(0,0);
- my $l = new Gtk::Label($j->[0]);
- $l->set_justify('left');
- $infos[2*$i]->pack_start($l,1,1,0);
- $vbox_local->pack_start($infos[2*$i],0,0,0);
- if (defined $j->[2]) {
- my $c = new Gtk::Combo();
- $c->set_popdown_strings(@{$j->[2]});
- $infos[2*$i+1] = $c->entry;
- $infos[2*$i+1]->set_editable(0);
- $infos[2*$i]->pack_start($c,0,0,0);
- } else {
- $infos[2*$i+1] = new Gtk::Entry();
- $infos[2*$i]->pack_start($infos[2*$i+1],0,0,0);
- }
- $infos[2*$i+1]->set_text(${$j->[1]});
- $i++;
- }
- my $c = $_;
- my $widget_temp;
- if (-e "$prefix/etc/sysconfig/network-scripts/ifcfg-eth$c") {
- $widget_temp = gtksignal_connect(new Gtk::Button(ethisup($c) ? _("deactivate now") : _("activate now")),
- clicked => sub {
- system("/sbin/if".(ethisup($c)?"down" : "up")." eth$c");
- gtkbuttonset($_[0], ethisup($c)? _("deactivate now") : _("activate now"));
- });
- } else {
- $widget_temp = _("This interface has not been configured yet.\nLaunch the configuration wizard in the main window");
- }
- $vbox_local->pack_start(gtkpack__(new Gtk::HBox(0,0),
- $widget_temp
- ),0,0,0);
- # $clist1->append($_+1, "eth$_", $intf->{"eth$_"}{IPADDR}, $intf->{"eth$_"}{BOOTPROTO}, $all_cards[$_]->[1]);
- # $clist1->set_selectable($_, 0);
-# require Data::Dumper;
-# print "------------\n" . Data::Dumper->Dump([$b],['b']) . "\n";
- my $hbox_local = new Gtk::HBox(0,0);
- my $pix = gtkpng("/usr/share/libDrakX/pixmaps/eth_card_mini.png");
- $hbox_local->pack_start($pix,0,0,0);
- $hbox_local->pack_start(new Gtk::Label("eth$_"),0,0,0);
- $hbox_local->show_all;
- $notebook->append_page($vbox_local, $hbox_local);
- }
- my $bbox1 = new Gtk::HButtonBox;
- $vbox1->pack_start($bbox1,0,0,10);
- $bbox1->set_layout(-end);
- my $button_ok = new Gtk::Button(_("OK"));
- $button_ok->signal_connect (clicked => sub {
- foreach (0..$#all_cards) {
- my $i = 0;
- my @infos = @{$card_tab[2*$_]};
- my @conf_data = @{$card_tab[2*$_+1]};
- foreach my $j (@conf_data) {
- ${$j->[1]} = $infos[2*$i+1]->get_text();
- $i++;
- }
- }
- update();
- $button_apply->set_sensitive(1);
- $window->destroy(); Gtk->main_quit;
- });
- $bbox1->add($button_ok);
- my $button_cancel = new Gtk::Button(_("Cancel"));
- $button_cancel->signal_connect (clicked => sub { $window->destroy(); Gtk->main_quit });
- $bbox1->add($button_cancel);
-
- $window->set_modal(1);
- $window->show_all();
- foreach (0..$#all_cards) {
- my @infos = @{$card_tab[2*$_]};
- $intf->{"eth$_"}{BOOTPROTO} eq "dhcp" or $infos[8]->hide;
- }
- $window->set_position('center_always');
- Gtk->main;
-}
-
-
-sub configure_net {
- my (undef, $prefix, $netcnx, $netc, $intf) = @_;
- if (!$netcnx->{type}) {
- my $dialog = new Gtk::Dialog();
- $dialog->set_position(1);
- $dialog->vbox->set_border_width(10);
- $dialog->signal_connect (delete_event => sub { Gtk->main_quit() });
- $dialog->vbox->pack_start(new Gtk::Label(_("You don't have any internet connection.
-Create one first by clicking on 'Configure'")),1,1,0);
- my $bbox_dialog = new Gtk::HButtonBox;
- $dialog->action_area->add($bbox_dialog);
- $bbox_dialog->set_layout(-end);
- my $button_ok = new Gtk::Button _("OK");
- $button_ok->signal_connect (clicked => sub {
- Gtk->main_quit();
- });
- $bbox_dialog->add($button_ok);
- $dialog->show_all;
- $dialog->set_modal(1);
- Gtk->main();
- $dialog->destroy;
- return;
- }
- my $cnx = {};
- my @infos;
- $cnx = $netcnx->{$netcnx->{type}};
- my $auto_detect = {};
- my $window = new Gtk::Window -toplevel;
- $window->set_policy (1, 1, 1);
- $window->signal_connect (delete_event => sub { Gtk->main_quit });
- $window->set_position(1);
- $window->set_title(_("Internet connection configuration"));
- $window->border_width(10);
- my $vbox1 = new Gtk::VBox(0,0);
- $window->add($vbox1);
- $vbox1->pack_start(new Gtk::Label(_("Internet Connection Configuration")),0,1,0);
-
- $vbox1->pack_start(new Gtk::HSeparator,0,0,5);
- my $table1 = new Gtk::Table (2, 4, 0);
- $table1->set_row_spacings(5);
- $table1->set_col_spacings(5);
- $vbox1->pack_start($table1,0,0,0);
- $table1->attach(new Gtk::Label(_("Profile: ")), 0, 1, 0, 1, 'fill', 'fill',0,0);
- $table1->attach(new Gtk::Label(_($netcnx->{PROFILE})), 1, 2, 0, 1, 'fill', 'fill',0,0);
- $table1->attach(new Gtk::Label(_("Connection type: ")), 0, 1, 1, 2, 'fill', 'fill',0,0);
- $table1->attach(new Gtk::Label(_($netcnx->{type})), 1, 2, 1, 2, 'fill', 'fill',0,0);
-# my $button1 = new Gtk::Button(_("Reconfigure using wizard..."));
-# $table1->attach($button1, 2, 4, 0, 2, 'fill', 'fill',0,0);
- $vbox1->pack_start(new Gtk::HSeparator,0,0,5);
-
- my $frame1 = new Gtk::Frame (_("Parameters"));
- $vbox1->pack_start($frame1,1,1,0);
- my $vbox2 = new Gtk::VBox(0,0);
- $frame1->add($vbox2);
- my $i = 0;
- my @conf_data = ([_("Card IRQ"), \$cnx->{irq} ],
- [_("Card mem (DMA)"), \$cnx->{mem} ],
- [_("Card IO"), \$cnx->{io} ],
- [_("Card IO_0"), \$cnx->{io0} ],
- [_("Card IO_1"), \$cnx->{io1} ],
- [_("Your personal phone number"), \$cnx->{phone_in} ],
- [_("Provider name (ex provider.net)"), \$netc->{DOMAINNAME2}],
- [_("Provider phone number"), \$cnx->{phone_out} ],
- [_("Provider dns 1 (optional)"), \$netc->{dnsServer2}],
- [_("Provider dns 2 (optional)"), \$netc->{dnsServer3}],
- [_("Account Login (user name)"), \$cnx->{login} ],
- [_("Account Password"), \$cnx->{passwd} ],
- [_("Dialing mode"), \$cnx->{dialing_mode}, [ "auto", "manual"] ],
- [_("Gateway"), \$netc->{GATEWAY}],
- [_("Connection name"), \$cnx->{connection} ],
- [_("Phone number"), \$cnx->{phone} ],
- [_("Login ID"), \$cnx->{login} ],
- [_("Password"), \$cnx->{passwd} ],
- [_("Authentication"), \$cnx->{auth}, [ _("PAP"), _("Terminal-based"), _("Script-based"), __("CHAP") ] ],
- [_("Domain name"), \$cnx->{domain} ],
- [_("First DNS Server (optional)"), \$cnx->{dns1} ],
- [_("Second DNS Server (optional)"), \$cnx->{dns2} ],
- [_("Ethernet Card"), \$netc->{NET_DEVICE}, [ 'eth0', 'eth1', 'eth2', 'eth3', 'eth4', 'eth5','eth6', 'eth7', 'eth8', 'eth9' ]],
- [_("DHCP Client"), \$netcnx->{dhcp_client}, ["dhcpcd", "dhcpxd", "dhcp-client"] ],
- [_("Connection speed"), \$cnx->{speed}, ["64 Kb/s", "128 Kb/s"]],
- [_("Connection timeout (in sec)"), \$cnx->{huptimeout} ]
-);
- foreach (@conf_data) {
- $infos[2*$i] = new Gtk::HBox(0,0);
- my $l = new Gtk::Label($_->[0]);
- $l->set_justify('left');
- $infos[2*$i]->pack_start($l,1,1,0);
- $vbox2->pack_start($infos[2*$i],0,0,0);
- if (defined $_->[2]) {
- my $c = new Gtk::Combo();
- $c->set_popdown_strings(@{$_->[2]});
- $infos[2*$i+1] = $c->entry;
- $infos[2*$i]->pack_start($c,0,0,0);
- } else {
- $infos[2*$i+1] = new Gtk::Entry();
- $infos[2*$i]->pack_start($infos[2*$i+1],0,0,0);
- #hide password if Entry Password
- if ($_->[0] eq _("Account Password") || $_->[0] eq _("Password")) { $infos[2*$i+1]->set_visibility(0) };
- }
- $infos[2*$i+1]->set_text(${$_->[1]});
- $i++;
- }
- my @mask;
-@mask = (0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0) if $netcnx->{type} eq 'lan';
-@mask = (0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,1) if $netcnx->{type} eq'isdn_internal'&& defined $cnx->{vendor} && defined $cnx->{id};
-@mask = (1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,1) if $netcnx->{type} eq'isdn_internal'&&(!defined $cnx->{vendor}||!defined $cnx->{id});
-@mask = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0) if ($netcnx->{type} eq 'modem'||$netcnx->{type} eq 'isdn_external');
-@mask = (0,0,0,0,0,0,1,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0) if $netcnx->{type} =~ 'adsl';
-@mask = (0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0) if $netcnx->{type} eq 'cable';
- $vbox1->pack_start(new Gtk::HSeparator,0,0,5);
-
-
- my $bbox1 = new Gtk::HButtonBox;
- $vbox1->pack_start($bbox1,0,0,0);
- $bbox1->set_layout(-end);
- my $button_ok = new Gtk::Button _("OK");
- $button_ok->signal_connect (clicked => sub {
- $i = 0;
- foreach (@mask) {
- ${$conf_data[$i]->[1]} = $infos[2*$i+1]->get_text() if ($_);
- $i++;
- }
- update();
- $button_apply->set_sensitive(1);
- $window->destroy(); Gtk->main_quit;
- });
- $bbox1->add($button_ok);
- my $button_cancel = new Gtk::Button _("Cancel");
- $button_cancel->signal_connect (clicked => sub { $window->destroy(); Gtk->main_quit });
- $bbox1->add($button_cancel);
-
- $window->set_modal(1);
- $window->show_all();
- $i = 0;
- foreach (@mask) {
- if ($_) { $infos[2*$i]->show }
- else { $infos[2*$i]->hide }
- $i++;
- }
- $window->set_position('center_always');
- Gtk->main;
-}
diff --git a/perl-install/standalone/drakfloppy b/perl-install/standalone/drakfloppy
deleted file mode 100755
index 471beb475..000000000
--- a/perl-install/standalone/drakfloppy
+++ /dev/null
@@ -1,455 +0,0 @@
-#!/usr/bin/perl -w
-
-# Control-center
-# $Id$
-#
-# Copyright (C) 2001-2002 MandrakeSoft
-# Yves Duret <yduret at 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 POSIX;
-use Gtk;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use Config;
-use any;
-init Gtk;
-Gtk->set_locale;
-
-#-------------------------------------------------------------
-# i18n routines
-# IMPORTANT: next two routines have to be redefined here to
-# get correct namespace (drakconf instead of libDrakX)
-# (This version is now UTF8 compliant - Sg 2001-08-18)
-#-------------------------------------------------------------
-
-sub _ {
- my $s = shift @_; my $t = translate($s);
- sprintf $t, @_;
-}
-
-sub translate {
- my ($s) = @_;
- $s ? c::dgettext('drakfloppy', $s) : '';
-}
-
-if ($::isEmbedded) {
- print "EMBED\n";
- print "XID : $::XID\n";
- print "CCPID : $::CCPID\n";
-}
-
-$in = 'interactive'->vnew('su', 'default');
-local $_ = join '', @ARGV;
-
-/-h/ and die _("usage: drakfloppy\n");
-
-$expert_mode = 0;
-# we have put here the list in order to do $list->clear() when we have to do
-$fixed_font = Gtk::Gdk::Font->fontset_load(_("-misc-Fixed-Medium-r-*-*-*-140-*-*-*-*-*-*,*"));
-my @titles = ( _("Module name"), _("Size") );
-my $list = new_with_titles Gtk::CList( @titles );
-
-my $window = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel;
-$window->signal_connect( 'delete_event', sub { $::isEmbedded ? kill('USR1', $::CCPID) : Gtk->exit(0) });
-$window->set_title( _("drakfloppy") );
-$window->set_policy(1, 1, 1);
-$window->border_width (5);
-
-### menus definition
-# the menus are not shown
-# but they provides shiny shortcut like C-q
-my @menu_items = (
- { path => _("/_File"), type => '<Branch>' },
- { path => _("/File/_Quit"), accelerator => _("<control>Q"), callback => sub { $::isEmbedded ? kill('USR1', $::CCPID) : Gtk->exit(0) } },
- );
-my $menubar = get_main_menu( $window );
-
-######### menus end
-
-my $global_vbox = new Gtk::VBox();
-
-$::isEmbedded or $global_vbox->pack_start (new Gtk::Label(_("boot disk creation")), 0, 0, 0);
-
-######## up part
-my $up_vbox = new Gtk::VBox (0, 0);
-
-# device part
-my $dev_hbox = new Gtk::HBox (1, 0);
-my $device_combo = new Gtk::Combo();
-my $device_button = new Gtk::Button( _("default") );
-
-$device_combo->set_popdown_strings( "/dev/fd0", "/dev/fd1", );
-$device_button->signal_connect( 'clicked', sub { $device_combo->entry->set_text("/dev/fd0");});
-
-$dev_hbox->pack_start (new Gtk::Label( _("device") ), 0, 0, 0);
-$dev_hbox->pack_start ($device_combo, 0, 0, 0);
-$dev_hbox->pack_start ($device_button, 0, 0, 0);
-$up_vbox->pack_start ($dev_hbox, 0, 0, 0);
-
-# kernel part
-my $ker_hbox = new Gtk::HBox (1, 0);
-my $kernel_combo = new Gtk::Combo();
-my $kernel_button = new Gtk::Button( _("default") );
-$kernel_combo->disable_activate();
-$kernel_combo->set_popdown_strings( do {
- opendir YREP, "/lib/modules" or die _("DrakFloppy Error: %s", $!);
- my @files_modules = grep !/^\.\.?$/, readdir YREP;
- closedir YREP;
- @files_modules;
-});
-#$kernel_combo->entry->set_text(`uname -r`);
-$kernel_combo->entry->signal_connect( "changed", sub { change_tree($kernel_combo->entry->get_text()); $list->clear();});
-$aaaa= `uname -r`;
-chomp ($aaaa);
-$kernel_button->signal_connect( 'clicked', sub { $kernel_combo->entry->set_text($aaaa); $list->clear(); });
-
-$ker_hbox->pack_start (new Gtk::Label( _("kernel version") ), 0, 0, 0);
-$ker_hbox->pack_start ($kernel_combo, 0, 0, 0);
-$ker_hbox->pack_start ($kernel_button, 0, 0, 0);
-$up_vbox->pack_start ($ker_hbox, 0, 0, 5);
-
-# vbox part
-my $up_frame = new Gtk::Frame( _("General") );
-$up_frame->add($up_vbox);
-$global_vbox->pack_start ($up_frame, 1, 1, 0);
-
-### expert mode
-my $expert_main_frame = new Gtk::Frame( _("Expert Area") );
-my $expert_dedans = new Gtk::VBox( 0, 5 );
-$expert_dedans->border_width (5);
-my $expert_button_frame = new Gtk::Frame( _("mkinitrd optional arguments") );
-my $expert_mod_frame = new Gtk::Frame( _("Add a module") );
-my $expert_pane = new Gtk::HPaned();
-$expert_pane->set_handle_size( 10 );
-$expert_pane->set_gutter_size( 8 );
-
-my $expert_button = new Gtk::Button( _("Expert Mode") );
-$expert_button->signal_connect( "clicked", sub {
- if ($expert_mode) {
- $expert_mod_frame->hide();
- $expert_button_frame->hide()
- } else {
- $expert_mod_frame->show();
- $expert_button_frame->show();
- }
- $expert_mode = !$expert_mode;
- });
-
-my $expert_button_vbox = new Gtk::VBox(0, 5);
-my $expert_button_hbox = new Gtk::HBox(0, 5);
-my $expert_button_hbox2 = new Gtk::HBox(0, 5);
-my $force_button = new Gtk::ToggleButton( _("force") );
-my $needed_button = new Gtk::ToggleButton( _("if needed") );
-my $scsi_button = new Gtk::ToggleButton( _("omit scsi modules") );
-my $raid_button = new Gtk::ToggleButton( _("omit raid modules") );
-$expert_button_hbox->pack_start( $force_button, 0, 0, 0 );
-$expert_button_hbox->pack_start( $raid_button, 0, 0, 0 );
-
-$expert_button_hbox2->pack_start( $needed_button, 0, 0, 0 );
-$expert_button_hbox2->pack_start( $scsi_button, 0, 0, 0 );
-
-$expert_button_vbox->pack_start($expert_button_hbox, 0, 0, 0);
-$expert_button_vbox->pack_start($expert_button_hbox2, 0, 0, 0);
-$expert_button_frame->add($expert_button_vbox);
-$expert_dedans->pack_start ($expert_button_frame, 0, 0, 0);
-$expert_mod_frame->add($expert_pane);
-$expert_dedans->pack_start ($expert_mod_frame, 1, 1, 0);
-$expert_main_frame->add($expert_dedans);
-$global_vbox->pack_start ($expert_main_frame, 1, 1, 0);
-
-### the tree
-
-# Create a ScrolledWindow for the tree
-my $tree_scrolled_win = new Gtk::ScrolledWindow();
-$tree_scrolled_win->set_usize( 200, $::isEmbedded ? 0 : 175);
-$expert_pane->add1( $tree_scrolled_win );
-$tree_scrolled_win->set_policy( 'automatic', 'automatic' );
-
-# Create root tree
-my $tree = new Gtk::Tree();
-my $leaf;
-my $root_dir;
-$tree_scrolled_win->add_with_viewport( $tree );
-$tree->set_selection_mode( 'single' );
-$tree->set_view_mode( 'item' );
-
-fill_tree ($kernel_combo->entry->get_text());
-
-# Create a ScrolledWindow for the list
-my $list_scrolled_win = new Gtk::ScrolledWindow( undef, undef );
-my $rmmod_button = new Gtk::Button( _("Remove a module") );
-my $expert_inside_pane2 = new Gtk::VBox (0, 0);
-my $list_selected_row;
-
-$expert_inside_pane2->pack_start ($list_scrolled_win, 1, 1, 0);
-$expert_inside_pane2->pack_start ($rmmod_button, 0, 0, 0);
-$expert_pane->add2( $expert_inside_pane2 );
-$list_scrolled_win->set_policy( 'automatic', 'automatic' );
-$rmmod_button->signal_connect('clicked', sub {$list->remove($list_selected_row);});
-
-# Create list box
-########################################################## from here my $list
-$list->signal_connect('select_row', sub { (undef, $list_selected_row) = @_; });
-$list_scrolled_win->add( $list );
-$list->set_column_justification(1, 'right');
-$list->set_column_width( 0, 200 );
-$list->set_column_width( 1, 50 );
-$list->set_selection_mode( 'single' );
-$list->set_shadow_type( 'none' );
-$list->show();
-
-### output
-my $output_frame = new Gtk::Frame( _("Output") );
-my $output = new Gtk::Text( undef, undef );
-my $vscrollbar = new Gtk::VScrollbar( $output->vadj );
-my $output_hbox = new Gtk::HBox (0, 0);
-$output_hbox->border_width (5);
-$output_hbox->set_usize( 30, 75 );
-$output_hbox->pack_start( $output, 1, 1, 0 );
-$output_hbox->pack_start( $vscrollbar, 0, 0, 0 );
-$output_frame->add ($output_hbox);
-$global_vbox->pack_start ($output_frame, 0, 0, 0);
-
-### final buttons
-my $build_button = new Gtk::Button( _("Build the disk") );
-my $cancel_button = new Gtk::Button( _("Cancel") );
-my $fin_hbox = new Gtk::HBox( 0, 0 );
-$cancel_button->signal_connect( clicked=> sub {$::isEmbedded ? kill('USR1', $::CCPID) : Gtk->exit(0)});
-$build_button->signal_connect('clicked', \&build_it);
-$fin_hbox->pack_end($cancel_button, 0, 0, 0);
-$fin_hbox->pack_end($build_button, 0, 0, 10);
-$fin_hbox->pack_end($expert_button, 0, 0, 10);
-$global_vbox->pack_start ($fin_hbox, 0, 0, 0);
-
-### back to window
-$window->add( $global_vbox );
-
-$window->show_all();
-$expert_mod_frame->hide();
-$expert_button_frame->hide();
-
-Gtk->main_iteration while Gtk->events_pending;
-$::isEmbedded and kill 'USR2', $::CCPID;
-Gtk->main;
-
-
-
-#-------------------------------------------------------------
-# tree functions
-#-------------------------------------------------------------
-### Subroutines
-
-sub fill_tree {
- ($root_dir) = @_;
- $root_dir = "/lib/modules/" . $root_dir;
- # Create root tree item widget
- $leaf = new_with_label Gtk::TreeItem( $root_dir );
- $tree->append( $leaf );
- $leaf->signal_connect( 'select', \&select_item, $root_dir );
- $leaf->set_user_data( $root_dir );
-
- # Create the subtree
- if ( has_sub_trees( $root_dir ) ) {
- my $subtree = new Gtk::Tree();
- $leaf->set_subtree( $subtree );
- $leaf->signal_connect( 'expand', \&expand_tree, $subtree );
- $leaf->signal_connect( 'collapse', \&collapse_tree );
- $leaf->expand();
- }
-}
-
-sub change_tree {
- $leaf->destroy();
- fill_tree (@_);
- $leaf->show();
-}
-
-# Callback for expanding a tree - find subdirectories, files and add them to tree
-sub expand_tree
- {
- my ( $item, $subtree ) = @_;
-
- my $dir_entry;
- my $path;
- my $item_new;
- my $new_subtree;
-
- my $dir = $item->get_user_data();
-
- chdir( $dir );
-
- foreach $dir_entry ( <*> ) {
- if (( -d $dir_entry ) or ( $dir_entry =~ /\.o(\.gz)?$/)) {
- $path = $dir . "/" . $dir_entry;
- $path =~ s|//|/|g;
- $item_new = new_with_label Gtk::TreeItem( $dir_entry );
- $item_new->set_user_data( $path );
- $item_new->signal_connect( 'select', \&select_item, $path );
- $subtree->append( $item_new );
- $item_new->show();
-
- if ( has_sub_trees( $path ) ) {
- $new_subtree = new Gtk::Tree();
- $item_new->set_subtree( $new_subtree );
- $item_new->signal_connect( 'expand', \&expand_tree, $new_subtree );
- $item_new->signal_connect( 'collapse', \&collapse_tree );
- }
- }
- }
- chdir( ".." );
- }
-
-
-# Callback for collapsing a tree -- removes the subtree
-sub collapse_tree
- {
- my ( $item ) = @_;
- my $subtree = new Gtk::Tree();
-
- $item->remove_subtree();
- $item->set_subtree( $subtree );
- $item->signal_connect( 'expand', \&expand_tree, $subtree );
- }
-
-# Called whenever an item is clicked on the tree widget.
-sub select_item {
- my ( $widget, $file ) = @_;
- return if (-d $file);
- my $size = ( lstat( $file ) )[ 7 ];
- my $lr = $list->rows();
- my $i;
- $file =~ s|/lib/modules/.*?/||g;
- for ($i=0; $i < $lr; $i++) {
- last if ($file eq $list->get_text($i, 0));
- }
- print $file,"\n";
-
- $list->append($file, $size) if ($i == $lr) or ($lr == 0);
-}
-
-#-------------------------------------------------------------
-# menu callback functions
-#-------------------------------------------------------------
-
-sub print_hello {
- print "mcdtg !\n";
-}
-
-sub get_main_menu {
- my ( $window ) = @_;
- my $accel_group = new Gtk::AccelGroup();
- my $item_factory = new Gtk::ItemFactory( 'Gtk::MenuBar', '<main>', $accel_group );
- $item_factory->create_items( @menu_items );
- $window->add_accel_group( $accel_group );
- return ( $item_factory->get_widget( '<main>' ) );
-}
-
-
-sub create_dialog {
- my ( $label, $c ) = @_;
- my $ret = 0;
- my $dialog = new Gtk::Dialog;
- $dialog->signal_connect ( delete_event => sub {Gtk->main_quit();});
- $dialog->set_title(_("drakfloppy"));
- $dialog->border_width(10);
- $dialog->vbox->pack_start(new Gtk::Label($label),1,1,0);
-
- my $button = new Gtk::Button _("OK");
- $button->can_default(1);
- $button->signal_connect(clicked => sub { $ret = 1; $dialog->destroy(); Gtk->main_quit(); });
- $dialog->action_area->pack_start($button, 1, 1, 0);
- $button->grab_default;
-
- if ($c) {
- my $button2 = new Gtk::Button _("Cancel");
- $button2->signal_connect(clicked => sub { $ret = 0; $dialog->destroy(); Gtk->main_quit(); });
- $button2->can_default(1);
- $dialog->action_area->pack_start($button2, 1, 1, 0);
- }
-
- $dialog->show_all;
- Gtk->main();
- $ret;
-}
-
-sub destroy_window {
- my($widget, $windowref, $w2) = @_;
- $$windowref = undef;
- $w2 = undef if defined $w2;
- 0;
-}
-
-
-#-------------------------------------------------------------
-# the function
-#-------------------------------------------------------------
-sub build_it {
- my $y;
- my $co = "/sbin/mkbootdisk --noprompt --verbose --device ". $device_combo->entry->get_text();
- if ($expert_mode) {
- $co .= " --mkinitrdargs -f" if $force_button->get_active;
- $co .= " --mkinitrdargs --ifneeded" if $needed_button->get_active;
- $co .= " --mkinitrdargs --omit-scsi-modules" if $scsi_button->get_active;
- $co .= " --mkinitrdargs --omit-raid-modules" if $raid_button->get_active;
- for (my $i=0; $i<$list->rows(); $i++) {
- $y = $list->get_text($i, 0);
- $y =~ s|.*?/||g;
- $co .= " --mkinitrdargs --with=" . $y; #. "/usr/lib/" . $kernel_combo->entry->get_text() . "/" . $y;
- }
- }
- $co .= " " . $kernel_combo->entry->get_text();
- $co .= " 2>&1 |";
- create_dialog(_("Be sure a media is present for the device %s", $device_combo->entry->get_text()), 1) 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 ($b =~ "dd") {create_dialog(_("There is no medium or it is write-protected for device %s.\nPlease insert one.", $device_combo->entry->get_text()), 1) ? goto test : return 0; }
-
- open STATUS, $co or do { create_dialog(_("Unable to fork: %s", $!), 0); return; };
- while (<STATUS>) {
- $output->insert( $fixed_font, undef, undef, $_ );
- }
- close STATUS or create_dialog(_("Unable to close properly mkbootdisk: \n %s \n %s", $!, $?), 0);
-
- return (0);
-}
-
-####
-# 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 ) = @_;
- my $file;
-
- foreach $file ( <$dir/*> ) {
- return 1 if ( -d $file ) or ($file =~ /\.o(\.gz)?$/);
- }
-
- return (0);
- }
-
diff --git a/perl-install/standalone/drakfont b/perl-install/standalone/drakfont
deleted file mode 100755
index 38a365261..000000000
--- a/perl-install/standalone/drakfont
+++ /dev/null
@@ -1,1264 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright (C) 2001 by MandrakeSoft (sdupont@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 doublon) but don't import if already exist.
-# - import from directory
-# look for if it exist before for each font and not delete the original.
-# (replace all, no, none)
-# expert options:
-# ask the directory, and look for if it exist before
-# if it exist 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:
-# - abiword, Koffice, Gnumeric, ...
-# - Speedo and Bitmap (PCF, BDF, and SNF)
-# - option strong: strong verification with ttmkfdir -c ?
-#
-# 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 Gtk;
-use lib qw(/usr/lib/libDrakX );
-
-use standalone
- ; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use my_gtk qw(:helpers :wrappers);
-use common;
-
-#use strict;
-#use Config;
-#use POSIX;
-
-my $in = 'interactive'->vnew( 'su', 'network' );
-
-if ( "@ARGV" =~ /--help|-h/ ) {
- print q(Font Importation and monitoring application
---windows_import : import from all available windows partitions.
---xls_fonts : show all fonts that already exist from xls
---strong : strong verification of font.
---install : accept any font file and any directry.
---uninstall : uninstall any font or any directory of font.
---replace : replace all font if already exist
---application : 0 none application.
- : 1 all application available supported.
- : name_of_application like so for staroffice
- : and gs for ghostscript for only this one.
-);
- exit(0);
-}
-
-# global variables needed by each functions
-my $xlsfonts = 0;
-my $windows = 0;
-my $strong;
-my $replace;
-my $application;
-my $install;
-my $uninstall;
-my $so = 1;
-my $gs = 1;
-my $abi = 1;
-my $printer = 1;
-my $mode = -1;
-my @application;
-my @install;
-my @uninstall;
-my $interactive;
-my $text;
-my $vscrollbar;
-my $check4;
-my $check1;
-my $check2;
-my $check3;
-my $pbar;
-my $pbar1;
-my $pbar2;
-my $pbar3;
-my $font_box;
-my $central_widget;
-my $label1;
-my $label2;
-my $label3;
-my $label4;
-my $list_path;
-my $path_list;
-my $current_path;
-my $list;
-my $list_all_font_path;
-
-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;
- /--strong|-s/ and $strong = 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/X11/fs/config';
-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';
-my $mkttfdir = '/usr/X11R6/bin/mkttfdir';
-my $ghostscript;
-
-#my $ttmkfdir = '/usr/sbin/ttmkfdir';
-
-# Global lists, just to manipulate it easily.
-# 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 @fontsdir_to_install; => list of fonts to uninstall.
-# my @fontsdir_to_uninstall; => path to remove in xfs font file.
-# my @installed_fonts_full_path; => full path list of fonts to uninstall.
-
-my @font_list;
-my @installed_fonts;
-my @installed_fonts_path;
-my @fontsdir_to_install;
-my @fontsdir_to_uninstall;
-my @installed_fonts_full_path;
-
-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 {
- my @temp3;
- foreach my $tmp_path (@installed_fonts_path) {
- @temp3 = ();
- foreach my $temp2 ( all($tmp_path) ) {
- if ( !( ( $temp2 =~ /^fonts/ ) || ( $temp2 =~ /^type/ ) ) ) {
- push @temp3, $temp2;
- }
- }
- if ( !(@temp3) ) {
- system("chkfontpath -r $tmp_path ")
- or print "PERL::system command failed during chkfontpath\n";
- }
- }
-}
-
-sub search_installed_fonts {
- list_fontpath();
- $interactive and progress( $pbar, 0.1, _("Search installed fonts") );
- push @installed_fonts, all($_) foreach @installed_fonts_path;
- $interactive and progress( $pbar, 0.1, _("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|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, _("parse all fonts") );
- }
- else {
- display_error( _("no fonts found") );
- return 0;
- }
- }
- !$replace && grep( /$i/, @installed_fonts ) and next;
- grep ( /$i$/, @font_list )
- or push @font_list, "$win_dir/$_->[1]/fonts/$i";
- }
- }
- $interactive && $nb_dir and progress( $pbar, 1, _("done") );
- }
- if ( !@font_list ) {
- print "drakfont:: could not find any font in /win*/fonts \n";
- $interactive
- and display_error(
- _("could not find any font in your mounted partitions") );
- return 0;
- }
- 1;
-}
-
-sub is_a_font {
- local $_ = $_[0];
- /\.ttf$/i
- || /\.pfa$/i
- || /\.pfb$/i
- || /\.pcf$/i
- || /\.pcf\.gz$/i
- || /\.pfm$/i
- || /\.gsf$/;
-}
-
-# Optimisation de cette etape indispensable
-sub search_dir_font {
- foreach my $fn (@install) {
- my @font_list_tmp = ();
- my @font_list_tmpp = ();
- my $dir;
- if ( !( -e $fn ) ) { print "$_ :: no such file or directory \n" }
- else {
- if ( -d $fn ) {
- $dir = $fn;
- foreach my $i ( all($fn) ) {
- if ( is_a_font($i) ) {
- push @font_list_tmp, "$i";
- foreach my $i (@font_list_tmp) {
- !$replace && grep( /$i/, @installed_fonts )
- and next;
- grep /$i/, @font_list or push @font_list, "$fn/$i";
- }
- }
- }
- }
- else {
- if ( is_a_font($fn) ) {
- !$replace && grep( /$fn/, @installed_fonts ) and next;
- !grep /$fn/, (@installed_fonts) and push @font_list, "$fn";
- }
- }
- }
- $interactive
- and progress( $pbar, 0.50 / @install, _("Reselect correct fonts") );
- }
- $interactive and progress( $pbar, 1, _("done") );
- !@font_list && $interactive
- and display_error( _("could not find any font.\n") );
-}
-
-sub search_dir_font_uninstall {
- my @font_list_tmp = ();
- my $fn = $_;
- if ( -d $fn ) {
- foreach my $i ( all($fn) ) {
- if ( is_a_font($i) ) { push @font_list_tmp, "$i"; }
- }
- }
- else {
- if ( is_a_font($fn) ) { push @font_list_tmp, "$fn"; }
- }
- foreach my $i (@installed_fonts_full_path) {
- foreach my $j (@font_list_tmp) {
- if ( $i =~ /$j/ ) { push @font_list, "$i"; }
- }
- }
- print "Fonts to uninstal: " . $_ . "\n" foreach (@font_list);
-}
-
-sub search_dir_font_uninstall_gi {
- @font_list = @uninstall;
- $interactive and progress( $pbar, 1, _("Search fonts in installed list") );
-}
-
-sub print_list {
- print "Font(s) to Install:\n\n";
- print "$_\n" foreach (@font_list);
-}
-
-sub dir_created {
- -e $drakfont_dir || mkdir_p($drakfont_dir);
- -e $drakfont_dir . "/Type1" || mkdir_p( $drakfont_dir . "/Type1" );
- -e $drakfont_dir . "/ttf" || mkdir_p( $drakfont_dir . "/ttf" );
- -e $drakfont_dir . "/tmp" || mkdir_p( $drakfont_dir . "/tmp" );
- -e $drakfont_dir . "/tmp/ttf" || mkdir_p( $drakfont_dir . "/tmp/ttf" );
- -e $drakfont_dir . "/tmp/Type1" || mkdir_p( $drakfont_dir . "/tmp/Type1" );
- -e $drakfont_dir . "/tmp/tmp" || mkdir_p( $drakfont_dir . "/tmp/tmp" );
-}
-
-sub put_font_dir {
- my @tmpl;
- my @list_ttf;
- -e "/usr/share/ghostscript"
- or $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
- and progress( $pbar1, 1 / @font_list, _("Fonts copy") );
- }
- $interactive and progress( $pbar1, 0.01, _("done") );
- $interactive
- and progress( $pbar2, 0.10, _("True Type fonts installation") );
- glob("$drakfont_dir/tmp/tmp/*.TTF")
- and system( 'cd '
- . $drakfont_dir
- . '/tmp/tmp ; for foo in *.TTF; do mv $foo `basename $foo .TTF`.ttf; done'
- );
- system( 'cd ' . $drakfont_dir . '/tmp/tmp && cp *.ttf ../../ttf' );
- $interactive
- and progress( $pbar2, 0.20, _("please wait during ttmkfdir...") );
-
- # system ('cd '.$drakfont_dir.'/ttf && $ttmkfdir > fonts.dir' );
- my $ttfdir = $drakfont_dir . "/ttf";
- `$mkttfdir $ttfdir`;
- $interactive and progress( $pbar2, 0.10, _("True Type install done") );
- my $update_chkfontpath = "$chkfontpath -a $drakfont_dir/ttf";
-
- if ( $so && $gs ) {
- my @glob_drak = glob("$drakfont_dir/tmp/tmp/*.ttf");
- foreach my $fontname (@glob_drak) {
- system("cd $drakfont_dir/tmp/tmp && $ttf2pt1 -b $fontname");
- $interactive
- and
- progress( $pbar2, 0.50 / @glob_drak, _("Fonts conversion") );
- }
- system(
-"cd $drakfont_dir/tmp/tmp && mv *.gsf *.pfb *.pfm *.afm ../Type1"
- );
- system("cd $drakfont_dir/tmp/Type1 && $type1inst");
- $interactive and progress( $pbar2, 0.10, _("type1inst building") );
- -e "$drakfont_dir/tmp/Type1/Fontmap"
- and system(
-"cd $drakfont_dir/tmp/Type1 && cat Fontmap >> `rpm -ql ghostscript | grep Fontmap.GS` "
- );
- system(
-"cd $drakfont_dir/tmp/Type1 && mv *.pfm *.gsf *.afm *.pfb ../../Type1 "
- );
- system("cd $drakfont_dir/Type1 && $type1inst");
- $interactive
- and progress( $pbar2, 0.05, _("Ghostscript referencing") );
- $update_chkfontpath .= "; $chkfontpath -a $drakfont_dir/Type1";
- }
-
- if ( !$so && $gs ) {
- foreach
- my $fontname ( @tmpl = glob("$/drakfont_dir/tmp/tmp/*.ttf") )
- {
- system("cd $/drakfont_dir/tmp/tmp && $ttf2pt1 -b $fontname");
- $interactive
- and progress( $pbar2, 0.50 / @tmpl, _("Fonts conversion") );
- }
- system("cd $drakfont_dir/tmp/tmp && mv *.gsf *.pfb *.pfm ../Type1");
- system("cd $drakfont_dir/tmp/Type1 && $type1inst");
- $interactive and progress( $pbar2, 0.1, _("type1inst building") );
- system(
-"cd $drakfont_dir/tmp/Type1 && cat Fontmap >> `rpm -ql ghostscript | grep Fontmap.GS` "
- );
- system(
-"cd $drakfont_dir/tmp/Type1 && mv *.pfm *.afm *.gsf *.pfb ../../Type1 "
- );
- system("cd $drakfont_dir/Type1 && $type1inst");
- $interactive
- and progress( $pbar2, 0.05, _("Ghostscript referencing") );
- $update_chkfontpath .= "; $chkfontpath -a $drakfont_dir/Type1";
- }
-
- if ( $so && !$gs ) {
- foreach my $fontname ( @tmpl = glob("$drakfont_dir/tmp/tmp/*.ttf") )
- {
- system("cd $drakfont_dir/tmp/tmp && $ttf2pt1 $fontname");
- $interactive
- and
- progress( $pbar2, 0.25 / @tmpl, _("ttf fonts conversion") );
- }
- foreach my $fontname ( @tmpl = glob("$drakfont_dir/tmp/tmp/*.pfm") )
- {
- system("cd $drakfont_dir/tmp/tmp && $pfm2afm $fontname");
- $interactive
- and
- progress( $pbar2, 0.25 / @tmpl, _("pfm fonts conversion") );
- }
- system("cd $drakfont_dir/tmp/tmp && mv *.afm ../Type1");
- system("cd $drakfont_dir/tmp/Type1 && mv *.afm ../../Type1 ");
- system("cd $drakfont_dir/Type1 && $type1inst");
- $interactive and progress( $pbar2, 0.14, _("type1inst building") );
- $update_chkfontpath .= "; $chkfontpath -a $drakfont_dir/Type1";
- }
-
- $interactive and progress( $pbar2, 0.01, _("done") );
- $interactive
- and progress( $pbar3, 0.25, _("Suppress temporary Files") );
- rm_rf("$drakfont_dir/tmp/");
- print "\n\nretarting xfs......\n";
- $interactive and progress( $pbar3, 0.5, _("Restart XFS") );
- system($update_chkfontpath);
-
- # system ($restart_xfs);
- # system('kill -USR1 `/sbin/pidof xfs` 2&1>/dev/null');
- system('/etc/rc.d/init.d/xfs restart');
- $interactive and progress( $pbar3, 0.30, _("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 );
- grep ( $_ =~ /$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" || mkdir_p( $drakfont_dir . "/remove" );
- $interactive and progress( $pbar, 1, _("done") );
- foreach my $i (@font_list) {
- $_ = $i;
- if ( /.pfb$/ || /.gsf$/ || /.pfm$/ || /.pfa$/ ) {
- system("mv $_ $drakfont_dir/remove ");
- }
- else {
- rm_rf($i);
- }
- $i =~ s/\/\w*\.\w*//gi;
- grep ( $i, (@list_dir) ) or push @list_dir, $i;
- $interactive
- and progress( $pbar1, 1 / @font_list, _("Suppress Fonts Files") );
- }
- $interactive and progress( $pbar1, 0.01, _("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
- and progress( $pbar2, 1 / @list_dir, _("Suppress Fonts Files") );
- }
- $interactive and progress( $pbar2, 0.01, _("xfs restart") );
- system("/etc/rc.d/init.d/xfs restart");
- -e "/usr/share/ghostscript" and rm_rf("$drakfont_dir/remove");
- $interactive and progress( $pbar2, 0.01, _("done") );
-}
-
-sub license_msg {
- print _(
-"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 using the normal way. In rare cases, bogus fonts may hang up your X Server."
- )
- . "\n";
-}
-
- $list_all_font_path
- || $xlsfonts
- || $windows
- || @install
- || @uninstall ? backend_mod() : interactive_mode();
-
-sub backend_mod {
- if ($xlsfonts) {
- system("xlsfonts");
- }
- if ($list_all_font_path) {
- 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 {
- my $font_sel;
- gtkpack( $font_box, $font_sel = new Gtk::FontSelection, );
- $central_widget = \$font_sel;
-}
-
-sub display_error {
- my ($message) = @_;
- my $label;
- my $error_box;
- ${$central_widget}->destroy();
- gtkpack(
- $font_box,
- $error_box = gtkpack_(
- new Gtk::VBox( 0, 0 ),
- 1,
- new Gtk::Label($message),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::HButtonBox, -spread ),
- gtksignal_connect(
- new Gtk::Button( _("OK") ),
- clicked =>
- sub { ${$central_widget}->destroy(); create_fontsel() }
- ),
- ),
- )
- );
- $central_widget = \$error_box;
-}
-
-sub interactive_mode {
- my $font_sel;
- $interactive = 1;
- init Gtk;
- my $window1 =
- $::isEmbedded ? new Gtk::Plug($::XID) : new Gtk::Window -toplevel;
- $window1->signal_connect( delete_event => sub { Gtk->exit(0) } );
- $window1->set_position(1);
- $window1->set_title( _("Fonts Importation") );
- $window1->set_border_width(5);
- my ( $pix_user_map, $pix_user_mask ) = gtkcreate_png("ic-drakfont-48");
- my ( $pix_u_map, $pix_u_mask ) = gtkcreate_png("drakfont.620x57");
-
- gtkadd(
- $window1,
- gtkpack_(
- new Gtk::VBox( 0, 2 ),
- if_(
- !$::isEmbedded, 0, new Gtk::Pixmap( $pix_u_map, $pix_u_mask )
- ),
- 1,
- gtkpack_(
- new Gtk::HBox( 0, 2 ),
- 1,
- gtkpack_(
- new Gtk::VBox( 0, 2 ),
- 1,
- gtkpack(
- $font_box = new Gtk::VBox( 0, 5 ),
- $font_sel = new Gtk::FontSelection,
- ),
- 1,
- gtkpack_(
- new Gtk::HBox( 0, 2 ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::VButtonBox, -end ),
- gtksignal_connect(
- new Gtk::Button( _("Get Windows Fonts") ),
- clicked => sub {
- ${$central_widget}->destroy();
- $windows = 1;
- appli_choice();
- }
- ),
- gtksignal_connect(
- new Gtk::Button( _("Uninstall Fonts") ),
- clicked => sub {
- ${$central_widget}->destroy();
- uninstall();
- }
- ),
- ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::VButtonBox, -end ),
- gtksignal_connect(
- new Gtk::Button( _("Advanced Options") ),
- clicked => sub {
- ${$central_widget}->destroy();
- $windows = 0;
- advanced_install();
- }
- ),
- gtksignal_connect(
- new Gtk::Button( _("Font List") ),
- clicked => sub {
- ${$central_widget}->destroy();
- create_fontsel();
- }
- ),
- ),
- 1,
- new Gtk::HBox( 0, 2 ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::VButtonBox, -end ),
- gtksignal_connect(
- new Gtk::Button( _("Help") ),
- clicked =>
- sub { ${$central_widget}->destroy(); help() }
- ),
- gtksignal_connect(
- new Gtk::Button( _("Close") ),
- clicked => sub {
- $::isEmbedded and kill 'USR1', $::CCPID;
- Gtk->main_quit();
- }
- ),
- ),
- ),
- ),
-
- # 0, gtkpack_(new Gtk::VBox(0,5),
- # 0, new Gtk::VBox(0,0),
- # 0, new Gtk::Pixmap($pix_user_map, $pix_user_mask),
- # 1, new Gtk::VBox(0,0),
- # 1, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end),
- # gtksignal_connect(new Gtk::Button(_("About")), clicked => sub {
- # ${$central_widget}->destroy(); about() }),
- # gtksignal_connect(new Gtk::Button(_(" Help ")), clicked => sub {
- # ${$central_widget}->destroy(); help() }),
- # gtksignal_connect(new Gtk::Button(_("Close")), clicked => sub {
- # $::isEmbedded and kill 'USR1', $::CCPID;
- # Gtk->main_quit() }),
- # ),
- # )
- ),
- ),
- );
- $central_widget = \$font_sel;
- $window1->show_all;
- $font_sel->set_page(1);
- $font_sel->cur_page->child->hide();
- $font_sel->set_page(2);
- $font_sel->cur_page->child->hide();
- $font_sel->set_page(0);
- $window1->realize;
-
- # $window1->show_all();
- Gtk->main_iteration while Gtk->events_pending;
- $::isEmbedded and kill 'USR2', $::CCPID;
- Gtk->main;
- Gtk->exit(0);
-}
-
-sub about {
- my $text = new Gtk::Text( undef, undef );
- my $about_box;
- gtkpack(
- $font_box,
- $about_box = gtkpack_(
- new Gtk::VBox( 0, 10 ),
- 1,
- gtkpack_(
- new Gtk::HBox( 0, 0 ),
- 1,
- gtktext_insert(
- gtkset_editable( $text, 1 ), "
- Copyright (C) 2001 by MandrakeSoft
- DUPONT Sebastien sdupont\@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.
-
- 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
-
-
-"
- ),
- 0,
- new Gtk::VScrollbar( $text->vadj ),
- ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::HButtonBox, -spread ),
- gtksignal_connect(
- new Gtk::Button( _("OK") ),
- clicked =>
- sub { ${$central_widget}->destroy(); create_fontsel() }
- ),
- ),
- )
- );
- $central_widget = \$about_box;
- $font_box->show_all();
-}
-
-sub help {
- my $text = new Gtk::Text( undef, undef );
- my $help_box;
- gtkpack(
- $font_box,
- $help_box = gtkpack_(
- new Gtk::VBox( 0, 10 ),
- 1,
- gtkpack_(
- new Gtk::HBox( 0, 0 ),
- 1,
- gtktext_insert(
- gtkset_editable( $text, 1 ), "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 doublon) but don't import if already exist.
- - import from directory
- look for if it exist before for each font and not delete the original.
- (replace all, no, none)
- expert options:
- ask the directory, and look for if it exist before
- if it exist 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...
-
-
-"
- ),
- 0,
- new Gtk::VScrollbar( $text->vadj ),
- ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::HButtonBox, -spread ),
- gtksignal_connect(
- new Gtk::Button( _("OK") ),
- clicked =>
- sub { ${$central_widget}->destroy(); create_fontsel() }
- ),
- ),
- )
- );
- $central_widget = \$help_box;
- $font_box->show_all();
-}
-
-sub appli_choice {
- my $choice_box;
- my $text = new Gtk::Text( undef, undef );
- gtkpack(
- $font_box,
- $choice_box = gtkpack_(
- new Gtk::HBox( 0, 10 ),
- 0,
- new Gtk::VBox( 0, 10 ),
- 0,
- new Gtk::VBox( 0, 10 ),
- 1,
- gtkpack_(
- new Gtk::VBox( 0, 10 ),
- 1,
- gtkpack_(
- new Gtk::VBox( 0, 10 ),
- 1,
- gtkpack(
- new Gtk::HBox( 0, 10 ),
- new Gtk::HBox( 0, 10 ),
- _(
-"Choose the applications that will support the fonts:"
- ),
- new Gtk::HBox( 0, 10 ),
- ),
- 0,
- new Gtk::HBox( 0, 10 ),
- 0,
- gtkpack_(
- new Gtk::HBox( 0, 10 ), 0,
- _("Ghostscript"), 1,
- new Gtk::HBox( 0, 10 ), 0,
- my $check11 = new Gtk::CheckButton(),
- ),
- 0,
- gtkpack_(
- new Gtk::HBox( 0, 10 ), 0,
- _("StarOffice"), 1,
- new Gtk::HBox( 0, 10 ), 0,
- my $check22 = new Gtk::CheckButton(),
- ),
- 0,
- gtkpack_(
- new Gtk::HBox( 0, 10 ), 0,
- _("Abiword"), 1,
- new Gtk::HBox( 0, 10 ), 0,
- my $check33 = new Gtk::CheckButton(),
- ),
- 0,
- gtkpack_(
- new Gtk::HBox( 0, 10 ), 0,
- _("Generic Printers"), 1,
- new Gtk::HBox( 0, 10 ), 0,
- my $check44 = new Gtk::CheckButton(),
- ),
- ),
- 0,
- gtkpack_(
- new Gtk::HBox( 0, 10 ),
- 1,
- gtktext_insert(
- gtkset_editable( $text, 0 ),
- _(
-"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 using the normal way. In rare cases, bogus fonts may hang up your X Server."
- )
- ),
- 0,
- new Gtk::VScrollbar( $text->vadj ),
- 0,
- new Gtk::VBox( 0, 10 ),
- ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::HButtonBox, -spread ),
- gtksignal_connect(
- new Gtk::Button( _("OK") ),
- clicked => sub {
- ${$central_widget}->destroy();
- import_status();
- }
- ),
- gtksignal_connect(
- new Gtk::Button( _("Cancel") ),
- clicked => sub {
- ${$central_widget}->destroy();
- create_fontsel();
- }
- ),
- ),
- ),
- 0,
- new Gtk::VBox( 0, 10 ),
- 0,
- new Gtk::VBox( 0, 10 ),
- ),
-
- );
- foreach (
- [ $check11, \$gs ],
- [ $check22, \$so ],
- [ $check33, \$abi ],
- [ $check44, \$printer ]
- )
- {
- my $ref = $_->[1];
- gtksignal_connect( gtkset_active( $_->[0], ${$ref} ),
- toggled => sub { ${$ref} = ${$ref} ? 0 : 1; } );
- }
- $central_widget = \$choice_box;
- $font_box->show_all();
-}
-
-sub font_choice {
- my $file_dialog;
-
- $file_dialog = gtksignal_connect(
- new Gtk::FileSelection( _("File Selection") ),
- destroy => sub { $file_dialog->destroy(); }
- );
- $file_dialog->ok_button->signal_connect(
- clicked => \&file_ok_sel,
- $file_dialog
- );
- $file_dialog->ok_button->child->set( _("Add") );
- $file_dialog->cancel_button->signal_connect(
- clicked => sub { $file_dialog->destroy() } );
- $file_dialog->cancel_button->child->set( _("Close") );
- $file_dialog->set_filename(
- _("Select the font file or directory and click on 'Add'") );
- $file_dialog->show();
-}
-
-sub file_ok_sel {
- my ( $widget, $file_selection ) = @_;
- my $file_name = $file_selection->get_filename();
- print "-- @install\n";
- if ( !member( $file_name, @install ) ) {
- push ( @install, $file_name );
- $list->add( gtkshow( new Gtk::ListItem($file_name) ) );
- }
-}
-
-sub list_remove {
- my ( $widget, $list ) = @_;
- my @to_remove;
- push @to_remove, $list->child_position($_) foreach ( $list->selection );
- splice @install, $_, 1 foreach ( reverse sort @to_remove );
- $list->remove_items( $list->selection );
-}
-
-sub advanced_install {
- my $scrolled_window;
- my $adv_box;
- $list = new Gtk::List();
- $list->set_selection_mode( -extended );
-
- gtkpack(
- $font_box,
- $adv_box = gtkpack_(
- new Gtk::VBox( 0, 10 ),
- 1,
- gtkpack_( new Gtk::HBox( 0, 4 ), 1, createScrolledWindow($list), ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::HButtonBox, -spread ),
- gtksignal_connect(
- new Gtk::Button( _("Add") ),
- clicked => sub { font_choice() }
- ),
- gtksignal_connect(
- new Gtk::Button( _("Remove Selected") ),
- clicked => \&list_remove,
- $list
- ),
- gtksignal_connect(
- new Gtk::Button( _("Install List") ),
- clicked => sub {
- ${$central_widget}->destroy();
- appli_choice();
- }
- ),
- ),
- )
- );
- $central_widget = \$adv_box;
- $adv_box->show_all();
-}
-
-sub list_to_remove {
- my @number_to_remove;
- my @files_path = grep( !/fonts/, all($current_path) );
- Gtk->main_iteration while Gtk->events_pending;
- push @number_to_remove,
- $path_list->child_position($_) foreach ( $path_list->selection );
- @uninstall = ();
- push @uninstall,
- $current_path . "/" . $files_path[$_] foreach (@number_to_remove);
- ${$central_widget}->destroy();
- show_list_to_remove();
-}
-
-sub show_list_to_remove {
- my $show_box;
- my $show_list = new Gtk::List();
- $show_list->add( gtkshow( new Gtk::ListItem($_) ) ) foreach @uninstall;
- gtkpack(
- $font_box,
- $show_box = gtkpack_(
- new Gtk::VBox( 0, 10 ),
- 1,
- gtkpack_(
- new Gtk::HBox( 0, 4 ),
- 1, createScrolledWindow($show_list)
- ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::HButtonBox, -spread ),
- gtksignal_connect(
- new Gtk::Button( _("click here if you are sure.") ),
- clicked => sub {
- ${$central_widget}->destroy();
- import_status_uninstall();
- }
- ),
- gtksignal_connect(
- new Gtk::Button( _("here if no.") ),
- clicked =>
- sub { ${$central_widget}->destroy(); create_fontsel() }
- ),
- ),
- )
- );
- $central_widget = \$show_box;
- $show_box->show_all();
-}
-
-sub uninstall {
- my $scrolled_window;
- my $scrolled_window2;
- my $uninst_box;
- @install = ();
- @installed_fonts_path = ();
- list_fontpath();
- chk_empty_xfs_path();
- $list_path = new Gtk::List();
- $list_path->set_selection_mode( -extended );
-
- foreach (@installed_fonts_path) {
- my $t = $_;
- $list_path->add(
- gtkshow(
- gtksignal_connect(
- new Gtk::ListItem($t),
- select => sub {
- $current_path = $t;
- $path_list->clear_items( 0, -1 );
- $path_list->append_items(
- map {
- /fonts/
- ? ()
- : gtkshow( new Gtk::ListItem($_) )
- } all($t)
- );
- }
- )
- )
- );
- }
- $list_path->set_selection_mode( -single );
- $path_list = new Gtk::List();
- $path_list->set_selection_mode( -extended );
-
- gtkpack(
- $font_box,
- $uninst_box = gtkpack_(
- new Gtk::VBox( 0, 10 ),
- 1,
- gtkpack_(
- new Gtk::HBox( 0, 4 ), 1,
- createScrolledWindow($list_path), 1,
- createScrolledWindow($path_list)
- ),
- 0,
- gtkadd(
- gtkset_layout( new Gtk::HButtonBox, -spread ),
- gtksignal_connect(
- new Gtk::Button( _("Unselected All") ),
- clicked => sub { $path_list->unselect_all(); }
- ),
- gtksignal_connect(
- new Gtk::Button( _("Selected All") ),
- clicked => sub { $path_list->select_all(); }
- ),
- gtksignal_connect(
- new Gtk::Button( _("Remove List") ),
- clicked => sub { list_to_remove() }
- ),
- ),
- )
- );
- $central_widget = \$uninst_box;
- $uninst_box->show_all();
-}
-
-sub import_status {
- my $table;
- $pbar = new Gtk::ProgressBar;
- $pbar1 = new Gtk::ProgressBar;
- $pbar2 = new Gtk::ProgressBar;
- $pbar3 = new Gtk::ProgressBar;
- gtkpack(
- $font_box,
- $table = create_packtable(
- { col_spacings => 10, row_spacings => 50 },
- [ "", "" ],
- [
- _("Initials tests"), $pbar, $pbar->{label} = new Gtk::Label(' ')
- ],
- [
- _("Copy fonts on your system"), $pbar1,
- $pbar1->{label} = new Gtk::Label(' ')
- ],
- [
- _("Install & convert Fonts"), $pbar2,
- $pbar2->{label} = new Gtk::Label(' ')
- ],
- [
- _("Post Install"), $pbar3, $pbar3->{label} = new Gtk::Label(' ')
- ],
- ),
- );
- $central_widget = \$table;
- $font_box->show_all();
- Gtk->main_iteration while Gtk->events_pending;
- backend_mod();
-}
-
-sub import_status_uninstall {
- my $table;
- $pbar = new Gtk::ProgressBar;
- $pbar1 = new Gtk::ProgressBar;
- $pbar2 = new Gtk::ProgressBar;
- gtkpack(
- $font_box,
- $table = create_packtable(
- { col_spacings => 10, row_spacings => 50 },
- [ "", "" ],
- [ "", "" ],
- [
- _("Initials tests"), $pbar, $pbar->{label} = new Gtk::Label(' ')
- ],
- [
- _("Remove fonts on your system"), $pbar1,
- $pbar1->{label} = new Gtk::Label(' ')
- ],
- [
- _("Post Uninstall"), $pbar2,
- $pbar2->{label} = new Gtk::Label(' ')
- ],
- ),
- );
- $central_widget = \$table;
- $font_box->show_all();
- Gtk->main_iteration while Gtk->events_pending;
- backend_mod();
-}
-
-sub progress {
- my ( $progressbar, $incr, $label_text ) = @_;
- my ($new_val) = $progressbar->get_current_percentage;
- $new_val += $incr;
- if ( $new_val > 1 ) { $new_val = 1 }
- $progressbar->update($new_val);
- $progressbar->{label}->set($label_text);
- Gtk->main_iteration while Gtk->events_pending;
-}
-
diff --git a/perl-install/standalone/drakgw b/perl-install/standalone/drakgw
deleted file mode 100755
index 0e66b15b4..000000000
--- a/perl-install/standalone/drakgw
+++ /dev/null
@@ -1,547 +0,0 @@
-#!/usr/bin/perl
-
-#
-# Guillaume Cottenceau (gc@mandrakesoft.com)
-#
-# Copyright 2000, 2001, 2002 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;
-use log;
-use c;
-use network::netconnect;
-use network::shorewall;
-
-$::isInstall and die "Not supported during install.\n";
-
-
-local $_ = join '', @ARGV;
-
-/-h/ and die "usage: drakgw [--version]\n";
-/-version/ and die 'version: $Id$ '."\n";
-$::Wizard_pix_up = "wiz_drakgw.png";
-$::Wizard_title = _("Internet Connection Sharing");
-$::direct = /-direct/;
-
-
-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 $dhcpd_conf = "/etc/dhcpd.conf";
-my $cups_conf = "/etc/cups/cupsd.conf";
-
-my $shorewall = network::shorewall::read();
-
-my $in = 'interactive'->vnew('su', 'default');
-
-!$::isEmbedded && $in->isa('interactive::gtk') and $::isWizard=1;
-
-pur_gtk_mode() if $::isEmbedded && $in->isa('interactive::gtk');
-
-sub sys { system(@_) == 0 or log::l("[drakgw] Warning, sys failed for $_[0]") }
-
-sub outpend {
- standalone::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 ()
-{
- my $cups_used = 0;
- standalone::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/named status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/named stop");
-
- my $netmon = '/usr/sbin/net_monitor';
- my $netmon_need_start;
- if (-x $netmon && `$netmon --status` eq 1) {
- $netmon_need_start = 1;
- system("$netmon --disconnect --force --quiet >/dev/null");
- }
- sys("/etc/rc.d/init.d/network restart");
- $netmon_need_start and system("$netmon --connect --force --quiet >/dev/null");
-
- sys("/etc/init.d/shorewall restart");
-
- sys("/etc/rc.d/init.d/$_ start"), sys("/sbin/chkconfig --level 345 $_ on") foreach 'named', 'dhcpd', 'shorewall';
- sys("/etc/rc.d/init.d/cups start") if $cups_used;
-}
-
-sub stop_daemons ()
-{
- standalone::explanations("Stopping daemons");
- foreach (qw(dhcpd named)) {
- system("/etc/rc.d/init.d/$_ status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/$_ stop");
- }
- system("/etc/rc.d/init.d/shorewall status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/shorewall clear");
- sys("/sbin/chkconfig --level 345 $_ off") foreach 'named', 'dhcpd';
-}
-
-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 eq '2.4' or fatal_quit(_("Sorry, we support only 2.4 kernels."));
-
-begin:
-
-#- **********************************
-#- * 0th step: verify if we are already set up
-
-if ($shorewall && $shorewall->{masquerade}) {
- $::Wizard_no_previous = 1;
-
- if (!$shorewall->{disabled}) {
- my $r = $in->ask_from_list_(_("Internet Connection Sharing currently enabled"),
-_("The setup of Internet connection sharing has already been done.
-It's currently enabled.
-
-What would you like to do?"),
- [ __("disable"), __("reconfigure"), __("dismiss") ]) or quit_global($in, 0);
- if ($r eq "disable") {
- {
- my $wait_disabl = $in->wait_message('', _("Disabling servers..."));
- stop_daemons();
- }
- foreach ($dhcpd_conf, $rc_firewall_24) {
- renamef($_, "$_.drakgwdisable") or die "Could not rename $_ to $_.drakgwdisable"
- }
- log::l("[drakgw] Disabled");
- $::Wizard_finished = 1;
- $in->ask_okcancel('', _("Internet connection sharing is now disabled."));
- quit_global($in, 0);
- }
- if ($r eq "dismiss") {
- quit_global($in, 0);
- }
- }
- else
- {
- my $r = $in->ask_from_list_(_("Internet Connection Sharing currently disabled"),
-_("The setup of Internet connection sharing has already been done.
-It's currently disabled.
-
-What would you like to do?"),
- [ __("enable"), __("reconfigure"), __("dismiss") ]);
- if ($r eq "enable") {
- foreach ($dhcpd_conf, $rc_firewall_24) {
- rename($_, "$_.old") if -f $_;
- rename("$_.drakgwdisable", $_) or die "Could not find configuration. Please reconfigure.";
- }
- {
- my $wait_enabl = $in->wait_message('', _("Enabling servers..."));
- start_daemons();
- }
- log::l("[drakgw] Enabled");
- $::Wizard_finished = 1;
- $in->ask_okcancel('', _("Internet connection sharing 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(_("Internet Connection Sharing"),
-_("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.
-
-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;
-
-
-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();
-defined $card_netconnect and log::l("[drakgw] Information from netconnect: ignore card $card_netconnect");
-
-my @cards = grep {
- log::l("[drakgw] Have network card: $_");
- $_ ne $card_netconnect
-} detect_devices::getNet();
-log::l("[drakgw] Available network cards: ", join(", ", @cards));
-
-my $format = sub {
- $aliased_devices{$_[0]} ?
- _("Interface %s (using module %s)", $_[0], $aliased_devices{$_[0]}) :
- _("Interface %s", $_[0]);
-};
-
-#- setup the network interface we shall use
-
-my $device;
-if (!@cards)
-{
- $in->ask_warn(_("No network adapter on your system!"),
- _("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(_("Network interface"),
-_("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_ask_confirm;
-}
-else
-{
- $device = $in->ask_from_listf(_("Choose the network interface"),
- _("Please choose what network adapter will be connected to your Local Area Network."),
- $format,
- \@cards,
- ) or goto step_ask_confirm;
- defined $device or quit_global($in, 0);
-}
-standalone::explanations("Choosing network device: $device");
-
-
-my $lan_address = "192.168.0.0";
-my $server_ip = "192.168.0.1";
-
-my $reconf_dhcp_server_intf = 1;
-
-if (grep(/$device/, @configured_devices)) {
- step_warning_already_conf:
- my $auto = _('Yes');
- my $conf = network::read_interface_conf("/etc/sysconfig/network-scripts/ifcfg-$device");
- $in->ask_from(_("Network interface already configured"),
- _("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 => _("Automatic reconfiguration"), val => \$auto, list => [ _('Yes'), _('No (experts only)') ] },
- { val => _("Show current interface configuration"), clicked =>
- sub { $in->ask_warn(_('Current interface configuration'),
- _("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_detectsetup;
-
- if ($auto ne _('Yes')) {
- $reconf_dhcp_server_intf = 0;
- $server_ip = $conf->{IPADDR};
- $lan_address = $conf->{NETWORK};
- $in->ask_from('',
- _("I can keep your current configuration and assume you already set up a DHCP server; in that case please verify I correctly read the C-Class Network that you use for your local network; I will not reconfigure it and I will not touch your DHCP server configuration.
-
-Else, I can reconfigure your interface and (re)configure a DHCP server for you.
-
-", $device),
- [ { label => _("C-Class Local Network"), val => \$lan_address, type => 'entry' },
- { label => _("(This) DHCP Server IP"), val => \$server_ip, type => 'entry' },
- { label => _("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('',
- _("The Local Network did not finish with `.0', bailing out."));
- quit_global($in, 0);
-}
-standalone::explanations("Using LAN address <$lan_address>");
-
-
-#- test for potential conflict with other networks
-
-foreach (grep { $_ ne $device } @configured_devices)
-{
- grep(/$lan_address/, cat_("/etc/sysconfig/network-scripts/ifcfg-$_")) and
- ($in->ask_warn('', _("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(_("Configuring..."),
- _("Configuring scripts, installing software, starting servers..."));
-
-
-#- setup the /etc/sysconfig/network-script/ script
-
-if ($reconf_dhcp_server_intf) {
- standalone::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, qq(DEVICE=$device
-BOOTPROTO=static
-IPADDR=$server_ip
-NETMASK=255.255.255.0
-NETWORK=$lan_address.0
-BROADCAST=$lan_address.255
-ONBOOT=yes
-));
-}
-
-
-#- install and setup the RPM packages
-
-my $rpms_to_install;
-my %rpm2file = (iptables => '/sbin/iptables',
- 'dhcp-server' => '/usr/sbin/dhcpd',
- bind => '/usr/sbin/named',
- '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);
-#- second: try one by one if failure detected
-if (grep { !-e $rpm2file{$_} } keys %rpm2file) {
- foreach (keys %rpm2file) {
- -e $rpm2file{$_} or $in->do_pkgs->install($_);
- -e $rpm2file{$_} or fatal_quit(_("Problems installing package %s", $_));
- }
-}
-
-put_in_hash($shorewall ||= {}, {
- disabled => 0,
- net_interface => $card_netconnect,
- if_(@cards > 1, loc_interface => [ grep { $_ ne $device } @cards ]),
- masquerade => { interface => $device, subnet => "$lan_address.0/24" },
-});
-
-network::shorewall::write($shorewall);
-
-#- be sure that FORWARD_IPV4 is enabled in /etc/sysconfig/network
-
-substInFile { s/^FORWARD_IPV4.*\n//; $_ .= "FORWARD_IPV4=true\n" if eof } $sysconf_network;
-
-
-#- setup the DHCP server
-
-if ($reconf_dhcp_server_intf) {
- standalone::explanations("Configuring a DHCP server on $lan_address.0");
- renamef($dhcpd_conf, "$dhcpd_conf.old");
- output($dhcpd_conf, qq(subnet $lan_address.0 netmask 255.255.255.0 {
- # default gateway
- option routers $server_ip;
- option subnet-mask 255.255.255.0;
-
- option domain-name "homelan.org";
- option domain-name-servers $server_ip;
-
- range dynamic-bootp $lan_address.16 $lan_address.253;
- default-lease-time 21600;
- max-lease-time 43200;
-}
-));
-}
-
-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
-
-substInFile { s/^INTERFACES\n//; $_ .= "INTERFACES=\"$device\"\n" if eof } $sysconf_dhcpd;
-
-
-#- 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) {
- standalone::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 (grep(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();
-
-
-#- bye-bye message
-
-undef $wait_configuring;
-
-$::Wizard_no_previous = 1;
-$::Wizard_finished = 1;
-
-$in->ask_okcancel(_("Congratulations!"),
-_("Everything has been configured.
-You may now share Internet connection with other computers on your Local Area Network, using automatic network configuration (DHCP)."));
-
-
-log::l("[drakgw] Installation complete, exiting");
-quit_global($in, 0);
-
-sub quit_global {
- my ($in, $exitcode) = @_;
- $in->exit($exitcode);
- goto begin
-}
-
-sub pur_gtk_mode
-{
- require Gtk;
- init Gtk;
- my $setup_state = $shorewall && $shorewall->{masquerade} ?
- ($shorewall->{disabled} ?
- _("The setup has already been done, but it's currently disabled.") :
- _("The setup has already been done, and it's currently enabled.")) :
- _("No Internet Connection Sharing has ever been configured.");
-
- my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel;
- $window1->signal_connect(delete_event => sub { Gtk->exit(0) });
- $window1->set_position(1);
- $window1->set_title(_("Internet connection sharing configuration"));
- $window1->border_width(10);
- my $vbox1 = new Gtk::VBox(0,0);
- $window1->add($vbox1);
- my $hbox1 = new Gtk::HBox(0,0);
- $vbox1->pack_start($hbox1,1,1,0);
- my $label1 = new Gtk::Label(
-_("Welcome to the Internet Connection Sharing utility!
-
-%s
-
-Click on Configure to launch the setup wizard.", $setup_state));
- $hbox1->pack_start($label1,1,1,0);
- my $hbox2 = new Gtk::HBox(0,0);
- $vbox1->pack_start($hbox2,1,1,0);
-
- my $bbox1 = new Gtk::HButtonBox;
- $vbox1->pack_start($bbox1,0,0,0);
- $bbox1->set_layout(-end);
- my $button_conf = new Gtk::Button _("Configure");
- $button_conf->signal_connect(clicked => sub {
- system("/usr/sbin/drakgw --wizard");
- kill('USR1', $::CCPID);
- });
- $bbox1->add($button_conf);
- my $button_cancel = new Gtk::Button _("Cancel");
- $button_cancel->signal_connect(clicked => sub {
- kill('USR1', $::CCPID);
- });
- $bbox1->add($button_cancel);
- $window1->show_all();
- Gtk->main_iteration while Gtk->events_pending;
- $::isEmbedded and kill 'USR2', $::CCPID;
- Gtk->main;
- Gtk->exit(0);
-
-}
diff --git a/perl-install/standalone/drakproxy b/perl-install/standalone/drakproxy
deleted file mode 100755
index f912bb9ee..000000000
--- a/perl-install/standalone/drakproxy
+++ /dev/null
@@ -1,33 +0,0 @@
-#!/usr/bin/perl
-
-# DrakNet
-
-# Copyright (C) 1999 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;
-
-$::o->{miscellaneous} ||= {};
-$::o->{miscellaneous} = { getVarsFromSh('/etc/profile.d/proxy.sh') };
-my $in = 'interactive'->vnew('su', 'network');
-network::network::miscellaneousNetwork($in, 1, 1);
-any::miscellaneousNetwork('');
-$in->exit(0);
-
diff --git a/perl-install/standalone/draksound b/perl-install/standalone/draksound
deleted file mode 100755
index 88f8e99c3..000000000
--- a/perl-install/standalone/draksound
+++ /dev/null
@@ -1,57 +0,0 @@
-#!/usr/bin/perl
-# DrakxSound
-# Copyright (C) 2002 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;
-
-("@ARGV" =~ /--help|-h/) and die "usage: draksound [-h] [--help]\n";
-
-my $in = 'interactive'->vnew();
-
-modules::mergein_conf('/etc/modules.conf');
-
-my @devices = grep { $_->{media_type} eq 'MULTIMEDIA_AUDIO' } detect_devices::probeall(1);
-if (@devices) {
- # 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::get_alias("sound-slot-$::i");
- $_->{driver} = $driver if $driver;
- harddrake::sound::config($in, $_);
- } modules::probe_category('multimedia/sound');
-} else {
- $in->ask_warn(_("No Sound Card detected!"),
- formatAlaTeX(_("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")));
-}
-
-modules::write_conf;
-$in->exit(0);
diff --git a/perl-install/standalone/draksplash b/perl-install/standalone/draksplash
deleted file mode 100755
index 22731a004..000000000
--- a/perl-install/standalone/draksplash
+++ /dev/null
@@ -1,544 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-use MDK::Common;
-use Gtk;
-use interactive;
-use my_gtk ;
-init Gtk;
-
-#- convenience variables for true and false
-my $false = 0;
-my $true = 1;
-
-#- this part is embedded management
-$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~/--embedded (\S*) (\S*)/;
-if ($::isEmbedded) {
- print "EMBED\n";
- print "XID : $::XID\n";
- print "CCPID : $::CCPID\n";
-}
-
-my $in = 'interactive'->vnew('su', 'default');
-local $_ = join '', @ARGV;
-
-/-h/ and die _("no help implemented yet.\n");
-/-version/ and die 'version: $Id$'."\n";
-
-my $window = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window ("toplevel");
-$window->signal_connect(delete_event => sub { $::isEmbedded ? kill(USR1, $::CCPID) : &CloseAppWindow });
-
-#- verification of package image magik
-$in->ask_warn(_("Error"),_("package ImageMagick is required for correct working"))
- and $::isEmbedded ? kill(USR1, $::CCPID) : &CloseAppWindow if system('rpm -q ImageMagick');
-
-
-#- application vars
-#my $mained = 1;
-my $tmp_path = '/tmp/draksplash/';
-! -d $tmp_path and mkdir($tmp_path);
-my $thm_path = '/usr/share/bootsplash/themes/';
-my $thm_conf_path = '/etc/bootsplash/themes/';
-
-my $prev_window;
-my $pix;
-
-my $boot_conf_path = '/etc/bootsplash/themes/';
-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'=>new Gtk::Frame(_("first step creation")),
- 'widget'=>{ 'label'=> { 'res'=>_("final resolution"),
- 'file'=>_("choose image file"),
- 'name'=>_("Theme name")
- },
- 'button'=>{ 'boot_conf'=>_("make bootsplash step 2"),
- 'lilo_conf'=>_("go to lilosplash configuration"),
- 'kill'=>_("quit"),
- 'save'=>_("save theme"),
- 'file'=>_("browse"),
- },
- 'combo'=> {'res'=>['800x600', '1024x768', '1280x1024'],
- 'name'=>[ $theme{'name'} , &giv_exist_thm]
- },
- ,},
- 'pos'=>[ 'name',
- 'res',
- 'file',
- 'boot_conf',
- 'save',
- 'kill'],
- );
-my %boot_conf_frame = ('frame' => new Gtk::Frame( _("Configure bootsplash picture") ),
- 'widget'=> { 'label' => { 'tx'=> _("x coordinate of text box in number of character"),
- 'ty'=> _("y coordinate of text box in number of character"),
- 'tw'=> _("text width"),
- 'th'=> _("text box height"),
- 'px'=> _("the progress bar x coordinate of its upper left corner"),
- 'py'=> _("the progress bar y coordinate of its upper left corner"),
- 'pw'=> _("the width of the progress bar"),
- 'ph'=> _("the heigth of the progress bar"),
- 'pc'=> _("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'=> _("go back"),
- 'prev'=>_("preview"),
- 'pc'=> _("choose color"),
-
- },
- 'check' => { 'logo' => _("Display logo on Console" ),
- 'quiet'=> _("Make kernel message quiet by default"),
- },
- },
- 'pos'=> [ 'tx' ,
- 'ty' ,
- 'tw' ,
- 'th' ,
- 'px' ,
- 'py' ,
- 'pw' ,
- 'ph' ,
- 'pc' ,
- 'logo',
- 'quiet',
- 'annul',
- 'prev',
- ],
- );
-#- var action is used to hide/show the correct frame
-my @action_frame = ( \%boot_conf_frame ,
- \%first);
-
-
-# >>>>>>>>>> FIRST SCREEN >>>>>>>>>>
-my $VB2 = new Gtk::VBox(0,5);
-&mk_frame(\$VB2,\%first);
-#****************************- 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'} = new Gtk::Frame(_("Configure bootsplash picture") );
- &make_boot_frame;
- member( $theme{'name'}, &giv_exist_thm) and &thm_in_this_res and &get_this_thm_res_conf or $in->ask_warn(_("Notice"),_("This theme haven't yet any bootsplash in %s !",$theme{'res'}{'res'}));
- });
-#- quit button
-$first{'widgets'}{'button'}{'kill'}->signal_connect( clicked => \&CloseAppWindow);
-#- 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 = new Gtk::FileSelection('choose image');
- $file_dialog->set_filename( ( $first{'widgets'}{'label'}{'file'}->get ne _("choose image file") )?$first{'widgets'}{'label'}{'file'}->get:'~/' );
- $file_dialog->cancel_button->signal_connect( clicked => sub{ $file_dialog->destroy} );
- $file_dialog->ok_button->signal_connect( clicked => sub{ $first{'widgets'}{'label'}{'file'}->set_text($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{'widgets'}{'button'}{'save'}->signal_connect(clicked=> sub{ &write_boot_thm });
-#**************************************************
-#**************************************************
-# <<<<<<<<<< FIRST SCREEN <<<<<<<<<<
-
-
-$first_vbox = new Gtk::VBox(0,5);
-#$first_vbox->add($boot_conf_frame{'frame'});
-$first_vbox->add($first{'frame'});
-
-&make_boot_frame;
-
-# set window attributes and show it
-$window->border_width( 5 );
-$window->add($first_vbox);
-$window->set_policy( 0, 1, 1 );
-$window->set_position('center');
-$window->show_all();
-&show_act(\%first);
-
-# Gtk event loop
-main Gtk;
-
-# Should never get here
-exit( 0 );
-
-### Callback function to close the window
-sub CloseAppWindow{
- Gtk->exit( 0 );
- return $false;
-}
-
-#- ====## 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('',_("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 = $thm_conf_path.$theme{'name'}.'/global.config';
- my $cfg_file = $thm_conf_path.$theme{'name'}.'/cfg/bootsplash-'.$theme{'res'}{'res'}.'.cfg';
- #- verify all dir exists or create them
- -d $thm_conf_path.$theme{'name'}
- or mkdir($thm_conf_path.$theme{'name'});
- -d $thm_conf_path.$theme{'name'}.'/cfg'
- or mkdir($thm_conf_path.$theme{'name'}.'/cfg');
- -d $thm_path.$theme{'name'}
- or mkdir($thm_path.$theme{'name'});
- -d $thm_path.$theme{'name'}.'/images/'
- or mkdir($thm_path.$theme{'name'}.'/images/');
- #- copy image to dest by convert
- system('convert -scale '.$theme{'res'}{'res'} .' '.$first{'widgets'}{'label'}{'file'}->get.' '.$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
- my $cfg_cont = '# 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 heigth of the progress bar
-ph='.$theme{'boot_conf'}{'ph'}.'
-
-# pc is the color of the progress bar
-pc='.$theme{'boot_conf'}{'pc'}.''
-;
- my $globalconf_cont = '# Display logo on console.
-LOGO_CONSOLE='.$logo.'
-
-# Make kernel message quiet by default.
-QUIET='.$quiet
-;
- output($globalconf_file, $globalconf_cont);
- output($cfg_file,$cfg_cont);
-}
-
-
-#- 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;
- -f $thm_path.$theme{'name'}."/images/bootsplash-".$theme{'res'}{'res'}.".jpg"
- and $first{'widgets'}{'label'}{'file'}->set_text($thm_path.$theme{'name'}."/images/bootsplash-".$theme{'res'}{'res'}.".jpg");
- return 1;
-}
-
-sub read_boot_conf {
- chdir($thm_conf_path);
- my $line;
- if(-f $theme{'name'}.'/cfg/bootsplash-'.$theme{'res'}{'res'}.'.cfg') {
- open CFG , $theme{'name'}.'/cfg/bootsplash-'.$theme{'res'}{'res'}.'.cfg';
- while($line = <CFG>){
- $line =~ m/^([a-z][a-z])=([^\n]+)/
- and $theme{'boot_conf'}{$1} = $2;
- }
- close CFG;
- &set_scale_values;
- } else {
- return 0;
- }
-}
-
-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'}}){
- -f "bootsplash-$_.jpg"
- and $is_ok = 1
- and $first{'widgets'}{'combo'}{'res'}->entry->set_text($_)
- and last;
-
- }
- $is_ok == 1 or $in->ask_warn(_("Notice"),_("This theme haven't yet any 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}){
- ! ${$name.'_tip'} and ${$name.'_tip'} = new Gtk::Tooltips();
- ${$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 ( $box , $ref ) = @_;
- foreach(@{$ref->{'pos'}}){
- #- open a new hbox
- ${$_.'hb'} = new Gtk::HBox(0,5);
- #- look for label
- $ref->{'widget'}{'label'}{$_}
- and $ref->{'widgets'}{'label'}{$_} = new Gtk::Label($ref->{'widget'}{'label'}{$_})
- and ${$_.'hb'}->add($ref->{'widgets'}{'label'}{$_});
- #- look for scale
- $ref->{'widget'}{'scale'}{$_}
- and $ref->{'widgets'}{'scale'}{$_} = new Gtk::HScale( ${$_."_adj"} = new Gtk::Adjustment(0,0,$scale_size{$_},1,10,0))
- and ${$_."hb"}->add($ref->{'widgets'}{'scale'}{$_})
- and $ref->{'widgets'}{'scale'}{$_}->set_digits(0);
- ${$_.'_adj'} and ${$_.'_adj'}->set_value($theme{'boot_conf'}{$_});
- #- look for combo
- $ref->{'widget'}{'combo'}{$_}
- and @popdown = @{$ref->{'widget'}{'combo'}{$_}}
- and $ref->{'widgets'}{'combo'}{$_} = new Gtk::Combo
- and ${$_."hb"}->add($ref->{'widgets'}{'combo'}{$_})
- and $ref->{'widgets'}{'combo'}{$_}->set_popdown_strings(@popdown);
- #- look for checkbox
- $ref->{'widget'}{'check'}{$_}
- and $ref->{'widgets'}{'check'}{$_} = new Gtk::CheckButton( $ref->{'widget'}{'check'}{$_} )
- and ${$_."hb"}->add($ref->{'widgets'}{'check'}{$_})
- and $ref->{'widgets'}{'check'}{$_}->set_active(1);
- #- look for button
- $ref->{'widget'}{'button'}{$_}
- and $ref->{'widgets'}{'button'}{$_} = new Gtk::Button($ref->{'widget'}{'button'}{$_})
- and ${$_."hb"}->add($ref->{'widgets'}{'button'}{$_});
- #- look for tooltips
- $ref->{'widget'}{'tooltip'}{$_}
- and &tool_tip($_,\%{$ref});
- ${$box}->add(${$_."hb"});
- }
- #####################la ligne en dessous est a revoir aparement##########################
- $ref->{'frame'}->add(${$box});
-}
-
-#- Desc => take a decimal value between 0 to 255 and return the corresponding hexadecimal value
-sub dec2hex{
- my ($dec) = @_;
- my @dec_hex = (0,1,2,3,4,5,6,7,8,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{
- $VB = new Gtk::VBox(0,5);
- &mk_frame(\$VB,\%boot_conf_frame);
- #- open a color choose box
- $boot_conf_frame{'widgets'}{'button'}{'pc'}->signal_connect( clicked => sub {
- $color = new Gtk::ColorSelectionDialog(_("ProgressBar color selection"));
- $theme{'boot_conf'}{'pc'} =~ m/0x(.{2})(.{2})(.{2})/;
- my @rgb = map { hex($_)/255 } ($1 ,$2, $3);
- $color->colorsel->set_color(@rgb);#$theme{'boot_conf'}{'pc'});
- $color->cancel_button->signal_connect(clicked=> sub{$color->destroy});
- $color->ok_button->signal_connect(clicked=> sub{
- @rgb = $color->colorsel->get_color();
- @rgb = map ( dec2hex($_*255) , @rgb);
- $theme{'boot_conf'}{'pc'} = "0x$rgb[0]$rgb[1]$rgb[2]";
- $color->destroy;
- });
- $color->show;
- });
- #- 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{
- if(! -f $first{'widgets'}{'label'}{'file'}->get) {
- $in->ask_warn(_("Notice"),_("You must choose an image file first!"));
- return 0;
- }
- #- calculation of the 2 angle of text box and progress bar
- &set_thm_values;
- my $text_tl = ($theme{'boot_conf'}{'tx'}*$font_size{'w'}).','.$theme{'boot_conf'}{'ty'}*$font_size{'h'};
- my $text_br = ($theme{'boot_conf'}{'tw'}*$font_size{'w'}+$theme{'boot_conf'}{'tx'}*$font_size{'w'}).','.($theme{'boot_conf'}{'th'}*$font_size{'h'}+$theme{'boot_conf'}{'ty'}*$font_size{'h'});
- my $progress_tl = $theme{'boot_conf'}{'px'}.','.$theme{'boot_conf'}{'py'};
- my $progress_br = ($theme{'boot_conf'}{'px'}+$theme{'boot_conf'}{'pw'}).','.($theme{'boot_conf'}{'py'}+$theme{'boot_conf'}{'ph'});
- my $w = $in->wait_message('', _("Generating preview ..."));
- $x++;
- $com = "convert -scale $theme{'res'}{'res'} -fill black -draw 'rectangle $text_tl $text_br rectangle $progress_tl $progress_br' ".$first{'widgets'}{'label'}{'file'}->get." $tmp_path.prev$x.png";
- system($com);
- &show_prev("$tmp_path.prev$x.png");
- } );
- $first_vbox->add($boot_conf_frame{'frame'});
- #- check scales values are possibly correct
- #&set_scale_values;
-
- foreach my $k ( keys %{$theme{'boot_conf'}}){
- $k =~ m/[tp][hwyx]/
- and ${$k.'_adj'}->signal_connect(value_changed => sub{ &check_boot_scales($k) });
- }
- # unlink "$tmp_path.prev$x.png";
-}
-
-#- 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 => create a new window with a preview of splash screen
-#- Args => $file (str) full path to preview file
-sub show_prev{
- my ($file) = @_;
- $prev_window
- or ($prev_window = new Gtk::Window('toplevel') and $prev_window->set_policy( 0, 1, 1 ) );
- #- must destroy and recreate or get a bug on refreshing the preview window!
- $pix
- and $pix->destroy;
- $pix = new Gtk::Pixmap(my_gtk::gtkcreate_png($file));
- $prev_window->add($pix);
- $prev_window ->signal_connect(delete_event => sub{$prev_window->destroy} );
- $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 = $tw_adj->get_value;
- my $tx = $tx_adj->get_value;
- my $th = $th_adj->get_value;
- my $ty = $ty_adj->get_value;
- my $pw = $pw_adj->get_value;
- my $ph = $ph_adj->get_value;
- my $px = $px_adj->get_value;
- my $py = $py_adj->get_value;
- my $max_x = $scale_size{'tw'};
- my $max_y = $scale_size{'th'};
- my $max_xres = $theme{'res'}{'w'};
- my $max_yres = $theme{'res'}{'h'};
-
- $obj eq 'tw' and $max_x < ($tw + $tx) and $tx_adj->set_value($max_x - $tw);
- $obj eq 'tx' and $max_x < ($tw + $tx) and $tw_adj->set_value($max_x - $tx);
- $obj eq 'th' and $max_y < ($th + $ty) and $ty_adj->set_value($max_y - $th);
- $obj eq 'ty' and $max_y < ($th + $ty) and $th_adj->set_value($max_y - $ty);
- $obj eq 'pw' and $max_xres < ($pw + $px) and $px_adj->set_value($max_xres - $pw);
- $obj eq 'px' and $max_xres < ($pw + $px) and $pw_adj->set_value($max_xres - $px);
- $obj eq 'ph' and $max_yres < ($ph + $py) and $py_adj->set_value($max_yres - $ph);
- $obj eq 'py' and $max_yres < ($ph + $py) and $ph_adj->set_value($max_yres - $py);
-
-}
diff --git a/perl-install/standalone/drakupdate_fstab b/perl-install/standalone/drakupdate_fstab
deleted file mode 100755
index e68d55b92..000000000
--- a/perl-install/standalone/drakupdate_fstab
+++ /dev/null
@@ -1,123 +0,0 @@
-#!/usr/bin/perl
-
-# XFdrake
-# Copyright (C) 2002 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 detect_devices;
-use common;
-use fsedit;
-use lang;
-use any;
-use fs;
-
-$::testing = $ARGV[0] eq '--test' && shift;
-my ($raw_action, $device_name) = @ARGV;
-my ($action) = $raw_action =~ /^--(add|del)/;
-
-@ARGV == 2 && $action or die "usage: drakupdate_fstab [--test] [--add | --del] <device>\n";
-
-main($action, $device_name);
-
-
-sub device_name_to_entry {
- my ($name) = @_;
- $name =~ s|/dev/||;
- my @l = detect_devices::get();
-
- my ($e, $nb);
- if ((my $devfs_prefix, $nb) = $name =~ m,(.*)/(?:cd|disc|part(\d+))$,) {
- ($e) = grep { $_->{devfs_prefix} eq $devfs_prefix } @l or return;
- } else {
- if (($e) = grep { $name eq $_->{device} } @l) {
- $nb = '';
- } else {
- (my $prefix, $nb) = $name =~ m/^(.*?)(\d*)$/;
- ($e) = grep { $prefix eq ($_->{prefix} || $_->{device}) } @l or return;
- }
- }
-
- if ($nb) {
- $e->{devfs_device} = $e->{devfs_prefix} . '/part' . $nb;
- $e->{device} = ($e->{prefix} || $e->{device}) . $nb;
- }
- $e;
-}
-
-sub set_options {
- my ($part) = @_;
- my $use_supermount = cat_('/etc/fstab') =~ /supermount/;
- my $security = any::get_secure_level();
- my ($iocharset, $codepage) = lang::fs_options(lang::read());
-
- fs::set_default_options($part, 1, $use_supermount, $security, $iocharset, $codepage);
-}
-
-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 fsedit::mntpoint2part("$mntpoint$_", $fstab);
- $part->{mntpoint} = "$mntpoint$_";
- return 1;
- }
- 0;
-}
-
-sub main {
- my ($action, $device_name) = @_;
- 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', 'verbatim_credentials') ];
- my ($existing_fstab_entries, $fstab_) = partition { $_->{device} eq $part->{device} || $_->{device} eq $part->{devfs_device} } @$fstab;
-
- if ($action eq 'add') {
- if (@$existing_fstab_entries) {
- print STDERR "Already in fstab\n" if $::testing;
- return;
- }
- set_options($part);
- set_mount_point($part, $fstab) or return;
-
- my ($line) = fs::prepare_write_fstab([$part]);
- append_to_file($fstab_file, $line) if $line;
- } else {
- if (!@$existing_fstab_entries) {
- print STDERR "Not found in fstab\n" if $::testing;
- return;
- }
- my ($s) = fs::prepare_write_fstab($fstab_, '', 'keep_smb_credentials');
- output($fstab_file, $s);
- }
-
- if ($::testing) {
- print "fstab would have changed:\n";
- system("diff -u /etc/fstab $fstab_file");
- }
-}
diff --git a/perl-install/standalone/drakxservices b/perl-install/standalone/drakxservices
deleted file mode 100755
index a57b430bb..000000000
--- a/perl-install/standalone/drakxservices
+++ /dev/null
@@ -1,23 +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 services;
-use log;
-
-local $_ = join '', @ARGV;
-
-/-h/ and die "usage: drakxservices\n";
-
-
-my $in = 'interactive'->vnew('su', 'services');
-begin:
-my $l = services::ask($in);
-services::doit($in, $l) if $l;
-!$::isEmbedded and $in->exit(0);
-kill 'USR1', $::CCPID;
-goto begin;
diff --git a/perl-install/standalone/drakxtv b/perl-install/standalone/drakxtv
deleted file mode 100755
index 4d96f01ad..000000000
--- a/perl-install/standalone/drakxtv
+++ /dev/null
@@ -1,168 +0,0 @@
-#!/usr/bin/perl -w
-# DrakxTV
-# $Id$
-
-# Copyright (C) 2002 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 interactive;
-use strict;
-use detect_devices;
-use lang;
-use log;
-use common;
-
-("@ARGV" =~ /--help|-h/) and die "usage: drakxtv [-h] [--help] [--no-guess]\n";
-
-
-my $in = 'interactive'->vnew();
-
-sub scan4channels {
-# xawtv has been installed by DrakX when/if it's detected a
-# tv card.
-# In the future, we might try to install xawtv if it'sn't there
-# as we're just a, xawtv wraper
-# -x "/usr/bin/scantv" or $in->do_pkgs->install('xawtv');
-# -x "/usr/bin/scantv" or {
-#{ exec {'consolehelper'} $0, ("urpmi", "xawtv") or die _("consolehelper missing");
-# };
- if (! -x "/usr/bin/scantv") {
-# standalone::explanations("package xawtv isn't installed");
- $in->ask_warn("XawTV isn't installed!",
- formatAlaTeX(_("XawTV isn't installed!
-
-
-If you do have a TV card but DrakX has neither detected it (no bttv nor saa7134
-module in \"/etc/modules\") nor installed xawtv, please send the
-results of \"lspcidrake -v -f\" to \"install\@mandrakesoft.com\"
-with subject \"undetected TV card\".
-
-
-You can install it by typing \"urpmi xawtv\" as root, in a console.")));
-
- } else {
- my ($ftable_id, $norm);
-
-# my %freqtables = map {$i=$_;$i =~ s/ (.*)/-\1/;_($_) => $i} (...)
-# this table must be checked on each xawtv release:
- my %freqtables =
- ("us-bcast" => _("USA (broadcast)"), "us-cable" => _("USA (cable)"), "us-cable-hrc" => _("USA (cable-hrc)"), "canada-cable" => _("Canada (cable)"),
- "japan-bcast" => _("Japan (broadcast)"), "japan-cable" => _("Japan (cable)"), "china-bcast" => _("China (broadcast)"),
- "europe-west" => _("West Europe"), "europe-east" => _("East Europe"), "italy" => _("Italy"), "ireland" => _("Ireland"), "france" => _("France [SECAM]"),
- "newzealand" => _("Newzealand"), "australia" => _("Australia"),
- "southafrica" => _("South Africa"),
- "argentina" => _("Argentina"),
- "australia-optus" => _("Australian Optus cable TV"),
- -1 =>_("All")
- );
-# Info: HRC means "Harmonically Related Carrier"
-
- # default to pal since most people use that
- $norm = "PAL";
- if ("@ARGV" !~ /--help|-h/) {
- my %countries =
- (
- "ar" => [ "argentina" ],
- "au" => [ "australia" ],
- "(br|fr)" => ["france", "SECAM"],
- "ca" => [ "canada-cable" ],
- "(ga|ie)" => [ "ireland" ],
- "it" => [ "italy" ],
- "jp" => [ "japan-bcast", "NTSC-JP"],
- "nz" => [ "newzealand" ],
- "(at|be|ch|de|eu|gb|se)" => [ "europe-west" ],
- "us" => [ "us-bcast", "NTSC" ],
- "za" => [ "southafrica" ],
- "(zh|TW|Big5|CN.GB2312|CN)" => [ "china-bcast" ]
- );
-
- ($_) = lang::read('', $>);
- foreach my $i (keys %countries) {
- if (/($i|$i.UTF-8)$/i) {
- my $tbl = $countries{$i};
- $ftable_id = $tbl->[0];
- $norm = $tbl->[1] if ($tbl->[1]);
- }
- }
- log::l("[drakxtv] guess lang=>$_, norm=>$norm, area=>$ftable_id");
- }
-
- if ($in->ask_from("TVdrake", _("Please,\ntype in your tv norm and country"),
- [
- { label => _("TV norm:"), val => \$norm, list => ["NTSC", "NTSC-JP","PAL", "PAL-M", "PAL-N", "PAL-NC", "SECAM"], type => 'combo' },
- { label => _("Area:"), val => \$ftable_id, list => [keys %freqtables], format => sub { $freqtables{$_[0]} }, sort => 1},
- ]
- ))
- { my $wait = $in->wait_message(_('Please wait'),
- _("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 = $ENV{HOME};
- my $i = system ( (($use_X) ?
- "xvt -T '"._("Scanning for TV channels")." ...' -e ":"")
- . "scantv -n $norm -f $ftable_id -o $home/.xawtv".(($use_X)?"":" &>$home/tmp/scantv.log;"));
- if ($i) {
- $in->ask_warn(_("There was an error while scanning for TV channels"),
- _("XawTV isn't installed!")) }
- else {
- standalone::explanations("created file $home/.xawtv");
- $in->ask_warn(_("Have a nice day!"),
- _("Now, you can run xawtv (under X Window!) !\n")) if (! $use_X);
- };
-
- };
- }
-}
-
-my @devices = grep { $_->{media_type} eq 'MULTIMEDIA_VIDEO' } detect_devices::probeall(1);
-if (@devices) {
- # TODO: That need some work for multiples TV cards
- foreach (@devices) {
- if (($< == 0) && (grep { $_->{driver} =~ '(bttv|saa7134)' } @devices)) {
- require harddrake::v4l;
- require modules;
- no strict 'subs';
- modules::read_conf;
- harddrake::v4l::config($in, $_->{driver});
- modules::write_conf;
- }
- scan4channels();
- $in->exit(0);
- }
-} else {
- $in->ask_warn(_("No TV Card detected!"), formatAlaTeX(
- _("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")));
-}
-
-
-# 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 f5390a382..000000000
--- a/perl-install/standalone/fileshareset
+++ /dev/null
@@ -1,389 +0,0 @@
-#!/usr/bin/perl -T
-use strict;
-
-########################################
-# config files
-$nfs_exports::default_options = '*(ro,all_squash)';
-$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-2002 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|/../|;
- $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;
-
-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;
- local *F;
- open F, $file or return [];
-
- my ($prev_raw, $prev_line, %e, @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});
- }
- }
- local *F;
- open 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') != 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);
- local *F;
- open 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
- }
- }
- local *F;
- open 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;
- next;
- }
- s|(.*)[0-9#\-_!/]|$1| and next;
-
- # inspired by "Christian Brolin" "Long names are doom" on comp.lang.functional
- s|(.+)[AEIOU]|$1| and next; # allButFirstVowels
- s|(.*)(.)\2|$1$2| and next; # 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 a306a4fe4..000000000
--- a/perl-install/standalone/harddrake2
+++ /dev/null
@@ -1,13 +0,0 @@
-#!/usr/bin/perl -w
-
-use lib qw(/usr/lib/libDrakX);
-use standalone;
-use harddrake::ui;
-
-if ("@ARGV" =~ /--help|-h/) {
- print "Harddrake 2\n", $harddrake::ui::license, "\nUsage: harddrake [-h|--help]\n";
- exit;
-}
-$::isStandalone=1;
-
-harddrake::ui->new;
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/drakTS.620x57.png b/perl-install/standalone/icons/drakTS.620x57.png
deleted file mode 100644
index d4735df1d..000000000
--- a/perl-install/standalone/icons/drakTS.620x57.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakbackup.540x57.png b/perl-install/standalone/icons/drakbackup.540x57.png
deleted file mode 100644
index 5af42dfea..000000000
--- a/perl-install/standalone/icons/drakbackup.540x57.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakconnect_step.png b/perl-install/standalone/icons/drakconnect_step.png
deleted file mode 100644
index e2ddf46d7..000000000
--- a/perl-install/standalone/icons/drakconnect_step.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/drakfont.620x57.png b/perl-install/standalone/icons/drakfont.620x57.png
deleted file mode 100644
index 1eb7feb46..000000000
--- a/perl-install/standalone/icons/drakfont.620x57.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/K7.png b/perl-install/standalone/icons/harddrake2/K7.png
deleted file mode 100644
index 01c776c00..000000000
--- a/perl-install/standalone/icons/harddrake2/K7.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/harddrake2/cable.png b/perl-install/standalone/icons/harddrake2/cable.png
deleted file mode 100644
index 54c3fa12d..000000000
--- a/perl-install/standalone/icons/harddrake2/cable.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 08180b54f..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 89d800c45..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 ca9f8bae9..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 6a70153fe..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 d2a64591e..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 239363e00..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 12ea7cff9..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 ea0377005..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 8ecac9aa4..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 e7c153d10..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 6a025f4b5..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 1acf4a75c..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 6159d0ab6..000000000
--- a/perl-install/standalone/icons/harddrake2/memory.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 d25c378ed..000000000
--- a/perl-install/standalone/icons/harddrake2/modem.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 d1c1e6eca..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 ad4690b6d..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 51155d984..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 faa893211..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 9b95fdb3b..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 4cfe5f869..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 d30cdf167..000000000
--- a/perl-install/standalone/icons/harddrake2/unknown.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 8538918f5..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 7ac95ca36..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 f5bbce103..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 07d8156e7..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 16e9ded83..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 fa2eff689..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 bfd292e0a..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 3f4992134..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 25817dabc..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 80198d443..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 bc9b10ac7..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 cebb8bccd..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 5ffc1e822..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 e92873674..000000000
--- a/perl-install/standalone/icons/ic82-system-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-systemeplus-40.png b/perl-install/standalone/icons/ic82-systemeplus-40.png
deleted file mode 100644
index a5699dff5..000000000
--- a/perl-install/standalone/icons/ic82-systemeplus-40.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/ic82-tape-40.png b/perl-install/standalone/icons/ic82-tape-40.png
deleted file mode 100644
index 5889f1074..000000000
--- a/perl-install/standalone/icons/ic82-tape-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 c87fa4135..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 ec5bf2bcf..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 6a8125a9d..000000000
--- a/perl-install/standalone/icons/ic82-where-40.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 960d079e3..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/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/smbnfs_default.png b/perl-install/standalone/icons/smbnfs_default.png
deleted file mode 100644
index 546f06227..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 cbbbc1ec2..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 49f47ec4d..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_left.png b/perl-install/standalone/icons/wiz_default_left.png
deleted file mode 100644
index 2300ab36e..000000000
--- a/perl-install/standalone/icons/wiz_default_left.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 20f386d17..000000000
--- a/perl-install/standalone/icons/wiz_default_up.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/wiz_drakconnect.png b/perl-install/standalone/icons/wiz_drakconnect.png
deleted file mode 100644
index 20f386d17..000000000
--- a/perl-install/standalone/icons/wiz_drakconnect.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/wiz_drakgw.png b/perl-install/standalone/icons/wiz_drakgw.png
deleted file mode 100644
index aedff1dca..000000000
--- a/perl-install/standalone/icons/wiz_drakgw.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/wiz_firewall.png b/perl-install/standalone/icons/wiz_firewall.png
deleted file mode 100644
index 26923a00b..000000000
--- a/perl-install/standalone/icons/wiz_firewall.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/wiz_printerdrake.png b/perl-install/standalone/icons/wiz_printerdrake.png
deleted file mode 100644
index a49290702..000000000
--- a/perl-install/standalone/icons/wiz_printerdrake.png
+++ /dev/null
Binary files differ
diff --git a/perl-install/standalone/icons/wiz_scannerdrake.png b/perl-install/standalone/icons/wiz_scannerdrake.png
deleted file mode 100644
index 297f0deca..000000000
--- a/perl-install/standalone/icons/wiz_scannerdrake.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 197d5e874..000000000
--- a/perl-install/standalone/interactive_http/authorised_progs
+++ /dev/null
@@ -1,13 +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/draksec
-/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 e7673083c..000000000
--- a/perl-install/standalone/interactive_http/miniserv.init
+++ /dev/null
@@ -1,51 +0,0 @@
-#!/bin/sh
-# chkconfig: 235 99 00
-# description: Start or stop the miniserv administration server
-
-name=drakxtools_http
-server=/usr/share/libDrakX/$name/miniserv.pl
-
-case "$1" in
-'start')
- echo -n "Starting $name: "
- perl $server /etc/$name/conf
- touch /var/lock/subsys/drakxtools_http
- echo $name
- ;;
-'stop')
- echo -n "Shutting down $name: "
- kill `cat /var/run/$name.pid`
- rm -f /var/lock/subsys/drakxtools_http
- echo $name
- ;;
-'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')
- $0 stop
- $0 start
- ;;
-'reload')
- $0 stop
- $0 start
- ;;
-'condrestart')
- if [ -f /var/lock/subsys/drakxtools_http ]; then
- $0 restart
- fi
- ;;
-*)
- 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 7940726fa..000000000
--- a/perl-install/standalone/keyboarddrake
+++ /dev/null
@@ -1,67 +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;
-
-local $_ = join '', @ARGV;
-
-/-h/ and die _("usage: keyboarddrake [--expert] [keyboard]\n");
-
-$::expert = /-expert/;
-
-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', 'keyboard');
-
- begin:
- $::isEmbedded and kill 'USR2', $::CCPID;
- choose:
- $keyboard->{KEYBOARD} = $in->ask_from_listf(_("Keyboard"),
- _("Please, choose your keyboard layout."),
- \&keyboard::KEYBOARD2text,
- [ keyboard::KEYBOARDs() ],
- $keyboard->{KEYBOARD}) or goto end;
-
- any::keyboard_group_toggle_choose($in, $keyboard) or goto choose;
-}
-
-if ($::expert) {
- my $isNotDelete = !$in->ask_yesorno("BackSpace", _("Do you want the BackSpace to return Delete in console?"), 1);
- $keyboard->{BACKSPACE} = $isNotDelete ? "BackSpace" : "Delete";
-}
-
-system('loadkeys', keyboard::keyboard2kmap($keyboard));
-
-my $xkb = keyboard::keyboard2xkb($keyboard);
-system('setxkbmap', $xkb);
-
-eval {
- my $xfree_conf = Xconfig::xfree->read;
- my $x_kbd_conf = $xfree_conf->get_keyboard;
- $x_kbd_conf->{XkbLayout} = $xkb;
- $xfree_conf->set_keyboard($x_kbd_conf);
- $xfree_conf->write;
-};
-
-keyboard::write($keyboard);
-
-end:
-if ($::isEmbedded) {
- kill('USR1', $::CCPID);
- $keyboard = '';
- goto begin;
-} else {
- $in->exit(0) if $in;
-}
diff --git a/perl-install/standalone/livedrake b/perl-install/standalone/livedrake
deleted file mode 100755
index 9c2af4c03..000000000
--- a/perl-install/standalone/livedrake
+++ /dev/null
@@ -1,46 +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 run_program;
-use c;
-
-local $_ = join '', @ARGV;
-
-/-h/ and die "usage: livedrake [--testing]\n";
-
-$::testing = /-testing/;
-
-my $in = 'interactive'->vnew('su', 'default');
-
-my $cd_mntpoint = "/mnt/cdrom";
-
-while (! -x "$cd_mntpoint/Mandrake/mdkinst/usr/bin/perl-install/live_install") {
- ejectCdrom();
- $in->ask_okcancel(_("Change Cd-Rom"),
-_("Please insert the Installation Cd-Rom in your drive and press Ok when done.
-If you don't have it, press Cancel to avoid live upgrade."), 1) or $in->exit(0);
- run_program::run("mount", "/mnt/cdrom");
-}
-
-if (-x "$cd_mntpoint/Mandrake/mdkinst/usr/bin/perl-install/live_install") {
- chdir "/$cd_mntpoint/Mandrake/mdkinst/usr/bin/perl-install/";
- $::testing or exec "./live_install";
-}
-
-$in->ask_warn('', _("Unable to start live upgrade !!!\n"));
-$in->exit(1);
-
-sub ejectCdrom {
- my ($cdrom) = @_;
- $cdrom or cat_("/proc/mounts") =~ m|(/dev/\S+)\s+/mnt/cdrom\s| and $cdrom = $1;
- $cdrom or cat_("/etc/fstab") =~ m|(/dev/\S+)\s+/mnt/cdrom\s| and $cdrom = $1;
- my $f = eval { $cdrom && detect_devices::tryOpen($cdrom) } or return;
- run_program::run("umount", "/mnt/cdrom");
- ioctl $f, c::CDROM_LOCKDOOR(), 0;
- ioctl $f, c::CDROMEJECT(), 1;
-}
diff --git a/perl-install/standalone/localedrake b/perl-install/standalone/localedrake
deleted file mode 100644
index ef72f498e..000000000
--- a/perl-install/standalone/localedrake
+++ /dev/null
@@ -1,40 +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 lang;
-use any;
-
-my ($klang, $country, $apply);
-
-foreach (@ARGV) {
- $apply = /--apply/;
- $klang = $1 if /--kde_lang=(.*)/;
- $country = $1 if /--kde_country=(.*)/;
-}
-if ($klang) {
- my $lang = lang::kde_lang_country2lang($klang, $country);
- lang::write('', $lang, $>, 'dont_touch_kde_files') if $apply;
-
- #- help KDE defaulting to the right charset
- print lang::charset2kde_charset(lang::lang2charset($lang)), "\n";
-} else {
- my ($lang) = lang::read('', $>);
-
- my $in = 'interactive'->vnew;
- if ($lang = any::selectLanguage($in, $lang)) {
- lang::write('', $lang, $>);
- if ($>) {
- if (my $wm = any::running_window_manager()) {
- $in->ask_okcancel('', _("The change is done, but to be effective you must logout"), 1)
- && any::ask_window_manager_to_logout($wm);
- }
- }
- }
- $in->exit(0);
-}
-
-
diff --git a/perl-install/standalone/logdrake b/perl-install/standalone/logdrake
deleted file mode 100755
index 5603e8083..000000000
--- a/perl-install/standalone/logdrake
+++ /dev/null
@@ -1,542 +0,0 @@
-#! /usr/bin/perl
-# $Id$
-
-# Copyright (C) 2001 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.
-
-
-use POSIX;
-use Gtk;
-use lib qw(/usr/lib/libDrakX);
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use any;
-use Config;
-init Gtk;
-Gtk->set_locale;
-use my_gtk qw(:helpers :wrappers);
-
-use MDK::Common;
-use Data::Dumper;
-#-------------------------------------------------------------
-# i18n routines
-# IMPORTANT: next two routines have to be redefined here to
-# get correct namespace (drakconf instead of libDrakX)
-# (This version is now UTF8 compliant - Sg 2001-08-18)
-#-------------------------------------------------------------
-
-{
- no warnings;
- sub _ {
- my $s = shift @_; my $t = translate($s);
- sprintf $t, @_;
- }
-
- no warnings;
- sub translate {
- my ($s) = @_;
- $s ? c::dgettext('drakconf', $s) : '';
- }
-}
-
-$::isInstall and die "Not supported during install.\n";
-
-my $in = 'interactive'->vnew('su', 'default');
-my $cron_hourly = "/etc/cron.hourly/logdrake_service";
-
-if ($::isEmbedded) {
- print "EMBED\n";
- print "parent XID\t$::XID\n";
- print "mcc pid\t$::CCPID\n";
-}
-
-#- parse arguments list.
-for (@ARGV) {
- /^--version$/ and die 'version: $Id$ '."\n";
- /^--help$/ and die 'logdrake [--version] [--file=myfyle] [--word=myword] [--explain=regexp] [--alert]';
- /^--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() };
-}
-
-$::isTail = 1 if ($::isFile);
-$| = 1 if ($::isTail);
-my $h = chomp_(`hostname -s`);
-
-my $window = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel;
-$window->signal_connect(delete_event => sub { $::isEmbedded ? kill('USR1', $::CCPID) : Gtk->exit(0) });
-$window->set_title(_("logdrake"));
-$window->set_policy(1, 1, 1);
-$window->border_width (5) unless ($::isEmbedded);
-#$window->set_default_size(540,460);
-
-my $cal = gtkset_sensitive(new Gtk::Calendar(),0);
-my (undef,undef,undef,$mday) = localtime(time);
-$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(new Gtk::CheckButton(_("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 => _("/_File"), type => '<Branch>' },
- { path => _("/File/_New"), accelerator => _("<control>N"), callback => \&print_hello },
- { path => _("/File/_Open"), accelerator => _("<control>O"),callback => \&print_hello },
- { path => _("/File/_Save"), accelerator => _("<control>S"),callback => \&save },
- { path => _("/File/Save _As") },
- { path => _("/File/-"),type => '<Separator>' },
- { path => _("/File/_Quit"), accelerator => _("<control>Q"), callback => \&quit },
- { path => _("/_Options"), type => '<Branch>' },
- { path => _("/Options/Test") },
- { path => _("/_Help"),type => '<LastBranch>' },
- { path => _("/Help/_About...") }
- );
-my $menubar = get_main_menu($window);
-######### menus end
-
-
-########## font and colors
-my $n = Gtk::Gdk::Font->fontset_load(_("-misc-fixed-medium-r-*-*-*-100-*-*-*-*-*-*,*"));
-my $b = Gtk::Gdk::Font->fontset_load(_("-misc-fixed-bold-r-*-*-*-100-*-*-*-*-*-*,*"));
-
-#$black = "\033[30m";
-#$red = "\033[31m";
-#$green = "\033[32m";
-#$yellow = "\033[33m";
-#$blue = "\033[34m";
-#$magenta = "\033[35m";
-#$purple = "\033[35m";
-#$cyan = "\033[36m";
-#$white = "\033[37m";
-#$darkgray = "\033[30m";
-#$col_norm = "\033[00m";
-#$col_background = "\033[07m";
-#$col_brighten = "\033[01m";
-#$col_underline = "\033[04m";
-#$col_blink = "\033[05m";
-
-my $white = my_gtk::gtkcolor(50400, 655, 20000);
-my $black = my_gtk::gtkcolor(0, 0, 0);
-my $red = my_gtk::gtkcolor(0xFFFF, 655, 655);
-my $green = my_gtk::gtkcolor(0x0, 0x9898,0x0);
-my $yellow = my_gtk::gtkcolor(0xFFFF, 0xD7D7, 0);
-my $blue = my_gtk::gtkcolor(655, 655, 0xFFFF);
-my $magenta = my_gtk::gtkcolor(0xFFFF, 655, 0xFFFF);
-my $purple = my_gtk::gtkcolor(0xA0A0, 0x2020, 0xF0F0);
-my $cyan = my_gtk::gtkcolor(0x0, 0x9898, 0x9898);
-my $darkgray = my_gtk::gtkcolor(0x2F2F, 0x4F4F, 0x4F4F);
-
-
-# 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:");
-
-# Define specifics:
-my @daemons = ("named");
-
-# Now define what we want to use when:
-my $col_good = $green;
-my $col_warn = $yellow;
-my $col_bad = $red;
-my $col_note = $purple;
-my $col = $cyan;
-
-######### font and colors end
-
-my %files = (
- "auth" => { file => "/var/log/auth.log", desc => _("Authentication") },
- "user" => { file => "/var/log/user.log", desc => _("User") },
- "messages" => { file => "/var/log/messages", desc => _("Messages") },
- "syslog" => { file => "/var/log/syslog", desc => _("Syslog") },
- "explanations" => { file => "/var/log/explanations", desc => _("Mandrake Tools Explanations") }
-);
-
-my $yy = gtkset_sensitive(gtksignal_connect(new Gtk::Button(_("search")) , clicked => \&search),0);
-my $log_text = new Gtk::Text(undef, undef);
-my $refcount_search;
-#### far from window
-gtkadd($window,
- gtkpack_(new Gtk::VBox(0,0),
- if_(!$::isExplain && !$::isEmbedded, 0, _("A tool to monitor your logs")),
- if_(!$::isFile, 0, gtkadd(new Gtk::Frame(_("Settings")),
- gtkpack__(new Gtk::VBox(0,2),
- gtkpack__(new Gtk::VBox(0,2),
- # _("Show lines"),
- gtkpack__(new Gtk::HBox(0,0),
- " " . _("matching") . " ", $e_yes = new Gtk::Entry(),
- " " . _("but not matching") . " ", $e_no = new Gtk::Entry()
- )
- ),
- gtkpack_(new Gtk::HBox(0,0),
- 1, gtkadd(gtkset_border_width(new Gtk::Frame(_("Choose file")),2),
- gtkpack (gtkset_border_width(new Gtk::VBox(0,0),0),
- map { ${ "b_". $_ } = gtksignal_connect(new Gtk::CheckButton($files{ $_ }{desc}), clicked => sub{ $refcount_search++; gtkset_sensitive($yy,$refcount_search) }) } keys %files,
- )
- ),
- 0, gtkadd(gtkset_border_width(new Gtk::Frame(_("Calendar")),2),
- gtkpack__(gtkset_border_width(new Gtk::VBox(0,0),5),
- $cal_butt, $cal
- )
- )
- ),
- $yy,
- )
- )
- ),
- !$::isExplain ? (1, gtkadd(new Gtk::Frame(_("Content of the file")),
- createScrolledWindow($log_text)
- )) : (1, $log_text),
- if_(!$::isExplain, 0, gtkadd (gtkset_border_width(gtkset_layout(new Gtk::HButtonBox,-end), 5),
- if_(!$::isFile, gtksignal_connect(new Gtk::Button (_("Mail alert")),
- clicked => sub { eval { alert_config() };
- if ($@ =~ /wizcancel/) {
- $::Wizard_no_previous = 1;
- $::Wizard_no_cancel = 1;
- $::WizardWindow->destroy if defined $::WizardWindow;
- undef $::WizardWindow;
- } })),
- gtksignal_connect(new Gtk::Button (_("Save")), clicked => \&save),
- gtksignal_connect(new Gtk::Button ($::isEmbedded ? _("Cancel") : _("Quit")), clicked => \&quit)
- )
- )
- )
-
- );
-
-$::isFile and gtkset_usize($log_text,400,500);
-$window->realize;
-$window->show_all();
-search() if ($::isFile);
-#Gtk->main_iteration while Gtk->events_pending;
-$::isEmbedded and kill 'USR2', $::CCPID;
-Gtk->main;
-
-sub quit {
-$::isEmbedded ? kill('USR1', $::CCPID) : Gtk->exit(0);
-}
-
-#-------------------------------------------------------------
-# search functions
-#-------------------------------------------------------------
-sub search {
- $log_text->backward_delete($log_text->get_length());
- $log_text->freeze();
- if ($::isFile) {
- parse_file($::File);
- } else {
- foreach (keys %files) {
- parse_file($files{ $_ }{file}) if ${ $::{ "b_". $_ }}->active
- };
- }
- $log_text->thaw();
- Gtk->main_iteration while Gtk->events_pending;
-}
-
-sub parse_file {
- my $file = $_[0];
-
- $file =~ s/\.gz$//;
- my $i = 0;
- gtkadd(my $win_pb = (gtkset_modal new Gtk::Window(), 1),
- gtkpack(new Gtk::VBox(5,0),
- " " . _("please wait, parsing file: %s", $files{ $_ }{desc}) . " ",
- my $pbar = new Gtk::ProgressBar()
- )
- );
- $win_pb->set_position('center');
- $win_pb->realize();
- $win_pb->show_all();
- 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 ($year, $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;
- foreach (@all) {
- $i++;
- if ($i % 10) {
- $pbar->update($i/$taille);
- Gtk->main_iteration while Gtk->events_pending;
- }
-
- if (($en eq "") and /$ey/i) { logcolorize($_); next }
- if ((! /$en/i) and /$ey/i) { logcolorize($_); next }
- if ((! /$en/i) and ($ey eq "")) { logcolorize($_); next }
- }
- $win_pb->destroy();
-
- if ($::isTail) {
- open F, $file or die "E: $!";
- while (<F>) {}; #to prevent to output the file twice..
- $log_text->set_point($log_text->get_length());
- my $timer = Gtk->timeout_add(1000, \&input_callback);
- }
-}
-
-sub input_callback {
- logcolorize($_) while <F>;
- seek F, 0, 1;
-}
-
-
-##########################################################################################
-
-sub logcolorize {
-
- # we get date & time if it is date & time (dmesg)
- s/(\D{3} .. \d\d:\d\d:\d\d )//;
- $timestamp = $1;
- @rec = split;
-
- log_output($cyan,$timestamp,$b); # date & time if any...
- log_output(($rec[0] eq $h) ? $blue : $col,"$rec[0] ",$b); # hostname
-
- if ($rec[1] eq "last") {
- log_output($green," last message repeated ",$n);
- log_output($green, $rec[4], $b);
- log_output($green," times\n",$n);
- return;
- }
- # Extract PID if present
- if ($rec[1] =~ /\[(\d+)\]\:/) {
- my($pid) = $1;
- $rec[1] =~s/\[$1\]\:// ;
- log_output ($green, $rec[1] ."[",$n);
- log_output ($black, $pid,$b);
- log_output ($green, "]: ",$n);
- }
- else {
- log_output($green, $rec[1] ." ",$n);
- }
-
-
- for ($therest = (2); $therest<= $#rec; $therest++) {
- $col = $cyan;
-
- # 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($col,"$rec[$therest] ",$n);
- }
- log_output($black,"\n",$n);
-}
-
-
-sub log_output {
- $log_text->insert($_[2],$_[0], undef,$_[1]);
-}
-
-
-#-------------------------------------------------------------
-# mail/sms alert
-#-------------------------------------------------------------
-
-sub alert_config {
-
- $::isWizard = 1;
- $::Wizard_pix_up = "wiz_drakgw.png"; # FIXME
- $::Wizard_title = _("Mail alert");
-
- my $cron = q(#!/usr/bin/perl
-# generated by logdrake
-use MDK::Common;
-my $r = "*** ". chomp_(`date`) . " ***\n";
-
-);
-
-my $initdir = "/etc/init.d";
-
- my ($load,$mail,$email,$smtp,);
- $load = 3;
-
- begin:
- $::Wizard_finished = 0;
- $::Wizard_no_previous = 1;
- $in->ask_okcancel(_("Mail alert configuration"),
- _("Welcome to the mail configuration utility.\n\nHere, you'll be able to set up the alert system.\n"),
- 1) or quit();
-
- step_service:
- undef $::Wizard_no_previous;
- undef $::Wizard_finished;
- my $service = {
- httpd => _("Apache World Wide Web Server"),
- bind => _("Domain Name Resolver"),
- ftp => _("Ftp Server"),
- postfix => _("Postfix Mail Server"),
- samba => _("Samba Server"),
- sshd => _("SSH Server"),
- webmin => _("Webmin Service"),
- xinetd => _("Xinetd Service")
- };
- my @installed_d = ();
- foreach $serv (keys %$service) {
- -e "$initdir/$serv" && push (@installed_d,$serv);
- }
-
- $in->ask_from(_("service setting"),
- _("You will receive an alert if one of the selected services is no more running"),
- [ map { { label => "$_", val => \${ $_ }, type => "bool", text => "$service->{ $_ }" } } @installed_d
- ]) or goto begin;
-
- $cron .= "#- check services\n";
- foreach (@installed_d) {
- if(!-e "/var/lock/subsys/$_") { $r .= "Service $_ ($service->{$_} is not running\n" };
-# $cron .= "$r" if ${ $_ }; # take a look at this, don't know what is done here
- }
-
- step_load:
- undef $::Wizard_finished;
- $in->ask_from(_("load setting"),
- _("You will receive an alert if the load is higher than this value"),
- [
- { label => "load ", val => \$load, type => 'range', min => 1, max => 50 },
- ]) or goto step_service;
-
- $cron .= q@
-#- load
-my ($load) = split ' ', first(cat_("/proc/loadavg"));
-$r .= "Load is huge: $load\n" if ($load >@ . "$load);\n\n";
-
- step_output:
-# $::Wizard_no_previous = 1;
- $::Wizard_finished = 1;
- $in->ask_from(_("alert configuration"),
- _("Please enter your email address below "),
- [
- { label => "" },
- { label => "Email", val => \$email},
- ]) or goto step_load;
-
- $cron .= q@#- report it@;
- $cron .= q@
-$email = @. "'" . "$email" . "'" . ";\n\n";
-
- $cron .= q!
-open F, '|/usr/sbin/sendmail -oi -t';
-
-print F
-q(Subject: logdrake Mail Alert
-From: root@localhost
-To: ), "$email\n";
-print F $r;
-
-# EOF!;
- output "$cron_hourly", $cron;
- chmod 0755, $cron_hourly;
-
- print ("whole cron is ****** $cron *******\n");
-
- undef $::isWizard;
- $::WizardWindow->destroy if defined $::WizardWindow;
- undef $::WizardWindow;
-
-}
-
-
-#-------------------------------------------------------------
-# menu callback functions
-#-------------------------------------------------------------
-
-
-sub save {
- $::isWizard=0;
- $yy = $in->ask_file(_("Save as.."),"/root") or return;
- output($yy,$log_text->get_chars(0,$log_text->get_length()));
-}
-
-sub get_main_menu {
- my ($window) = @_;
- my $accel_group = new Gtk::AccelGroup();
- my $item_factory = new Gtk::ItemFactory('Gtk::MenuBar', '<main>', $accel_group);
- $item_factory->create_items(@menu_items);
- $window->add_accel_group($accel_group);
- return ($item_factory->get_widget('<main>'));
-}
-
-sub create_dialog {
- my ($label, $c) = @_;
- my $ret = 0;
- my $dialog = new Gtk::Dialog;
- $dialog->signal_connect (delete_event => sub { Gtk->main_quit() });
- $dialog->set_title(_("logdrake"));
- $dialog->border_width(10);
- $dialog->vbox->pack_start(new Gtk::Label($label),1,1,0);
-
- my $button = new Gtk::Button _("OK");
- $button->can_default(1);
- $button->signal_connect(clicked => sub { $ret = 1; $dialog->destroy(); Gtk->main_quit() });
- $dialog->action_area->pack_start($button, 1, 1, 0);
- $button->grab_default;
-
- if ($c) {
- my $button2 = new Gtk::Button _("Cancel");
- $button2->signal_connect(clicked => sub { $ret = 0; $dialog->destroy(); Gtk->main_quit() });
- $button2->can_default(1);
- $dialog->action_area->pack_start($button2, 1, 1, 0);
- }
-
- $dialog->show_all;
- Gtk->main();
- $ret;
-}
-
-sub destroy_window {
- my($widget, $windowref, $w2) = @_;
- $$windowref = undef;
- $w2 = undef if defined $w2;
- 0;
-}
diff --git a/perl-install/standalone/lsnetdrake b/perl-install/standalone/lsnetdrake
deleted file mode 100755
index 9865cee27..000000000
--- a/perl-install/standalone/lsnetdrake
+++ /dev/null
@@ -1,29 +0,0 @@
-#!/usr/bin/perl
-
-use lib qw(/usr/lib/libDrakX);
-use network::nfs;
-use network::smb;
-
-"@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}";
-
-my @l;
-push @l, network::nfs->new if $nfs;
-push @l, network::smb->new if $smb;
-
-foreach my $class (@l) {
- foreach my $server (sort_names($class->find_servers)) {
- foreach (sort_names($class->find_exports($server))) {
- print $class->to_fullstring($_), "\n";
- }
- }
-}
-
-sub sort_names {
- sort { $a->{name} cmp $b->{name} } @_;
-}
diff --git a/perl-install/standalone/mousedrake b/perl-install/standalone/mousedrake
deleted file mode 100755
index 06faca069..000000000
--- a/perl-install/standalone/mousedrake
+++ /dev/null
@@ -1,72 +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;
-
-
-local $_ = join '', @ARGV;
-
-/-h/ and die "usage: mousedrake [--auto] [--testing]\n";
-
-$::auto = /-auto/;
-$::testing = /-testing/;
-
-my $in = 'interactive'->vnew('su', 'mouse');
-
-modules::mergein_conf('/etc/modules.conf') if -r '/etc/modules.conf';
-
-undef $::Plug;
-begin:
-my $mouse = mouse::read();
-if (!$::noauto) {
- my $probed_mouse = mouse::detect();
- $mouse = $probed_mouse if !$mouse->{XMOUSETYPE} || !$probed_mouse->{unsafe};
-}
-
-$::isEmbedded and kill 'USR2', $::CCPID;
-if (!$mouse || !$::auto) {
- $mouse ||= mouse::fullname2mouse("serial|Generic 2 Button Mouse");
- if ($::isEmbedded && $in->isa('interactive::gtk')) {
- #- HACK: waiting for the ask_from_treelistf to attach itself
- #- and adding the nice test mouse to it
- Gtk->timeout_add(100, sub {
- defined $::Plug && defined $::Plug->child or return 1;
- mouse::test_mouse_standalone($mouse,$::Plug->child);
- 0;
- });
- }
- my $name = $in->ask_from_treelistf('mousedrake', _("Please, choose the type of your mouse."), '|',
- sub { join '|', map { translate($_) } split '\|', $_[0] },
- [ mouse::fullnames ],
- $mouse->{type} . '|' . $mouse->{name});
- $name or $::isEmbedded ? do { kill('USR1', $::CCPID); goto begin } : $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('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('', _("Emulate third button?"), 1));
-
- $mouse->{device} = $in->ask_from_listf(_("Mouse Port"),
- _("Please choose on which serial port your mouse is connected to."),
- \&mouse::serial_port2text,
- [ mouse::serial_ports ],
- $mouse->{device},
- ) || goto begin if $mouse->{type} eq 'serial';
-}
-
-mouse::write_conf($in, $mouse, 1);
-system('service', 'gpm', 'restart') if -e '/var/lock/subsys/gpm';
-
-$::isEmbedded ? kill('USR1', $::CCPID) : $in->exit(0);
-goto begin;
diff --git a/perl-install/standalone/net_monitor b/perl-install/standalone/net_monitor
deleted file mode 100755
index d7254ba99..000000000
--- a/perl-install/standalone/net_monitor
+++ /dev/null
@@ -1,539 +0,0 @@
-#!/usr/bin/perl
-
-# Monitor
-
-# Copyright (C) 1999 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 Gtk;
-use lib qw(/usr/lib/libDrakX);
-
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use my_gtk qw(:helpers :wrappers);
-#-use Data::Dumper;
-use common;
-use strict;
-use network::netconnect;
-use network::tools;
-use MDK::Common::Globals "network", qw($in $prefix $connect_file $disconnect_file $connect_prog);
-
-if ("@ARGV" =~ /--help|-h/) {
- print q(Network & Internet connection and monitoring application
-
---defaultintf interface : show this interface by default
---connect : connect to internet if not already connected
---disconnect : disconnect to internet if already connected
---force : used with (dis)connect : force (dis)connection.
---status : returns 1 if connected 0 otherwise, then exit.
---quiet : don't be interactive. To be used with (dis)connect.
-);
- exit(0);
-}
-
-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+)/;
-
-if ($force) {
- $connect and system("/etc/sysconfig/network-scripts/net_cnx_up");
- $disconnect and system("/etc/sysconfig/network-scripts/net_cnx_down");
- $connect = $disconnect = 0;
-}
-$quiet and exit(0);
-init Gtk;
-my $in = 'interactive'->vnew('su', 'default');
-
-
-my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel;
-$window1->signal_connect ( delete_event => sub { Gtk->exit(0); });
-$window1->set_position(1);
-$window1->set_title(_("Network Monitoring"));
-$window1->set_policy(1, 1, 1);
-$window1->set_border_width(5);
-#$::isEmbedded or $window1->set_usize(580, 320);
-
-my $colorr = my_gtk::gtkcolor(50400, 655, 20000);
-my $colort = my_gtk::gtkcolor(55400, 55400, 655);
-my $colora = my_gtk::gtkcolor(655, 50400, 655);
-my $isconnected=-1;
-my @interfaces;
-my $monitor = {};
-my $netcnx = {};
-my $netc = {};
-my $intf = {};
-my $c_time = 0;
-my $ct_tag;
-my $style= new Gtk::Style;
-$style->font(Gtk::Gdk::Font->fontset_load("-adobe-times-medium-r-normal-*-12-*-75-75-p-*-iso8859-*,*-r-*"));
-
-network::netconnect::load_conf($netcnx, $netc, $intf);
-network::netconnect::read_net_conf('', $netcnx, $netc);
-my $combo1 = new Gtk::Combo;
-$combo1->set_popdown_strings (network::netconnect::get_profiles() );
-$combo1->entry->set_text($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default");
-$combo1->entry->set_editable(0);
-MDK::Common::Globals::init(
- in => $in,
- prefix => '',
- connect_file => "/etc/sysconfig/network-scripts/net_cnx_up",
- disconnect_file => "/etc/sysconfig/network-scripts/net_cnx_down",
- connect_prog => "/etc/sysconfig/network-scripts/net_cnx_pg" );
-
-gtkadd($window1,
- gtkpack_(new Gtk::VBox(0,5),
- 0, _("Network Monitoring"),
- 1, gtkpack_(new Gtk::HBox(0,5),
- 1, my $notebook = new Gtk::Notebook,
- 0, gtkpack_(new Gtk::VBox(0,5),
- 0, gtkadd(gtkset_shadow_type(new Gtk::Frame(_("Settings")), 'etched_out'),
- gtkpack__(gtkset_border_width(new Gtk::VBox(0,5),5),
- gtkpack__(new Gtk::HBox(0,0),
- _("Connection type: "), my $label_cnx_type = new Gtk::Label("")),
- gtkpack__(new Gtk::HBox(0,0),
- _("Profile "), $combo1)
- )
- ),
- 1, gtkadd(gtkset_shadow_type(new Gtk::Frame(_("Statistics")), 'etched_out'),
- gtkpack__(new Gtk::VBox(0,0),
- create_packtable({ col_spacings => 1, row_spacings => 1},
- [ "", "instantaneous" , "average"],
- [ _("Sending Speed:"), my $label_st = new Gtk::Label(""), my $label_sta=new Gtk::Label("na")],
- [ _("Receiving Speed:"),my $label_sr= new Gtk::Label(""), my $label_sra=new Gtk::Label("na")],
- ),
- gtkpack__(new Gtk::HBox(0,0), " "._("Connection Time: "), my $label_ct = new Gtk::Label("")),
- )
- ),
- 0, gtkpack_(new Gtk::HBox(0,5),
- 1, gtksignal_connect(my $button_connect = gtkset_sensitive(new Gtk::Button(), 0), clicked => \&connection),
- 0, new Gtk::VSeparator,
- 0, gtkpack(new Gtk::VBox(0,5),
- gtksignal_connect(new Gtk::Button(_("Logs")), clicked => sub {
- -e "/usr/sbin/logdrake"
- ? system('/usr/sbin/logdrake --file=/var/log/messages &')
- : system('/usr/X11R6/bin/xvt -e "tail -f /var/log/messages " &')
- }),
- gtksignal_connect(my $button_close = new Gtk::Button(_("Close")), clicked => sub { Gtk->exit(0) }),
- )
- )
- )
- ),
- 0, my $statusbar = new Gtk::Statusbar
- )
- );
-$window1->show_all;
-$window1->realize;
-$combo1->entry->signal_connect( 'changed', sub {
- network::netconnect::set_profile($netcnx, $combo1->entry->get_text());
- network::netconnect::load_conf($netcnx, $netc, $intf);
- network::netconnect::set_net_conf($netcnx, $netc, $intf);
- network::netconnect::read_net_conf('', $netcnx, $netc);
- });
-my $gct = new Gtk::Gdk::GC($window1->window);
-$gct->set_foreground($colort);
-my $gcr = new Gtk::Gdk::GC($window1->window);
-$gcr->set_foreground($colorr);
-my $gca = new Gtk::Gdk::GC($window1->window);
-$gca->set_foreground($colora);
-my ($pix_c_map, $pix_c_mask) = gtkcreate_png("net_c.png");
-my ($pix_d_map, $pix_d_mask) = gtkcreate_png("net_d.png");
-my ($pix_u_map, $pix_u_mask) = gtkcreate_png("net_u.png");
-$button_connect->add(gtkpack__(new Gtk::VBox(0,3),
- my $pix_c = new Gtk::Pixmap($pix_u_map, $pix_u_mask),
- my $label_c = new Gtk::Label(_("Wait please"))
- ));
-$statusbar->push(1, _("Wait please, testing your connection..."));
-$window1->show_all();
-#$window1->set_policy (1, 1, 1);
-my $time_tag = Gtk->timeout_add(1000, \&rescan);
-my $time_tag2 = Gtk->timeout_add(20000, \&update);
-
-update();
-rescan();
-while ($isconnected == -1) {
- Gtk->main_iteration while Gtk->events_pending;
-}
-connection() if ($connect && !$isconnected || $disconnect && $isconnected);
-Gtk->main;
-Gtk->exit(0);
-
-my $during_connection;
-sub connection {
- $during_connection = 1;
- my $isconnected2 = $isconnected;
- $button_connect->set_sensitive(0);
- $button_close->set_sensitive(0);
- $statusbar->pop(1);
- $statusbar->push(1, $isconnected2 ? _("Disconnecting from Internet ") : _("Connecting to Internet "));
- if(!$isconnected2) {
- $c_time = time();
- $ct_tag = Gtk->timeout_add(1000, sub {
- my ($sec,$min,$hour) = gmtime(time() - $c_time);
- my $e = sprintf ("%02d:%02d:%02d", $hour, $min, $sec);
- $label_ct->set($e); 1; });
- } else { Gtk->timeout_remove($ct_tag) }
- my $nb_point=1;
- my $tag = Gtk->timeout_add(100, sub {
- $statusbar->pop(1);
- $statusbar->push(1, ($isconnected2 ? _("Disconnecting from Internet ") : _("Connecting to Internet "))
- . join('', map { "." } (1..$nb_point)));
- $nb_point++;
- 1;
- });
- my $netc = {};
- my $tag2 = Gtk->timeout_add(10000, sub {
- Gtk->timeout_remove($tag);
- $statusbar->pop(1);
- $statusbar->push(1, $isconnected2 ? ( $isconnected ?
- _("Disconnection from Internet failed.") :
- _("Disconnection from Internet complete.")) :
- ( $isconnected ?
- _("Connection complete.") :
- _("Connection failed.\nVerify your configuration in the Mandrake Control Center."))
- );
- my $tag3 = Gtk->timeout_add(10000, sub {
- $statusbar->pop(1);
- $statusbar->push(1, $isconnected ? _("Connected") : _("Not connected"));
- 0;
- });
- $button_connect->set_sensitive(1);
- $button_close->set_sensitive(1);
- undef $during_connection;
- 0;
- });
- Gtk->main_iteration while Gtk->events_pending;
- $tag2 = Gtk->timeout_add(1000, sub { system( $isconnected2 ? "/etc/sysconfig/network-scripts/net_cnx_down &" : "/etc/sysconfig/network-scripts/net_cnx_up &"); 0; });
-}
-
-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}} > 250;
-
- push(@{$monitor->{$intf}{stack_r}}, $recv - $refr);
- shift @{$monitor->{$intf}{stack_r}} if @{$monitor->{$intf}{stack_r}} > 250;
- $monitor->{$intf}{labelr}->set(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}} > 250;
-
- push(@{$monitor->{$intf}{stack_t}}, $transmit - $reft);
- shift @{$monitor->{$intf}{stack_t}} if @{$monitor->{$intf}{stack_t}} > 250;
- $monitor->{$intf}{labelt}->set(formatXiB($transmit - $monitor->{$intf}{initialt}));
- $monitor->{$intf}{referencet} = $transmit;
-
- draw_monitor($monitor->{$intf});
- }
- $label_sr->set(formatXiB($monitor->{sr}) . "/s");
- $label_st->set(formatXiB($monitor->{st}) . "/s");
- $monitor->{sra} += $monitor->{sr};
- $monitor->{sta} += $monitor->{st};
- $monitor->{nba} ++;
- if($monitor->{nba} > 9) {
- $label_sra->set(formatXiB($monitor->{sra}/10) . "/s");
- $label_sta->set(formatXiB($monitor->{sta}/10) . "/s");
- $monitor->{sra} = 0;
- $monitor->{sta} = 0;
- $monitor->{nba} = 0;
- }
- $label_cnx_type->set($netcnx->{type});
- $monitor->{$_} = 0 foreach ('sr', 'st');
- 1;
-}
-
-sub get_val {
- my @ret;
- my $a = cat_("/proc/net/dev");
- $a =~ s/^.*?\n.*?\n//;
- $a =~ s/^\s*lo:.*?\n//;
- my @line = split(/\n/, $a);
- foreach(@line) {
- s/\s*(\w*)://;
- my $intf=$1;
- push (@ret,$intf);
- $monitor->{$intf}{val} = [split()];
- $monitor->{$intf}{intf} = $intf;
- }
- @ret;
-}
-
-sub change_color {
- my ($color) = @_;
- my $window = new Gtk::Window -toplevel;
- my $doit;
- $window->signal_connect ( delete_event => sub { Gtk->main_quit() });
- $window->set_position(1);
- $window->set_title(_("Color configuration"));
- $window->set_border_width(5);
- gtkadd(gtkset_modal($window,1),
- gtkpack_(new Gtk::VBox(0,5),
- 1, my $colorsel = new Gtk::ColorSelection,
- 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -end),
- gtksignal_connect(new Gtk::Button(_("OK")), clicked => sub { $doit=1; Gtk->main_quit() }),
- gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub { Gtk->main_quit() }),
- )
- )
- );
- $colorsel->set_color($color->red()/65535, $color->green()/65535, $color->blue()/65535, $color->pixel());
- $window->show_all();
- Gtk->main;
- $window->destroy();
- $doit or return $color;
- my (@color) = $colorsel->get_color();
- my_gtk::gtkcolor($color[0]*65535, $color[1]*65535, $color[2]*65535);
-}
-
-my $scale;
-sub update {
- connected_bg(\$isconnected);
- my @intfs = get_val();
- if($combo1->entry->get_text ne ($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default")) {
- $combo1->entry->set_text($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default");
- }
- 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];
- $monitor->{$intf}{darea} = new Gtk::DrawingArea();
- $monitor->{$intf}{darea}->set_events(["pointer_motion_mask"]);
- $notebook->append_page(gtkshow(my $page = gtkpack_(new Gtk::VBox(0,0),
- 0, gtkpack__(gtkset_border_width(new Gtk::HBox(0,0), 5),
- gtksize($monitor->{$intf}{darea},300, 150)),
- 0, gtkpack_(new Gtk::HBox(0,0),
- 1, gtkpack__(new Gtk::VBox(0,0),
- gtkpack__(gtkset_border_width(new Gtk::HBox(0,5), 5),
- gtksignal_connect(my $button_t = gtkset_relief(new Gtk::Button(), 'none'), clicked => sub {
- $colort = change_color($colort);
- $gct->set_foreground($colort);
- $_[0]->draw(undef);
- }),
- _("sent: "), $monitor->{$intf}{labelt} = new Gtk::Label("0")),
- gtkpack__(gtkset_border_width(new Gtk::HBox(0,5), 5),
- gtksignal_connect(my $button_r = gtkset_relief(new Gtk::Button(), 'none'), clicked => sub {
- $colorr = change_color($colorr);
- $gcr->set_foreground($colorr);
- $_[0]->draw(undef);
- }),
- _("received: "), $monitor->{$intf}{labelr} = new Gtk::Label("0")),
- gtkpack__(gtkset_border_width(new Gtk::HBox(0,5), 5),
- gtksignal_connect(my $button_a = gtkset_relief(new Gtk::Button(), 'none'), clicked => sub {
- $colora = change_color($colora);
- $gca->set_foreground($colora);
- $_[0]->draw(undef);
- }),
- _("average"))
- ),
- 0, gtkpack__(gtkset_border_width(new Gtk::VBox(0,0), 5),
- gtkadd(gtkset_shadow_type(new Gtk::Frame(_("Local measure")), 'etched_out'),
- gtkpack__(gtkset_border_width(new Gtk::VBox(0,0), 5),
- gtkpack__(new Gtk::HBox(0,0),
- _('sent: '),
- my $measure_t = new Gtk::Label("0")
- ),
- gtkpack__(new Gtk::HBox(0,0),
- _('received: '),
- my $measure_r = new Gtk::Label("0")
- )
- )
- )
- )
- )
- )),
- new Gtk::Label($intf));
- foreach my $i ([$button_t, $gct],[$button_r, $gcr],[$button_a, $gca]) {
- $i->[0]->add(gtksignal_connect(gtkshow(gtksize(gtkset_usize(new Gtk::DrawingArea(), 10, 10), 10, 10)), expose_event => sub{ $_[0]->window->draw_rectangle ($i->[1], 1, 0, 0, 10, 10)} ));
- }
- $notebook->set_page($notebook->page_num($page));
- $monitor->{$intf}{page}=($notebook->page_num($page));
- $monitor->{$intf}{pixmap_db} = new Gtk::Gdk::Pixmap($monitor->{$intf}{darea}->window, 300, 150);
- $monitor->{$intf}{referencer} = $monitor->{$intf}{val}->[0];
- $monitor->{$intf}{referencet} = $monitor->{$intf}{val}->[8];
- $monitor->{$intf}{pixmap_db}->draw_rectangle ($monitor->{$intf}{darea}->style->black_gc, 1, 0, 0, 300, 150);
- $monitor->{$intf}{darea}->signal_connect( motion_notify_event =>
- sub { my ($w, $e) = @_;
- my $x = $e->{'x'} - 50;
- my $y = $e->{'y'};
- my $received = $x >= 0 ? $monitor->{$intf}{stack_r}[$x] : 0;
- my $transmitted = $x >= 0 ? $monitor->{$intf}{stack_t}[$x] : 0;
- my $type;
- $y * $scale / 150 < $transmitted and $type = _('transmitted');
- (150 - $y) * $scale / 150 < $received and $type = _('received');
- $measure_r->set(formatXiB($received));
- $measure_t->set(formatXiB($transmitted));
- });
- $monitor->{$intf}{darea}->signal_connect( expose_event => sub {
- $monitor->{$intf}{darea}->window->draw_pixmap ($monitor->{$intf}{darea}->style->bg_gc('normal'),
- $monitor->{$intf}{pixmap_db}, 0, 0, 0, 0, 300, 150);
- });
- }
- }
- foreach(@interfaces) {
- my $intf = $_;
- if(!member($intf,@intfs)) {
- $notebook->remove_page($monitor->{$intf}{page});
- }
- }
- @interfaces = @intfs;
- my $netc={};
- my $tmp;
- connected_bg(\$tmp);
- if(defined $tmp) {
- $isconnected = $tmp;
- if ($isconnected != -1 && !$during_connection) {
- if($isconnected && !in_ifconfig($netcnx->{NET_INTERFACE})) {
- $isconnected=0;
- $statusbar->pop(1);
- $statusbar->push(1, _("Warning, another internet connexion 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 ? _("Connected") : _("Not connected"));
- }
- $label_c->set($isconnected ? _("Disconnect %s", $netcnx->{type}) : _("Connect %s", $netcnx->{type}));
- $isconnected ? $pix_c->set($pix_c_map, $pix_c_mask) : $pix_c->set($pix_d_map, $pix_d_mask);
- $button_connect->set_sensitive(1);
- }
- }
- if (!(-e $connect_file && -e $disconnect_file)) {
- $button_connect->set_sensitive(0);
- $label_c->set("No internet connection configured");
- }
- 1;
-}
-
-sub in_ifconfig {
- my ($intf) = @_;
- -e '/sbin/ifconfig' or return 1;
- $intf eq '' and return 1;
- `/sbin/ifconfig` =~ /$intf/;
-}
-
-sub draw_monitor {
- my ($o) = @_;
- defined $o->{darea} or return;
- $o->{pixmap_db}->draw_rectangle ($o->{darea}->style->black_gc, 1, 0, 0, 300, 150);
- my $maxr = 0;
- foreach (@{$o->{stack_r}}) { $maxr = $_ if $_>$maxr }
- my $maxt = 0;
- foreach (@{$o->{stack_t}}) { $maxt = $_ if $_>$maxt }
- my $ech = $maxr + $maxt;
- $ech == 0 and $ech = 1;
- $scale = $ech;
- my $step=49;
- foreach (@{$o->{stack_t}}) {
- $o->{pixmap_db}->draw_rectangle($gct, 1, $step, 0, 1, $_*150/$ech);
- $step++;
- }
- $step=49;
- my ($av1, $av2, $last_a);
- foreach (@{$o->{stack_ta}}) {
- if($_ != -1) {
- if( !defined $av1) { $av1 = $_ } else { defined $av2 or $av2 = $_ }
- if ($av1 && $av2) {
- $o->{pixmap_db}->draw_line($gca, $step-15, $av1*150/$ech, $step-5, $av2*150/$ech);
- $av1 = $av2;
- undef $av2;
- $last_a = $step-50;
- }
- }
- $step++;
- }
- $step=49;
- foreach (@{$o->{stack_r}}) {
- $o->{pixmap_db}->draw_rectangle($gcr, 1, $step, 151-$_*150/$ech, 1, $_*150/$ech);
- $step++;
- }
- $step=49;
- ($av1, $av2) = undef;
- foreach (@{$o->{stack_ra}}) {
- if($_ != -1) {
- if(!defined $av1) { $av1 = $_ } else { defined $av2 or $av2 = $_ }
- if ((defined $av1) && (defined $av2)) {
- $o->{pixmap_db}->draw_line($gca, $step-15, 151-$av1*150/$ech, $step-5, 151-$av2*150/$ech);
- $av1 = $av2;
- undef $av2;
- }
- }
- $step++;
- }
-
- my $switch = 1;
- my $gcl = new Gtk::Gdk::GC($o->{darea}->window);
- $gcl->set_foreground($o->{darea}->window->get_colormap->color_white());
- $gcl->set_line_attributes (1, 'on-off-dash', 'not-last', 'round');
- for (my $i = 30;$i<=120;$i+=30) {
- $o->{pixmap_db}->draw_line($gcl, 50, $i, 300, $i);
- my ($gc2, $text);
- my ($dif1, $dif2);
- if ($last_a) {
- $dif1 = abs(150-@{$o->{stack_ra}}[$last_a]*150/$ech - $i);
- $dif2 = abs(@{$o->{stack_ta}}[$last_a]*150/$ech - $i);
- } else {
- $dif1 = abs(150-@{$o->{stack_r}}[@{$o->{stack_r}}-1]*150/$ech - $i);
- $dif2 = abs(@{$o->{stack_t}}[@{$o->{stack_t}}-1]*150/$ech - $i);
- }
- if ($dif1 < $dif2) {
- $text = formatXiB((150-$i)*$ech/150);
- $gc2=$gcr;
- my $x_l=5;
- if ($i > 30 && $switch) {
- $o->{pixmap_db}->draw_line($gct, $x_l, 0, $x_l, $i-30);
- $o->{pixmap_db}->draw_line($gct, $x_l-1, 0, $x_l-1, $i-30);
- $o->{pixmap_db}->draw_line($gct, $x_l+1, 0, $x_l+1, $i-30);
- $o->{pixmap_db}->draw_polygon($gct, 1, $x_l-4, $i-30, $x_l+5, $i-30, $x_l, $i-25);
- }
- if ($switch) {
- $o->{pixmap_db}->draw_line($gcr, $x_l, 150, $x_l, $i);
- $o->{pixmap_db}->draw_line($gcr, $x_l-1, 150, $x_l-1, $i);
- $o->{pixmap_db}->draw_line($gcr, $x_l+1, 150, $x_l+1, $i);
- $o->{pixmap_db}->draw_polygon($gcr, 1, $x_l-5, $i, $x_l+5, $i, $x_l, $i-6);
- }
- undef $switch;
- } else {
- $text = formatXiB($i*$ech/150);
- $gc2=$gct;
- }
- my $w = $style->font->string_width($text);
- $o->{pixmap_db}->draw_string($style->font, $gc2, 45-$w, $i+5, ($text) );
- }
- $o->{darea}->draw(undef);
-}
diff --git a/perl-install/standalone/printerdrake b/perl-install/standalone/printerdrake
deleted file mode 100755
index f31ca3e68..000000000
--- a/perl-install/standalone/printerdrake
+++ /dev/null
@@ -1,80 +0,0 @@
-#!/usr/bin/perl
-
-# printerdrake
-# Copyright (C) 1999 MandrakeSoft (fpons@mandrakesoft.com)
-# Original version for printer configuration from pad.
-#
-# 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 printerdrake;
-use printer;
-use c;
-
-local $_ = join '', @ARGV;
-
-/-h/ and die "usage: printerdrake [--beginner] [--expert] [--auto] [--noauto] [--skiptest] [--testing] [--cups] [--lprng] [--lpd] [--pdq]\n";
-
-$::expert = 0;
-if (/-expert/) {
- $::expert = 1;
-} elsif (/-beginner/) {
- $::expert = 0;
-} else {
- printer::get_usermode ();
-}
-$::noauto = /-noauto/;
-$::testing = /-testing/;
-
-my $printer;
-
-my $in = 'interactive'->vnew('su', 'printer-mdk');
-
-my $commandline = $_;
-
-exit 0 if !printerdrake::first_time_dialog($printer, $in, 1);
-
-{
-# Check whether Foomatic is installed and install it if necessary
-printerdrake::install_foomatic($in);
-
-my $w = $in->wait_message(_("Printerdrake"), _("Reading printer data ..."));
-# Get what was installed before
-eval { $printer = printer::getinfo('') };
-# Choose the spooler by command line options
-$commandline =~ /-cups/ and
- $printer->{SPOOLER} = 'cups' and printer::read_configured_queues($printer);
-$commandline =~ /-lpr/ and
- $printer->{SPOOLER} = 'lpd' and printer::read_configured_queues($printer);
-$commandline =~ /-lpd/ and
- $printer->{SPOOLER} = 'lpd' and printer::read_configured_queues($printer);
-$commandline =~ /-lprng/ and
- $printer->{SPOOLER} ='lprng' and printer::read_configured_queues($printer);
-$commandline =~ /-pdq/ and
- $printer->{SPOOLER} = 'pdq' and printer::read_configured_queues($printer);
--r '/etc/modules.conf' and modules::mergein_conf('/etc/modules.conf');
-}
-
-begin:
-$::isEmbedded and kill 'USR2', $::CCPID;
-
-printerdrake::main($printer, $in, 1);
-
-$::isEmbedded ? kill('USR1', $::CCPID) : $in->exit(0);
-goto begin;
diff --git a/perl-install/standalone/scannerdrake b/perl-install/standalone/scannerdrake
deleted file mode 100755
index 4ce8c5add..000000000
--- a/perl-install/standalone/scannerdrake
+++ /dev/null
@@ -1,126 +0,0 @@
-#!/usr/bin/perl
-
-# scannerdrake $Id$
-# Yves Duret <yduret at mandrakesoft.com>
-# Copyright (C) 2001 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 standalone; #- warning, standalone must be loaded very first, for 'explanations'
-
-use interactive;
-use common;
-use scanner;
-
-for (@ARGV) {
- /^--version$/ and die 'version: $Id$ '."\n";
- /^--help$/ and die 'logdrake [--version] [--help] [--manual] [--device=dev] [--update-sane=sane_desc_dir] [--update-usbtable] [--dynamic=dev]';
- /^--update-usbtable$/ and do { scanner::updateScannerDBfromUsbtable(); exit };
- /^--update-sane=(.*)$/ and do { scanner::updateScannerDBfromSane($1); exit };
- /^--manual$/ and $::Manual=1;
- /^--dynamic=(.*)$/ and do { dynamic($1); exit };
-}
-
-$in = 'interactive'->vnew('su', 'default');
-$in->do_pkgs->install('sane-backends', 'xsane', if_($in->do_pkgs->is_installed('gimp'),'xsane-gimp'));
-if ($::Manual) { manual(); quit() }
-my $wait = $in->wait_message(_("Test ports"), _("Detecting devices ..."));
-@f = scanner::detect();
-$wait=undef;
-(@f) ? auto() : manual();
-quit();
-
-sub auto {
- foreach (@f) {
- if (member($_->{val}{DESCRIPTION}, keys %$scanner::scannerDB)) {
- my $name = $_->{val}{DESCRIPTION};
- $name =~ s/\s$//; #some HP entry have a trailing space, i will correct usbtable asap
- if ($scanner::scannerDB->{$name}{flags}{unsupported}) {
- $in->ask_warn('scannerdrake', _("The %s is not supported by this version of Mandrake Linux.", $name));
- return;
- }
- $in->ask_yesorno('scannerdrake',_("%s found on %s, configure it?",$name,$_->{port}),1) or manual();
- tryConfScanner($name, $_->{port});
- } else {
- $in->ask_yesorno('scannerdrake',_("%s is not in the scanner database, configure it manually?", $_->{val}{DESCRIPTION}),1) and manual();
- }
- }
-}
-
-sub manual {
- my $s = $in->ask_from_treelist('scannerdrake', _("Select a scanner"), '|', [' None', keys %$scanner::scannerDB], '') or return;
- return if $s eq ' None';
- if ($scanner::scannerDB->{$s}{flags}{unsupported}) {
- $in->ask_warn('scannerdrake', _("The %s is not supported by this version of Mandrake Linux.", $s));
- return;
- }
- tryConfScanner($s);
-}
-
-sub dynamic {
- @f = scanner::detect();
- foreach (@f) {
- if (member($_->{val}{DESCRIPTION}, keys %$scanner::scannerDB)) {
- my $name = $_->{val}{DESCRIPTION};
- $name =~ s/\s$//; #some HP entry have a trailing space, i will correct usbtable asap
- if ($scanner::scannerDB->{$name}{flags}{unsupported}) {
- $in->ask_warn('scannerdrake', _("The %s is not supported by this version of Mandrake Linux.", $name));
- return;
- }
- scanner::confScanner($name, $_->{port}) unless ($scanner::scannerDB->{$model}{flags}{unsupported});
- }
- }
-}
-
-sub tryConfScanner {
- # take care if interactive output is needed (unsupported, parallel..)
- my ($model, $port) = @_;
- if ($scanner::scannerDB->{$model}{flags}{unsupported}) {
- $in->ask_warn('scannerdrake', _("This %s scanner is unsupported", $model));
- return;
- }
- # if ($scanner::scannerDB->{$model}{driver} =~ /Parport/) {
- # $in->ask_warn('scannerdrake', _("This %s scanner uses parallel port, which is unsupported for the moment", $model));
- # return;
- # }
- if ($scanner::scannerDB->{$model}{driver} =~ /SCSI/) {
- #$in->ask_warn('scannerdrake', _("This %s scanner uses parallel port, which is unsupported for the moment", $model));
- #return;
- }
- if ($scanner::scannerDB->{$model}{ask} =~ /DEVICE/) {
- $port = '/dev/sg0';
- $in->ask_from('scannerdrake',
- _("Scannerdrake was not able to detect your %s scanner.\nPlease select the device where your scanner is plugged", $model),
- [
- { label => _("choose device"), val => \$port, list => ['/dev/sg0', '/dev/sg1', '/dev/sg2', '/dev/sg3', '/dev/sg4' ], not_edit => 0, sort => 1 },
- ],
- ) or manual();
- }
-
- if ($scanner::scannerDB->{$model}{server} =~ /printerdrake/) {
- $in->ask_warn('scannerdrake', _("This %s scanner must be configured by printerdrake.\nYou can launch printerdrake from the Mandrake Control Center in Hardware section.", $model));
- return;
- }
- scanner::confScanner($model,$port);
- $in->ask_warn(_("Congratulations!"),
- _("Your %s scanner has been configured.\nYou may now scan documents using ``XSane'' from Multimedia/Graphics in the applications menu.", $model));
-
-}
-
-sub quit {
- $::isEmbedded ? kill('USR1', $::CCPID) : $in->exit(0);
-}
diff --git a/perl-install/standalone/service_harddrake b/perl-install/standalone/service_harddrake
deleted file mode 100755
index b0da37509..000000000
--- a/perl-install/standalone/service_harddrake
+++ /dev/null
@@ -1,73 +0,0 @@
-#!/usr/bin/perl -w
-
-use lib qw(/usr/lib/libDrakX);
-
-use strict;
-use standalone; #- warning, standalone must be loaded very first, for 'explanations'
-use MDK::Common;
-use interactive;
-use harddrake::data;
-use Storable qw(store retrieve);
-
-my $hw_sysconfdir = "/etc/sysconfig/harddrake2";
-my $last_boot_config = $hw_sysconfdir."/previous_hw";
-
-# first run ? if not read old hw config
-my %previous_config = (-f $last_boot_config && -s $last_boot_config) ? retrieve($last_boot_config) : {};
-
-my (%config, $in);
-
-# For each hw, class, detect device, compare and offer to reconfigure if needed
-foreach (@harddrake::data::tree) {
- my ($Ident, $item, undef, $configurator, $detector, $do_it) = @$_;
- next unless $do_it;
- # No detector ? (should never happen but who know ?)
- ref($detector) eq 'CODE' or next;
-
- my %ID = map {
- my $i = $_;
- my $name = if_(defined $i->{device}, [$i->{device}, join ':', map { $i->{$_} } qw(vendor id subvendor subid)]);
- $name => $i;
- } &$detector;
- $config{$Ident} = \%ID;
-
- next if is_empty_hash_ref %previous_config;
- my $oldconfig = $previous_config{$Ident};
-
- my $msg;
- my @was_removed = difference2([ keys %$oldconfig ], [ keys %ID ]);
- $msg .= _("Some devices in the \"%s\" hardware class were removed:\n", $item) if @was_removed;
- $msg .= "- $_ was removed\n" foreach @was_removed;
-
- my @added = difference2([ keys %ID ], [ keys %$oldconfig ]);
- $msg .= _("\nSome devices in the %s class were added:\n", $item) if @added;
- $msg .= "- $_ was added\n" foreach @added;
- @added || @was_removed or next;
-
- next unless (-x $configurator);
-
- my $res;
- $SIG{ALRM} = sub { die "TIMED OUT\n" };
- undef $@;
- eval {
- alarm (5);
- $in = 'interactive'->vnew('su') unless defined $in;
- $res = $in->ask_okcancel("Hardware changes in $Ident class (5 seconds to answer)",
- $msg . "\nDo you want to run the appropriate config tool ?", 1)
- or $in->wait_message(_('Please wait'), _('Hardware probing in progress'));
- alarm (0);
- };
-
- next unless ($@ && $res); # timed out || canceled
- if (my $pid = fork) {
- require POSIX;
- POSIX::wait();
- } else {
- exec("$configurator 2>/dev/null") or die "$configurator missing\n";
- }
-}
-
-# output new hw config
-standalone::explanations "created file $last_boot_config";
-store \%config, $last_boot_config;
-$in->exit(0) if defined $in; exit 0;
diff --git a/perl-install/standalone/service_harddrake.sh b/perl-install/standalone/service_harddrake.sh
deleted file mode 100644
index b3da8d1a4..000000000
--- a/perl-install/standalone/service_harddrake.sh
+++ /dev/null
@@ -1,53 +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
- ;;
- *)
- gprintf "Usage: %s {start|stop}\n" "$0"
- exit 1
- ;;
-esac
diff --git a/perl-install/standalone/tinyfirewall b/perl-install/standalone/tinyfirewall
deleted file mode 100755
index e36a26b97..000000000
--- a/perl-install/standalone/tinyfirewall
+++ /dev/null
@@ -1,30 +0,0 @@
-#!/usr/bin/perl
-
-# Copyright (C) 1999-2002 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::tinyfirewall;
-
-my $in = 'interactive'->vnew('su', 'default');
-
-network::tinyfirewall::main($in);
-
-$in->exit;