diff options
Diffstat (limited to 'perl-install/standalone')
124 files changed, 0 insertions, 17746 deletions
diff --git a/perl-install/standalone/.perl_checker b/perl-install/standalone/.perl_checker deleted file mode 100644 index 202e0535f..000000000 --- a/perl-install/standalone/.perl_checker +++ /dev/null @@ -1 +0,0 @@ -Basedir .. diff --git a/perl-install/standalone/XFdrake b/perl-install/standalone/XFdrake deleted file mode 100755 index 229ec679b..000000000 --- a/perl-install/standalone/XFdrake +++ /dev/null @@ -1,106 +0,0 @@ -#!/usr/bin/perl - -# XFdrake -# 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 Xconfig::main; -use Xconfig::xfree; -use Xconfig::default; -use interactive; -use modules; -use common; -use any; -use c; - -local $_ = join '', @ARGV; - -my ($configure_this) = grep { !/^-/ } @ARGV; -$configure_this ||= 'everything'; - -{ - my $in = 'interactive'->vnew('su', 'X'); - - modules::mergein_conf('/etc/modules.conf') if -r '/etc/modules.conf'; - - my $rc = do { - my $options = { allowNVIDIA_rpms => $in->do_pkgs->check_kernel_module_packages('NVIDIA_kernel', 'NVIDIA_GLX'), - allowFB => listlength(cat_("/proc/fb")) }; - - if ($configure_this eq 'everything') { - check_XFree($in); - Xconfig::main::configure_everything_or_configure_chooser($in, $options, $::auto); - } elsif ($configure_this eq 'auto_install') { - Xconfig::main::configure_everything_auto_install(Xconfig::default::configure(), $in->do_pkgs, {}, $options); - } elsif ($configure_this eq 'monitor') { - Xconfig::main::configure_monitor($in, Xconfig::xfree->read); - } elsif ($configure_this eq 'resolution') { - Xconfig::main::configure_resolution($in, Xconfig::xfree->read); - } - }; - $rc && $rc eq 'config_changed' and ask_for_X_restart($in); - - $in->exit(0); -} - -sub check_XFree { - my ($in) = @_; - - #- set the standard configuration - foreach ('XF86Config', 'XF86Config-4') { - my $f = "/etc/X11/$_"; - symlinkf("$_.standard", $f) if -l $f && -e "$f.standard"; - } - - my $f = "/usr/X11R6/lib/X11/rgb.txt"; #- this one is on all platform - -e $f or $in->do_pkgs->install('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 ask_for_X_restart { - my ($in) = @_; - - $::isStandalone && $in->isa('interactive::gtk') or return; - - my ($wm, $pid) = any::running_window_manager(); - - if (!$wm) { - $in->ask_warn('', N("Please log out and then use Ctrl-Alt-BackSpace")); - return; - } - - $in->ask_okcancel('', N("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 4bbad2fa3..000000000 --- a/perl-install/standalone/adduserdrake +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use common; -use interactive; -use any; - -my @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'); - any::ask_users('', $in, $users, $ENV{SECURE_LEVEL}); -} - -system("adduser", $_->{name}) foreach @$users; -any::write_passwd_user('', $_, $isMD5) foreach @$users; -system("pwconv") if $isShadow; - -any::addUsers('', $users); - -$in->exit(0) if $in; diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake deleted file mode 100755 index 8afb3779e..000000000 --- a/perl-install/standalone/diskdrake +++ /dev/null @@ -1,120 +0,0 @@ -#!/usr/bin/perl - -# DiskDrake -# 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. - -# DiskDrake uses resize_fat which is a perl rewrite of the work of Andrew -# Clausen (libresize). -# DiskDrake is also based upon the libfdisk and the install from Red Hat Software - - -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use common; -use interactive; -use detect_devices; -use fsedit; -use fs; -use log; -use c; - -my %options; -my @l = @ARGV; -while (my $e = shift @l) { - my ($option) = $e =~ /--?(.*)/ or next; - if ($option =~ /(.*?)=(.*)/) { - $options{$1} = $2; - } else { - $options{$option} = ''; - } -} - -my @types = qw(hd nfs smb dav removable fileshare list-hd); -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') { - require any; - 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::get_info_from_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 'list-hd') { - print partition_table::description($_), "\n" foreach fsedit::get_all_fstab($all_hds); -} elsif ($type eq 'hd') { - require diskdrake::interactive; - diskdrake::interactive::main($in, $all_hds, 0, '', ''); -} elsif ($type eq 'removable') { - require diskdrake::removable; - $para =~ s|^/dev/||; - my ($raw_hd) = $para ? - first(grep { $para eq $_->{device} } @{$all_hds->{raw_hds}}) || die "unknown removable $para\n" : - $in->ask_from_listf('', '', \&diskdrake::interactive::format_raw_hd_info, $all_hds->{raw_hds}) or $in->exit(0); - - if (!$raw_hd->{mntpoint}) { - my $mntpoint = detect_devices::suggest_mount_point($raw_hd); - $raw_hd->{mntpoint} ||= find { !fsedit::has_mntpoint($_, $all_hds) } map { "/mnt/$mntpoint$_" } '', 2 .. 10; - - my $useSupermount = 1; - require security::level; - require lang; - fs::set_default_options($raw_hd, - is_removable => 1, - useSupermount => $useSupermount, - security => security::level::get(), - lang::fs_options(lang::read())); - } - 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 e5a4a95d2..000000000 --- a/perl-install/standalone/drakTermServ +++ /dev/null @@ -1,1578 +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 (on x86), mkinitrd-net, terminal-server, dhcp-server -# clusternfs, tftp-server -# -# 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 lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' -use strict; - -use interactive; -use ugtk2 qw(:helpers :wrappers :create); -use common; -use run_program; - -use Config; -use POSIX; - -my $in = 'interactive'->vnew('su'); - -my @buff; #- used to display status info - -my $central_widget; -my $window1; -my $windows; -my $status_box; -my $main_box; - -my $nfs_subnet; -my $nfs_mask; -my $thin_clients = 0; -my $cfg_dir = "/etc/drakxtools/draktermserv/"; -my $cfg_file = $cfg_dir . "draktermserv.conf"; -my $server_ip = get_ip_from_sys(); - -#- 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 == 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, 0/1 for THIN_CLIENT...\n" if $#ARGV < 5; - my $cmd_line = 1; - addclient($cmd_line, $ARGV[1], $ARGV[2], $ARGV[3], $ARGV[4], $ARGV[5]); - exit(0); -} - -if ("@ARGV" =~ /--delclient/) { - die "$0 $ARGV[0] requires hostname...\n" if $#ARGV < 1; - my $cmd_line = 1; - delclient($cmd_line, $ARGV[1]); - exit(0); -} - -read_conf_file(); -interactive_mode() if $#ARGV < 1; - -sub read_conf_file() { - if (-e $cfg_file) { - local *CONF_FILE; - open(CONF_FILE, "<" . $cfg_file) || print "You must be root to read configuration file. \n"; - local $_; - while (<CONF_FILE>) { - if (/^\bALLOW_THIN\b/) { - $thin_clients = 1; - last; - } - } - } -} - -sub write_conf_file() { - my @cfg_list; - if ($thin_clients == 1) { - @cfg_list = "ALLOW_THIN\n"; - } - output_p($cfg_file, @cfg_list); - chmod(0600, $cfg_file); -} - -sub write_thin_inittab { - my ($client_ip) = @_; - - my $inittab = " -# /etc/inittab\$\$IP=$client_ip\$\$ -# created by drakTermServ - -id:5:initdefault: - -# System initialization. -si::sysinit:/etc/rc.d/rc.sysinit - -l0:0:wait:/etc/rc.d/rc 0 -l1:1:wait:/etc/rc.d/rc 1 -l2:2:wait:/etc/rc.d/rc 2 -l3:3:wait:/etc/rc.d/rc 3 -l4:4:wait:/etc/rc.d/rc 4 -l5:5:wait:/etc/rc.d/rc 5 -l6:6:wait:/etc/rc.d/rc 6 - -# Things to run in every runlevel. -ud::once:/sbin/update - -# Trap CTRL-ALT-DELETE -ca::ctrlaltdel:/sbin/reboot -f - -# Run gettys in standard runlevels -1:2345:respawn:/sbin/mingetty tty1 - -# Connect to X server -x:5:respawn:/usr/X11R6/bin/X -ac -query $server_ip\n"; - - my $inittab_file = "/etc/inittab\$\$IP=$client_ip\$\$"; - local *INITTAB; - open(INITTAB, "> $inittab_file") or warn("Can't open $inittab_file!"); - print INITTAB $inittab; - close INITTAB -} - -sub cursor_wait() { - # turn the cursor to a watch - $window1->{rwindow}->window->set_cursor(new Gtk2::Gdk::Cursor("GDK_WATCH")); - gtkflush(); -} - -sub cursor_norm() { - # restore normal cursor - $window1->{rwindow}->window->set_cursor(new Gtk2::Gdk::Cursor("GDK_LEFT_PTR")); - gtkflush(); -} - -sub display_error { - my ($message) = @_; - my $error_box; - $$central_widget->destroy(); - gtkpack($status_box, - $error_box = gtkpack_(new Gtk2::VBox(0,0), - 1, new Gtk2::Label($message), - 0, gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("OK")), clicked => sub { - $$central_widget->destroy(); - }), - ), - ) - ); - $central_widget = \$error_box; -} - -sub interactive_mode() { - $window1 = ugtk2->new('drakTermServ'); - $window1->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) }); - unless ($::isEmbedded) { - $window1->{rwindow}->set_position('center'); - $window1->{rwindow}->set_title(N("Mandrake Terminal Server Configuration")); - } - $window1->{rwindow}->set_border_width(5); - - gtkadd($window1->{window}, - gtkpack_(new Gtk2::VBox(0,2), - if_(!$::isEmbedded, 0, gtkcreate_img("drakTS.620x57")), - 1, gtkpack_(new Gtk2::HBox(0,2), - 1, gtkpack_(new Gtk2::VBox(0,2), - 1, gtkpack($status_box = new Gtk2::VBox(0,5), - $main_box = new Gtk2::VBox(0,10), - ), - 1, gtkpack_(new Gtk2::HBox(0,2), - 0, gtkadd(gtkset_layout(Gtk2::VButtonBox->new(), 'end'), - gtksignal_connect(new Gtk2::Button(N("Enable Server")), clicked => sub { - $$central_widget->destroy(); - $windows = 1; - cursor_wait(); - enable_ts(); - cursor_norm(); - }), - gtksignal_connect(new Gtk2::Button(N("Disable Server")), clicked => sub { - $$central_widget->destroy(); - cursor_wait(); - disable_ts(); - cursor_norm(); - }), - ), - 0, gtkadd(gtkset_layout(Gtk2::VButtonBox->new(), 'end'), - gtksignal_connect(new Gtk2::Button(N("Start Server")), clicked => sub { - $$central_widget->destroy(); - $windows = 0; - cursor_wait(); - start_ts(); - cursor_norm(); - }), - gtksignal_connect(new Gtk2::Button(N("Stop Server")), clicked => sub { - $$central_widget->destroy(); - cursor_wait(); - stop_ts(); - cursor_norm(); - }), - ), - 0, gtkadd(gtkset_layout(Gtk2::VButtonBox->new(), 'end'), - gtksignal_connect(new Gtk2::Button(N("Etherboot Floppy/ISO")), clicked => sub { - $$central_widget->destroy(); - $windows = 1; - make_boot(); - }), - gtksignal_connect(new Gtk2::Button(N("Net Boot Images")), clicked => sub { - $$central_widget->destroy(); - make_nbi(); - }), - ), - 0, gtkadd(gtkset_layout(Gtk2::VButtonBox->new(), 'end'), - gtksignal_connect(new Gtk2::Button(N("Add/Del Users")), clicked => sub { - $$central_widget->destroy(); - $windows = 0; - maintain_users(); - }), - gtksignal_connect(new Gtk2::Button(N("Add/Del Clients")), clicked => sub { $$central_widget->destroy(); maintain_clients() }), - ), - 1, new Gtk2::HBox(0,2), - 0, gtkadd(gtkset_layout(Gtk2::VButtonBox->new(), 'end'), - gtksignal_connect(new Gtk2::Button(N("Help")),clicked => sub { - $$central_widget->destroy(); - help(); - }), - gtksignal_connect(new Gtk2::Button(N("Close")), clicked => sub { - write_conf_file(); - Gtk2->main_quit(); - }), - ), - ), - ), - ), - ), - ); - $central_widget = \$main_box; - $window1->{rwindow}->show_all; - $window1->{rwindow}->realize; - $window1->{rwindow}->show_all(); - - $window1->main; - ugtk2->exit(0); -} - -sub about() { - text_view(N(" - Copyright (C) 2002 by MandrakeSoft - Stew Benedict sbenedict\@mandrakesoft.com - -") . $::license . N(" - - Thanks: - - LTSP Project http://www.ltsp.org - - Michael Brown <mbrown\@fensystems.co.uk> - -")); -} - -sub text_view { - my ($text) = @_; - my $box; - gtkpack($status_box, - $box = gtkpack_(new Gtk2::VBox(0,10), - 1, gtkpack_(new Gtk2::HBox(0,0), - 1, create_scrolled_window(gtktext_insert( -# gtkset_editable( - new Gtk2::TextView, -# 1) - [ [ $text ] ]) - ), - ), - 0, gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("OK")), clicked => - sub { $$central_widget->destroy() }), - ), - ) - ); - $central_widget = \$box; - $status_box->show_all(); -} - -sub help() { - text_view(N("drakTermServ Overview - - - Create Etherboot Enabled Boot Images: - To boot a kernel via etherboot, a special kernel/initrd image must be created. - mkinitrd-net does much of this work and drakTermServ is just a graphical interface - to help manage/customize these images. - - - Maintain /etc/dhcpd.conf: - To net boot clients, each client needs a dhcpd.conf entry, assigning an IP address - and net boot images to the machine. drakTermServ helps create/remove these entries. - - (PCI cards may omit the image - etherboot will request the correct image. You should - also consider that when etherboot looks for the images, it expects names like - boot-3c59x.nbi, rather than boot-3c59x.2.4.19-16mdk.nbi). - - A typical dhcpd.conf stanza to support a diskless client looks like: - - host curly { - hardware ethernet 00:20:af:2f:f7:9d; - fixed-address 192.168.192.3; - #type fat; - filename \"i386/boot/boot-3c509.2.4.18-6mdk.nbi\"; - } - - While you can use a pool of IP addresses, rather than setup a specific entry for - a client machine, using a fixed address scheme facilitates using the functionality - of client-specific configuration files that ClusterNFS provides. - - Note: The \"#type\" entry is only used by drakTermServ. Clients can either be \"thin\" - or 'fat'. Thin clients run most software on the server via xdmcp, while fat clients run most - software on the client machine. A special inittab, /etc/inittab\$\$IP=client_ip\$\$ is - written for thin clients. System config files xdm-config, kdmrc, and gdm.conf are modified - if thin clients are used, to enable xdmcp. Since there are security issues in using xdmcp, - hosts.deny and hosts.allow are modified to limit access to the local subnet. - - Note: 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/X11/XF86Config-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 can 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 - - -")); -} - -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 Gtk2::List(); - my $nic; - - foreach (@nics) { - my $t = $_; - $list_nics->add(gtkshow(gtksignal_connect(new Gtk2::ListItem($t), - select => sub { $nic = $t }))); - } - $list_nics->set_selection_mode('single'); - - gtkpack($status_box, - $boot_box = gtkpack_(new Gtk2::VBox(0,10), - 0, gtkadd(new Gtk2::HBox(0,10), - new Gtk2::HBox(0,5), - create_scrolled_window($list_nics), - gtkadd(new Gtk2::VBox(1,10), - new Gtk2::HBox(0,20), - gtksignal_connect(new Gtk2::Button(N("Boot Floppy")), clicked => - sub { write_eb_image($nic, $rom_path, "floppy") }), - gtksignal_connect(new Gtk2::Button(N("Boot ISO")), clicked => - sub { write_eb_image($nic, $rom_path, "iso") }), - new Gtk2::HBox(0,20), - ), - new Gtk2::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 $model = Gtk2::TreeStore->new(Gtk2::GType->STRING); - my $tree_kernels = Gtk2::TreeView->new_with_model($model); - $tree_kernels->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $tree_kernels->set_headers_visible(0); - $tree_kernels->get_selection->set_mode('single'); - - foreach (@kernels) { - my $t_kernel = Gtk2::TreeIter->new; - $model->append($t_kernel, undef); - $model->set($t_kernel, [ 0 => $_ ]); - my $k_detail = Gtk2::TreeIter->new; - foreach (@nics) { - $model->append($k_detail, $t_kernel); - $model->set($k_detail, [ 0 => $_ ]); - } - $k_detail->free; - } - - $tree_kernels->get_selection->signal_connect(changed => sub { - $kernel = ''; - $nic = ''; - my ($model, $iter) = $_[0]->get_selected; - $model && $iter or return; - my $value = $model->get($iter, 0); - my $path = $model->get_path_str($iter); - if ($path !~ /:/) { - $kernel = $value; - } else { - my @elements = split(/:/, $path); - $nic = $value; - $kernel = $kernels[$elements[0]]; - } - }); - - # existing nbi images in list - my $list_model = Gtk2::ListStore->new(Gtk2::GType->STRING); - my $list_nbis = Gtk2::TreeView->new_with_model($list_model); - $list_nbis->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $list_nbis->set_headers_visible(0); - my @nbis = grep { /\.nbi/ } all("/var/lib/tftpboot"); - my $nbi; - my $iter = Gtk2::TreeIter->new; - my $nbi_iter; - - foreach (@nbis) { - $list_model->append($iter); - $list_model->set($iter, [ 0 => $_ ]); - } - - $list_nbis->get_selection->signal_connect(changed => sub { - my ($model, $iter) = $_[0]->get_selected; - $model && $iter or return; - $nbi = $model->get($iter, 0); - $nbi_iter = $iter; - }); - - gtkpack($status_box, - $nbi_box = gtkpack_(new Gtk2::VBox(1,10), - 0, gtkadd(new Gtk2::HBox(0,10), - create_scrolled_window($tree_kernels), - gtkadd(new Gtk2::VBox(1,10), - gtksignal_connect(new Gtk2::Button(N("Build Whole Kernel -->")), clicked => - sub { if ($kernel) { - $in->ask_warn('', N("This will take a few minutes.")); - cursor_wait(); - system("/usr/bin/mknbi-set -k /boot/$kernel"); - $list_model->clear; - @nbis = grep { /\.nbi/ } all("/var/lib/tftpboot"); - foreach (@nbis) { - $list_model->append($iter); - $list_model->set($iter, [ 0 => $_ ]); - } - cursor_norm(); - } else { - $in->ask_warn('', N("No kernel selected!")) if !($kernel); - } - }), - gtksignal_connect(new Gtk2::Button(N("Build Single NIC -->")), clicked => - sub { if ($nic) { - system("/usr/bin/mknbi-set -k /boot/$kernel -r $nic"); - $list_model->clear; - @nbis = grep { /\.nbi/ } all("/var/lib/tftpboot"); - foreach (@nbis) { - $list_model->append($iter); - $list_model->set($iter, [ 0 => $_ ]); - } - } else { - $in->ask_warn('', N("No NIC selected!")); - } - }), - gtksignal_connect(new Gtk2::Button(N("Build All Kernels -->")), clicked => sub { - $in->ask_warn('', N("This will take a few minutes.")); - cursor_wait(); - system("/usr/bin/mknbi-set"); - $list_model->clear; - @nbis = grep { /\.nbi/ } all("/var/lib/tftpboot"); - foreach (@nbis) { - $list_model->append($iter); - $list_model->set($iter, [ 0 => $_ ]); - } - cursor_norm(); - }), - new Gtk2::HBox(1,1), - gtksignal_connect(new Gtk2::Button(N("<-- Delete")), clicked => - sub { my $nbi = "/var/lib/tftpboot/" . $nbi; - my $result = unlink($nbi) || warn("Can't delete $nbi..."); - if ($result == 1) { - $list_model->remove($nbi_iter); - } - }), - gtksignal_connect(new Gtk2::Button(N("Delete All NBIs")), clicked => - sub { cursor_wait(); - foreach (grep { /\.nbi/ } all("/var/lib/tftpboot")) { - my $nbi = "/var/lib/tftpboot/" . $_; - unlink($nbi) || warn("Can't delete $nbi..."); - } - $list_model->clear; - cursor_norm(); - }), - new Gtk2::HBox(1,1), - ), - create_scrolled_window($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_model = Gtk2::ListStore->new(Gtk2::GType->STRING); - my $list_sys_users = Gtk2::TreeView->new_with_model($list_model); - $list_sys_users->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $list_sys_users->set_headers_visible(0); - - my $iter = Gtk2::TreeIter->new; - my $sys_user; - - foreach (@sys_users) { - my ($s_label) = split(/:/, $_, 2); - if (grep { /$s_label/ } @homes) { - $list_model->append($iter); - $list_model->set($iter, [ 0 => $s_label ]); - } - } - $iter->free; - - $list_sys_users->get_selection->signal_connect(changed => sub { - my ($model, $iter) = $_[0]->get_selected; - $model && $iter or return; - $sys_user = $model->get($iter, 0); - }); - - $list_model = Gtk2::ListStore->new(Gtk2::GType->STRING); - my $list_ts_users = Gtk2::TreeView->new_with_model($list_model); - $list_ts_users->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $list_ts_users->set_headers_visible(0); - - $iter = Gtk2::TreeIter->new; - my $ts_user; - - foreach (@ts_users) { - my ($t_label) = split(/:/, $_, 2); - my @system_entry = grep { /$t_label/ } @sys_users; - $t_label = $t_label . " !!!" if $_ ne $system_entry[0]; - $list_model->append($iter); - $list_model->set($iter, [ 0 => $t_label ]); - } - - $list_ts_users->get_selection->signal_connect(changed => sub { - my ($model, $iter) = $_[0]->get_selected; - $model && $iter or return; - $ts_user = $model->get($iter, 0); - }); - - gtkpack($status_box, - $user_box = gtkpack_(new Gtk2::VBox(0,10), - 0, gtkadd(new Gtk2::Label(N("!!! Indicates the password in the system database is different than\n the one in the Terminal Server database.\nDelete/re-add the user to the Terminal Server to enable login."))), - 0, gtkadd(new Gtk2::HBox(0,20), - create_scrolled_window($list_sys_users), - gtkadd(new Gtk2::VBox(1,10), - new Gtk2::HBox(0,10), - gtksignal_connect(new Gtk2::Button(N("Add User -->")), clicked => - sub { my $result = adduser(0, $sys_user); - if ($result == 0) { - $list_model->append($iter); - $list_model->set($iter, [ 0 => $sys_user ]); - } - }), - gtksignal_connect(new Gtk2::Button(N("<-- Del User")), clicked => - sub { deluser(0, $ts_user); - $list_model->remove($iter); - }), - new Gtk2::HBox(0,10), - ), - create_scrolled_window($list_ts_users), - ),), - ); - - $central_widget = \$user_box; - $user_box->show_all(); -} - -sub maintain_clients() { - #- add client machines to Terminal Server config - my $client_box; - my %clients = read_dhcpd_conf(); - my $client; - my $citer; - - #- client info in tree view - my $model = Gtk2::TreeStore->new(Gtk2::GType->STRING); - my $tree_clients = Gtk2::TreeView->new_with_model($model); - $tree_clients->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $tree_clients->set_headers_visible(0); - $tree_clients->get_selection->set_mode('browse'); - - foreach my $key (keys(%clients)) { - my $t_client = Gtk2::TreeIter->new; - $model->append($t_client, undef); - $model->set($t_client, [ 0 => $key ]); - - my $c_detail = Gtk2::TreeIter->new; - - $model->append($c_detail, $t_client); - $model->set($c_detail, [ 0 => $clients{$key}{hardware} ]); - - $model->append($c_detail, $t_client); - $model->set($c_detail, [ 0 => $clients{$key}{address} ]); - - $model->append($c_detail, $t_client); - $model->set($c_detail, [ 0 => N("type: %s", $clients{$key}{type}) ]); - - if ($clients{$key}{filename}) { - $model->append($c_detail, $t_client); - $model->set($c_detail, [ 0 => $clients{$key}{filename} ]); - } - } - - $tree_clients->get_selection->signal_connect(changed => sub { - my ($model, $iter) = $_[0]->get_selected; - $model && $iter or return; - my $value = $model->get($iter, 0); - my $path = $model->get_path_str($iter); - if ($path !~ /:/) { - $client = $value; - $citer = $iter; - } else { - $client = ''; - } - }); - - #- entry boxes for client data entry - my $label_host = new Gtk2::Label("Client Name:"); - $label_host->set_justify('left'); - my $entry_host = new Gtk2::Entry(); - my $label_mac = new Gtk2::Label("MAC Address:"); - $label_mac->set_justify('left'); - my $entry_mac = new Gtk2::Entry(); - my $label_ip = new Gtk2::Label("IP Address:"); - $label_ip->set_justify('left'); - my $entry_ip = new Gtk2::Entry(); - my $label_nbi = new Gtk2::Label("Kernel Netboot Image:"); - $label_nbi->set_justify('left'); - my $entry_nbi = new Gtk2::Combo(); - - my @images = grep { /\.nbi/ } all("/var/lib/tftpboot/"); - my $have_nbis = @images; - if ($have_nbis) { - unshift(@images, ""); - $entry_nbi->set_popdown_strings(@images); - } else { - $in->ask_warn('', N("No net boot images created!")); - make_nbi(); - return 1; - } - - my $check_thin; - my $check_allow_thin; - my $is_thin = 0; - - gtkpack($status_box, - $client_box = gtkpack_(new Gtk2::VBox(1,10), - 0, gtkadd(new Gtk2::HBox(0,5), - gtkadd(new Gtk2::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 Gtk2::VBox(1,10), - gtkadd(new Gtk2::HBox(0,1), - gtksignal_connect($check_thin = new Gtk2::CheckButton(N("Thin Client")), clicked => - sub { invbool \$is_thin }), - $check_allow_thin = new Gtk2::CheckButton(N("Allow Thin Clients")), - ), -# new Gtk2::HBox(1,1), - gtksignal_connect(new Gtk2::Button(N("Add Client -->")), clicked => - sub { my $hostname = $entry_host->get_text(); - my $mac = $entry_mac->get_text(); - my $ip = $entry_ip->get_text(); - my $nbi = $entry_nbi->entry->get_text(); - if ($hostname && $mac && $ip) { - - my $result = addclient(0, $hostname, $mac, $ip, $nbi, $is_thin); - - if ($result == 0) { - my $t_client = Gtk2::TreeIter->new; - - $model->append($t_client, undef); - $model->set($t_client, [ 0 => $hostname ]); - - my $c_det_hw = Gtk2::TreeIter->new; - $model->append($c_det_hw, $t_client); - $model->set($c_det_hw, [ 0 => $mac ]); - - my $c_det_ip = Gtk2::TreeIter->new; - $model->append($c_det_ip, $t_client); - $model->set($c_det_ip, [ 0 => $ip ]); - - my $client_type = "type: fat"; - $client_type = "type: thin" if $is_thin == 1; - my $c_det_type = Gtk2::TreeIter->new; - $model->append($c_det_type, $t_client); - $model->set($c_det_type, [ 0 => $client_type ]); - - if ($nbi) { - my $c_det_nbi = Gtk2::TreeIter->new; - $model->append($c_det_nbi, $t_client); - $model->set($c_det_nbi, [ 0 => $nbi ]); - } - $check_thin->set_active(0); - $is_thin = 0; - } - } - }), - gtksignal_connect(new Gtk2::Button(N("<-- Edit Client")), clicked => - sub { $entry_host->set_text($client); - $entry_mac->set_text($clients{$client}{hardware}); - $entry_ip->set_text($clients{$client}{address}); - my $type = $clients{$client}{type}; - if ($type eq "thin") { - $check_thin->set_active(1); - } else { - $check_thin->set_active(0); - } - $entry_nbi->entry->set_text($clients{$client}{filename}); - my $result = delclient(0, $client); - if ($result == 0) { - $model->remove($citer); - } - }), - gtksignal_connect(new Gtk2::Button(N("Delete Client")), clicked => - sub { my $result = delclient(0, $client); - if ($result == 0) { - $model->remove($citer); - } - }), - gtksignal_connect(new Gtk2::Button(N("dhcpd Config...")), clicked => - sub { $$central_widget->destroy(); dhcpd_config() }), -# new Gtk2::HBox(1,1), - ), - create_scrolled_window($tree_clients), - ),), - ); - - $check_allow_thin->set_active($thin_clients); - $check_thin->set_sensitive($thin_clients); - gtksignal_connect($check_allow_thin, clicked => - sub { invbool \$thin_clients; - $check_thin->set_sensitive($thin_clients); - # we need to change some system files to allow the thin clients - # to access the server - enabling xdmcp and modify hosts.deny/hosts.allow for some security - # we also need to set runlevel to 5 and restart the display manager - if ($thin_clients == 1) { - substInFile { s/id:3:initdefault:/id:5:initdefault:/ } "/etc/inittab"; - substInFile { s/! DisplayManager.requestPort:/DisplayManager.requestPort:/ } "/etc/X11/xdm/xdm-config"; - substInFile { s/Enable=false/Enable=true/ } "/usr/share/config/kdm/kdmrc"; - # This file had 2 "Enable=" entries, one for xdmcp and one for debug - change_gdm_xdmcp("true"); - log::explanations("Modified files /etc/inittab, /etc/X11/xdm/xdm-config, /usr/share/config/kdm/kdmrc, /etc/X11/gdm/gdm.conf"); - # just xdmcp in hosts.allow is enough for xdm & kdm, but gdm doesn't work - x11 doesn't help either - update_hosts_allow("enable"); - } else { - substInFile { s/id:5:initdefault:/id:3:initdefault:/ } '/etc/inittab'; - substInFile { s/DisplayManager.requestPort:/! DisplayManager.requestPort:/ } "/etc/X11/xdm/xdm-config"; - substInFile { s/Enable=true/Enable=false/ } "/usr/share/config/kdm/kdmrc"; - change_gdm_xdmcp("false"); - log::explanations("Modified files /etc/inittab, /etc/X11/xdm/xdm-config, /usr/share/config/kdm/kdmrc, /etc/X11/gdm/gdm.conf"); - update_hosts_allow("disable"); - } - $in->ask_warn('', N("Need to restart the Display Manager for full changes to take effect. \n(service dm restart - at the console)")); - } - ); - $central_widget = \$client_box; - $client_box->show_all(); -} - -sub dhcpd_config() { - #- do main dhcp server config - my $dhcpd_box; - my @ifvalues; - my @resolve; - my %netconfig; - my @nservers; - - #- entry boxes for data entry - my $box_subnet = new Gtk2::HBox(0,0); - my $label_subnet = new Gtk2::Label(N("Subnet:")); - $label_subnet->set_justify('right'); - my $entry_subnet = new Gtk2::Entry(20); - $box_subnet->pack_end($entry_subnet, 0, 0, 10); - $box_subnet->pack_end($label_subnet, 0, 0, 10); - - my $box_netmask = new Gtk2::HBox(0,0); - my $label_netmask = new Gtk2::Label(N("Netmask:")); - $label_netmask->set_justify('left'); - my $entry_netmask = new Gtk2::Entry(20); - $box_netmask->pack_end($entry_netmask, 0, 0, 10); - $box_netmask->pack_end($label_netmask, 0, 0, 10); - - my $box_routers = new Gtk2::HBox(0,0); - my $label_routers = new Gtk2::Label(N("Routers:")); - $label_routers->set_justify('left'); - my $entry_routers = new Gtk2::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 Gtk2::HBox(0,0); - my $label_subnet_mask = new Gtk2::Label(N("Subnet Mask:")); - $label_subnet_mask->set_justify('left'); - my $entry_subnet_mask = new Gtk2::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 Gtk2::HBox(0,0); - my $label_broadcast = new Gtk2::Label(N("Broadcast Address:")); - $label_broadcast->set_justify('left'); - my $entry_broadcast = new Gtk2::Entry(20); - $box_broadcast->pack_end($entry_broadcast, 0, 0, 10); - $box_broadcast->pack_end($label_broadcast, 0, 0, 10); - - my $box_domain = new Gtk2::HBox(0,0); - my $label_domain = new Gtk2::Label(N("Domain Name:")); - $label_domain->set_justify('left'); - my $entry_domain = new Gtk2::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 Gtk2::HBox(0,0); - my $box_name_servers_entry = new Gtk2::VBox(0,0); - my $label_name_servers = new Gtk2::Label(N("Name Servers:")); - $label_name_servers->set_justify('left'); - my $entry_name_server1 = new Gtk2::Entry(); - my $entry_name_server2 = new Gtk2::Entry(); - my $entry_name_server3 = new Gtk2::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); - - my $label_ip_range_start = new Gtk2::Label(N("IP Range Start:")); - my $label_ip_range_end = new Gtk2::Label(N("IP Range End:")); - my $entry_ip_range_start = new Gtk2::Entry(); - my $entry_ip_range_end = new Gtk2::Entry(); - - #- grab some default entries from the running system - - if (-e "/etc/sysconfig/network") { - %netconfig = getVarsFromSh("/etc/sysconfig/network"); - $entry_domain->set_text($netconfig{DOMAINNAME}); - } - - my $sys_netmask = get_mask_from_sys(); - $entry_netmask->set_text($sys_netmask); - $entry_subnet_mask->set_text($sys_netmask); - - my $sys_broadcast = get_broadcast_from_sys(); - $entry_broadcast->set_text($sys_broadcast); - my $sys_subnet = get_subnet_from_sys($sys_broadcast, $sys_netmask); - - $entry_subnet->set_text($sys_subnet); - - my @route = grep { /^0.0.0.0/ } `/sbin/route -n`; - @ifvalues = split(/[ \t]+/, $route[0]); - $entry_routers->set_text($ifvalues[1]); - - @resolve = cat_("/etc/resolv.conf"); - my $i = 1; - chop(@resolve); - - foreach (@resolve) { - @ifvalues = split / /; - if ($ifvalues[0] =~ /nameserver/ && $i < 4) { - $nservers[$i++] = $ifvalues[1]; - } - } - - $entry_name_server1->set_text($nservers[1]); - $entry_name_server2->set_text($nservers[2]); - $entry_name_server3->set_text($nservers[3]); - - gtkpack($status_box, - $dhcpd_box = gtkpack_(new Gtk2::HBox(1,10), - 0, gtkadd((new Gtk2::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 Gtk2::VBox(0,0), - new Gtk2::Label(N("dhcpd Server Configuration") . "\n\n" . - N("Most of these values were extracted\nfrom your running system.\nYou can modify as needed.")), - new Gtk2::HSeparator, - gtkadd((new Gtk2::HBox), - new Gtk2::Label(N("Dynamic IP Address Pool:")), - ), - gtkadd((new Gtk2::HBox(0,0)), - gtkadd((new Gtk2::VBox), - gtkadd($label_ip_range_start), - gtkadd($entry_ip_range_start), - ), - gtkadd((new Gtk2::VBox), - gtkadd($label_ip_range_end), - gtkadd($entry_ip_range_end), - ), - ), - gtkadd(new Gtk2::HBox), - gtksignal_connect(new Gtk2::Button(N("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(), - $entry_ip_range_start->get_text(), - $entry_ip_range_end->get_text(), - ) }), - new Gtk2::HBox(0,10), - ), - ), - ); - - $central_widget = \$dhcpd_box; - $dhcpd_box->show_all(); -} - -sub get_mask_from_sys() { - my %netconfig; - if (-e "/etc/sysconfig/network-scripts/ifcfg-eth0") { - %netconfig = getVarsFromSh("/etc/sysconfig/network-scripts/ifcfg-eth0"); - $netconfig{NETMASK}; - } -} - -sub get_subnet_from_sys { - my ($sys_broadcast, $sys_netmask) = @_; - my @subnet; - - my @netmask = split(/\./, $sys_netmask); - my @broadcast = split(/\./, $sys_broadcast); - - foreach (0..3) { - #- wasn't evaluating the & as expected - my $val1 = $broadcast[$_] + 0; - my $val2 = $netmask[$_] + 0; - $subnet[$_] = $val1 & $val2; - } - - join(".", @subnet); -} - -sub get_broadcast_from_sys() { - my @ifconfig = grep { /inet/ } `/sbin/ifconfig eth0`; - my @ifvalues = split(/[: \t]+/, $ifconfig[0]); - - $ifvalues[5]; -} - -sub get_ip_from_sys() { - my @ifconfig = grep { /inet/ } `/sbin/ifconfig eth0`; - my @ifvalues = split(/[: \t]+/, $ifconfig[0]); - - $ifvalues[3]; -} - -sub write_dhcpd_config { - my ($subnet, $netmask, $routers, $subnet_mask, $broadcast, $domain, $ns1, $ns2, $ns3, $pool_start, $pool_end) = @_; - - $nfs_subnet = $subnet; - $nfs_mask = $subnet_mask; - - local *FHANDLE; - 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 $pool_string = "\trange dynamic-bootp " . $pool_start . " " . $pool_end . ";\n" if $pool_start && $pool_end; - print FHANDLE $pool_string if $pool_string; - - my $ns_string = "\toption domain-name-servers " . $ns1 if $ns1; - $ns_string = $ns_string . ", " . $ns2 if $ns2; - $ns_string = $ns_string . ", " . $ns3 if $ns3; - $ns_string = $ns_string . ";\n" if $ns_string; - 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(N("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('', N("Couldn't access the floppy!")) - } else { - $in->ask_warn('', N("Floppy can be removed now")) - } - } else { - $in->ask_warn('', N("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/$nic.iso") { - $in->ask_warn('', N("Etherboot ISO image is %s", "/tmp/$nic.iso")) - } else { - $in->ask_warn('', N("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 == 1) { - print("No /etc/dhcpd.conf built yet - use GUI to create!!\n"); - return; - } else { - $in->ask_warn('', N("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") if -e "/etc/exports"; - local *FHANDLE; - open(FHANDLE, "> /etc/exports"); - print FHANDLE "#/etc/exports - generated by drakTermServ\n\n"; - print FHANDLE "/\t(ro,all_squash)\n"; - if ($nfs_subnet eq '') { - $nfs_subnet = get_subnet_from_sys(); - $nfs_mask = get_mask_from_sys(); - my $sys_broadcast = get_broadcast_from_sys(); - $nfs_subnet = get_subnet_from_sys($sys_broadcast, $nfs_mask); - - } - 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") if -e "/etc/exports.mdkTS"; - $buff_index = toggle_chkconfig("off", "clusternfs", $buff_index+1); - $buff_index = toggle_chkconfig("off", "tftp", $buff_index); - $buff_index = service_change("xinetd", "restart", $buff_index); - $buff[$buff_index] = "\n\tDone!"; - - if ($cmd_line == 1) { - print "@buff\n"; - return; - } - - show_status(@buff); -} - -sub toggle_chkconfig { - #- change service config - my ($state, $service, $buff_index) = @_; - system("/sbin/chkconfig $service $state"); - $buff[$buff_index] = "\tTurning $service $state...\n"; - $buff_index++; - $buff_index; -} - -sub service_change { - my ($service, $command, $buff_index) = @_; - system("BOOTUP=serial /sbin/service $service $command > /tmp/drakTSservice.status 2>&1"); - local *STATUS; - open(STATUS, "/tmp/drakTSservice.status"); - local $_; - while (<STATUS>) { - $buff[$buff_index] = "\t$_"; - $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() { - text_view("@buff"); -} - -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 - local *FHANDLE; - 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_deleted; - - my @ts_users = cat_("/etc/shadow\$\$CLIENT\$\$"); - my $is_ts_user = grep { /$username/ } @ts_users; - - if ($is_ts_user) { - $i = 0; - foreach my $user (@ts_users) { - if ($user =~ /$username/) { - splice(@ts_users, $i, 1); - $user_deleted = 1; - last; - } - $i++; - } - local *FHANDLE; - open(FHANDLE, "> /etc/shadow\$\$CLIENT\$\$"); - print FHANDLE $_ foreach @ts_users; - 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, $is_thin) = @_; - - my $host_in_use = 0; - my $mac_in_use = 0; - my $ip_in_use = 0; - - my %ts_clients = read_dhcpd_conf(); - - foreach my $client (keys(%ts_clients)) { - $host_in_use = 1 if $hostname eq $client; - $mac_in_use = 1 if $mac eq $ts_clients{$client}{hardware}; - $ip_in_use = 1 if $ip eq $ts_clients{$client}{address}; - } - - if ($cmd_line == 1) { - print "$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; - if ($is_thin == 1) { - $ts_clients{$hostname}{type} = "thin"; - } else { - $ts_clients{$hostname}{type} = "fat"; - } - $ts_clients{$hostname}{filename} = $nbi; - - my $clients = "/etc/dhcpd.conf.etherboot.clients"; - local *CLIENT; - open(CLIENT, ">> $clients") or warn("Can't open $clients!"); - my $client_entry = format_client_entry($hostname, %ts_clients); - print CLIENT $client_entry; - close CLIENT; - 0; - } -} - -sub delclient { - #- find a client and delete the entry in dhcpd.conf - my ($cmd_line, $hostname) = @_; - my $host_found; - - my %ts_clients = read_dhcpd_conf(); - - foreach my $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" unless $host_found; - return; - } -} - -sub change_gdm_xdmcp { - my ($enable) = @_; - my @conf_data = cat_("/etc/X11/gdm/gdm.conf"); - for (my $i = 0; $i < @conf_data; $i++) { - $conf_data[$i] =~ s/^Enable=false/Enable=true/ if $enable eq "true"; - $conf_data[$i] =~ s/^Enable=true/Enable=false/ if $enable eq "false"; - # bail here so we don't alter the debug setting - if ($conf_data[$i] eq "[debug]\n") { - output("/etc/X11/gdm/gdm.conf", @conf_data); - last; - } - } -} - -sub update_hosts_allow { - my ($mode) = @_; - my $ip = get_ip_from_sys(); - my @values = split(/\./, $ip); - my $subnet = $values[0] . "." . $values[1] . "." . $values[2] . "."; - my $i; - if ($mode eq "enable") { - my $has_all = `grep ALL /etc/hosts.allow`; - if ($has_all) { - $in->ask_warn('', N("/etc/hosts.allow and /etc/hosts.deny already configured - not changed")); - return; - } - if (!$has_all) { - log::explanations("Modified file /etc/hosts.allow"); - append_to_file("/etc/hosts.allow", "ALL:\t$subnet\n"); - } - $has_all = `grep ALL /etc/hosts.deny`; - if (!$has_all) { - log::explanations("Modified file /etc/hosts.deny"); - append_to_file("/etc/hosts.deny", "ALL:\tALL\n"); - } - } - if ($mode eq "disable") { - my @allow = cat_("/etc/hosts.allow"); - for ($i = 0; $i < @allow; $i++) { - if ($allow[$i] =~ /^ALL:\t$subnet/) { - splice(@allow, $i, 1); - log::explanations("Modified file /etc/hosts.allow"); - output("/etc/hosts.allow", @allow); - last; - } - } - my @deny = cat_("/etc/hosts.deny"); - for ($i = 0; $i < @deny; $i++) { - if ($deny[$i] =~ /^ALL:\tALL/) { - splice(@deny, $i, 1); - log::explanations("Modified file /etc/hosts.deny"); - output("/etc/hosts.deny", @deny); - last; - } - } - } -} - -sub format_client_entry { - #- create a client entry, in proper format - my ($client, %ts_clients) = @_; - - my $entry = "host $client {\n"; - $entry .= "\thardware ethernet\t$ts_clients{$client}{hardware};\n"; - $entry .= "\tfixed-address\t\t$ts_clients{$client}{address};\n"; - $entry .= "\t#type\t\t\t$ts_clients{$client}{type};\n" if $ts_clients{$client}{type}; - $entry .= "\tfilename\t\t\"$ts_clients{$client}{filename}\";\n" if $ts_clients{$client}{filename}; - $entry .= "}\n"; - write_thin_inittab($ts_clients{$client}{address}) if $ts_clients{$client}{type} eq "thin"; - $entry -} - -sub write_dhcpd_conf { - my %ts_clients = @_; - my $clients = "/etc/dhcpd.conf.etherboot.clients"; - - local *CLIENT; - open(CLIENT, "> $clients") or warn("Can't open $clients!"); - foreach my $key (keys(%ts_clients)) { - my $client_entry = format_client_entry($key, %ts_clients); - print CLIENT $client_entry; - } - close CLIENT -} - -sub read_dhcpd_conf() { - my $clients = "/etc/dhcpd.conf.etherboot.clients"; - my %ts_clients; - my $hostname; - - #- read and parse current client entries - local *CLIENTS; - open(CLIENTS, $clients) or 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/; - $name = "type" if $name =~ /#type/; - $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 789f57d3c..000000000 --- a/perl-install/standalone/drakautoinst +++ /dev/null @@ -1,354 +0,0 @@ -#!/usr/bin/perl - -# -# Guillaume Cottenceau (gc@mandrakesoft.com) -# -# Copyright 2001-2002 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; - -$::direct = /-direct/; - -my $in = 'interactive'->vnew('su', 'default'); - -my $imagefile = "/root/drakx/replay_install.img"; --f $imagefile or $in->ask_warn(N("Error!"), - N("I can't find needed image file `%s'.", $imagefile), 1), quit_global($in, 0); - -$::direct or $in->ask_okcancel(N("Auto Install Configurator"), -N("You are about to configure an Auto Install floppy. This feature is somewhat dangerous and must be used circumspectly. - -With that feature, you will be able to replay the installation you've performed on this computer, being interactively prompted for some steps, in order to change their values. - -For maximum safety, the partitioning and formatting will never be performed automatically, whatever you chose during the install of this computer. - -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 => translate($st->{$f}{text}), val => \$def_choice, list => [ N("replay"), N("manual") ] }; - push @all_steps, [ $f, \$def_choice ]; -} - -$in->ask_from(N("Automatic Steps Configuration"), - N("Please choose for each step whether it will replay like your install, or it will be manual"), - \@choices - ) or quit_global($in, 0); - -${$_->[1]} eq N("manual") and push @manual_steps, $_->[0] foreach @all_steps; - -my $mountdir = "/root/tmp/drakautoinst-mountdir"; -d $mountdir or mkdir $mountdir, 0755; -my $floppy = detect_devices::floppy(); -my $dev = devices::make($floppy); -$in->ask_okcancel('', N("Insert a blank floppy in drive %s", $floppy), 1) or quit_global($in, 0); -{ - log::explanations(N("Creating auto install floppy")); - my $w = $in->wait_message('', N("Creating auto install floppy")); - 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; -my %struct_gui; - -if (!$::isEmbedded && $in->isa('interactive::gtk')) { - require ugtk2; - ugtk2->import(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 = ugtk2->new('$o edition'); - my @box_to_hide; - my $nb_pages=0; - my $notebook = new Gtk2::Notebook; - $notebook->set_show_border(0); - $notebook->set_show_tabs(0); - $notebook->append_page(gtkpack_(gtkset_border_width(new Gtk2::VBox(0,0), 10), - 1, new Gtk2::VBox(0,0), - 0, gtkpack_(new Gtk2::HBox(0,0), - 1, new Gtk2::VBox(0,0), - 0, gtkadd(gtkset_shadow_type(new Gtk2::Frame, 'etched-in'), - gtkcreate_img('mdk_logo')), - 1, new Gtk2::VBox(0,0), - ), - 0, N("\nWelcome.\n\nThe parameters of the auto-install are available in the sections on the left"), - 1, new Gtk2::VBox(0,0), - ), undef); - $notebook->show_all; - $notebook->set_page(0); - - gtkadd($W->{window}, - gtkpack_(new Gtk2::VBox(0,5), - 1, gtkpack_(new Gtk2::HBox(0,0), - 0, gtkadd(gtkset_size_request(gtkset_shadow_type(new Gtk2::Frame, 'in'), 130, 470), - gtkpack_(new Gtk2::VBox(0,0), - map { - my $box = new Gtk2::VBox(0,0); - push @box_to_hide, $box; - $box->{vis} = 0; - my @button_to_hide; - 0, gtksignal_connect(new Gtk2::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 Gtk2::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 = gtkcreate_img($_->[1]) } else { $b = () }; - gtksignal_connect(gtkadd($button, - gtkpack__(new Gtk2::VBox(0,3), - $b, - translate($_->[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 Gtk2::HSeparator, - 0, gtkadd(gtkset_border_width(gtkset_layout(new Gtk2::HButtonBox, 'end'), 5), - gtksignal_connect(new Gtk2::Button(N("Accept")), clicked => sub { Gtk2->main_quit }), - gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { $o = $o_old; Gtk2->main_quit; quit_global($in, 0) }), - ) - ) - ); - $_->hide foreach @box_to_hide; -# $W->{window}->show_all; -# gtkadd($W->{window}, -# gtkpack_($W->create_box_with_title(N("Edit variables")), -# 1, my $notebook = create_notebook( map { $_, h2widget($o->{$_}, "\$o->\{$_\}") } keys %$o ), -# 0, gtkpack(gtkset_border_width(new Gtk2::HBox(0,0),5), $W->create_okcancel), -# ), -# ); -# $notebook->set_tab_pos('left'); -# $::isEmbedded and gtkflush(); - $W->main; -# $W->destroy(); -} - -$o->{interactiveSteps} = \@manual_steps; - -my $str = join('', -"#!/usr/bin/perl -cw -# -# Special file generated by ``drakautoinst''. -# -# You should check the syntax of this file before using it in an auto-install. -# You can do this with 'perl -cw auto_inst.cfg.pl' or by executing this file -# (note the '#!/usr/bin/perl -cw' on the first line). -", - Data::Dumper->Dump([$o], ['$o']), "\0"); -$str =~ s/ {8}/\t/g; #- replace all 8 space char by only one tabulation, this reduces file size so much :-) -output($cfgfile, $str); - -fs::umount($mountdir); - -$in->ask_okcancel(N("Congratulations!"), -N("The floppy has been successfully generated. -You may now replay your installation.")); - -quit_global($in, 0); - - -sub quit_global { - my ($in, $exitcode) = @_; - $in->exit($exitcode); -} - - - -sub h2widget { - my ($k, $label) = @_; - my $w; - if (ref($k) =~ /HASH/) { - my $vb; - my @widget_list; - my $i = -1; - my @list_keys = keys(%{$k}); - if (ref(${$k}{$list_keys[0]}) =~ /HASH/) { - $i++; - my ($button_add, $button_remove); - $w = gtkpack_(new Gtk2::VBox(0,0), - 1, create_scrolled_window(gtkpack__($vb = new Gtk2::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(N("Auto Install"), ("Enter the name of the new field you want to add")) or return undef; - $field eq '' and return undef; - gtkpack__($vb, - $widget_list[$i] = create_packtable({ col_spacings => 10, row_spacings => 3 }, - [ "$field : ", h2widget($ref_local_k, "$label\{$field\}") ]) - ); - @{$widget_list2} = @widget_list; - }, - $vb, \$i, \@widget_list) - ); - } else { - $w = create_packtable({ col_spacings => 10, row_spacings => 3 }, - map { create_entry_element(${$k}{$_}, "$label\{$_\}", $_) } @list_keys - ) - } - } elsif (ref($k) =~ /ARRAY/) { - my $vb; - my @widget_list; - my $i = -1; - $w = gtkpack_(new Gtk2::VBox(0,0), - 1, create_scrolled_window( - gtkpack__($vb = new Gtk2::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 Gtk2::Entry; - $e->{value} = $value; - my $tag = Gtk2->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 Gtk2::HButtonBox, 'spread'), 5), - gtksignal_connect($button_add = new Gtk2::Button(N("Add an item")), clicked => sub { - $local_k{$_} = undef foreach keys %local_k; - $i++; - $local_gui->($vb, \@widget_list, \%local_k, $i) or $i--, return; - $i >= 0 and $button_remove->set_sensitive(1); - } - ), - gtksignal_connect($button_remove = new Gtk2::Button(N("Remove the last item")), clicked => sub { - $i >= 0 or return; - $widget_list[$i]->destroy(); - $i--; - $i >= 0 or $button_remove->set_sensitive(0); - } - ) - ) -} diff --git a/perl-install/standalone/drakbackup b/perl-install/standalone/drakbackup deleted file mode 100755 index b1cf973d0..000000000 --- a/perl-install/standalone/drakbackup +++ /dev/null @@ -1,4895 +0,0 @@ -#!/usr/bin/perl -# -# Copyright (C) 2001-2002 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/drakbackup.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 deprecated 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 lib qw(/usr/lib/libDrakX); -use standalone; #- warning, standalone must be loaded very first, for 'explanations' -use strict; - -use interactive; -use common; -use Time::localtime; -use detect_devices; - -# Backend Options. -# make this global for status screen -my ($window1, $my_win); -my $central_widget; -my $previous_widget; -my $current_widget; -my $interactive; -my $up_box; -my $advanced_box; -my $box2; -my $cfg_file_exist = 0; -my @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 $plabel; -my $plabel1; -my $plabel2; -my $plabel3; -my $stext; -my $list_model; -my $iter; -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 $std_device; -my @tape_devices; -my $tar_ext = "tar.gz"; - -# config. FILES -> Default PATH & Global variables. -my %config; -my @sys_files = "/etc"; -my @user_list; -my @list_other; -my $cfg_dir = "/etc/drakxtools/drakbackup/"; -my $cfg_file = $cfg_dir . "drakbackup.conf"; -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 $sys_diff_mode = 0; -my $user_diff_mode = 0; -my $other_diff_mode = 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; - -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; -} - -# allow not-root user with own config -if ($ENV{HOME} ne '/root') { - standalone::explanations("Running as $ENV{USER}..."); - $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}; -} -$cfg_file = $cfg_dir . "drakbackup.conf"; - -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).\n"; - print "USE_EXPECT Use expect to do the whole scp transfer, without keys.\n"; - print " (requires perl-Expect).\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 or differential backups of system files.\n"; - print "USER_INCREMENTAL_BACKUPS Do incremental or differential backups of user files.\n"; - print "OTHER_INCREMENTAL_BACKUPS Do incremental or differential backups if other files.\n"; - print "SYS_DIFFERENTIAL_BACKUPS Do differential backups of system files.\n"; - print "USER_DIFFERENTIAL_BACKUPS Do differential backups of user files.\n"; - print "OTHER_DIFFERENTIAL_BACKUPS Do differential 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); -} - -if (check_for_xserver()) { - # I give up, if I don't wrap this somehow, it never comes back when run in - # console or daemon mode - just pegs cpu to 100% - # perl_checker has fits though - eval { require ugtk2 }; - die "Can't load ugtk2...\n" if $@; - ugtk2->import(qw(:helpers :wrappers :create)); - interactive_mode(); -} else { - die "Can't run in console mode..."; -} - -sub all_user_list() { - my $passwdfile = "/etc/passwd"; - my $user; - my $uid; - @all_user_list = (); - - local *PASSWD; - 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"); - - local *INFO; - open INFO, $info or warn("Can't open $info\n"); - local $_; - 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 $info; - - my %data = ( - "drive speed" => 'speed', - "Can change speed" => 'chg_speed', - "Can read multisession" => 'multisession', - "Can write CD-R" => 'cdr', - "Can write CD-RW" => 'cdrw', - "Can write DVD-R" => 'dvdr', - "Can write DVD-RAM" => 'dvdram' - ); - - - #- 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 - my $cd_drives; - foreach (@cd_info) { - @line_data = split(/[:\t]+/, $_); - if ($line_data[0] =~ /drive name/) { - $cd_drives = @line_data-1; - chop($line_data[$cd_drives]); - @drive_names = @line_data; - print "drives: $cd_drives\n" unless $interactive; - } - chop($line_data[$cd_drives]) if $cd_drives; - foreach my $key (keys %data) { - if ($line_data[0] =~ $key) { - for ($i = 1; $i <= $cd_drives; $i++) { - $cd_devices{$drive_names[$i]}{$data{$key}} = $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"); - local *INFO; - open INFO, $info or warn("Can't open $info\n"); - local $_; - 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 my $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 my $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; - - 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"; - $sys_diff_mode and $backup_sys_versions and push @cfg_list, "SYS_DIFFERENTIAL_BACKUPS\n"; - $user_diff_mode and $backup_user_versions and push @cfg_list, "USER_DIFFERENTIAL_BACKUPS\n"; - $other_diff_mode and $backup_other_versions and push @cfg_list, "OTHER_DIFFERENTIAL_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(); -} - -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", N_("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 USER=root\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) { -# %config = getVarsFromSh($cfg_file) || print "You must be root to read configuration file. \n"; - local *CONF_FILE; - open(CONF_FILE, "<" . $cfg_file) || print "You must be root to read configuration file. \n"; - local $_; - 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 (/^SYS_DIFFERENTIAL_BACKUPS/) { $sys_diff_mode = 1 } - if (/^USER_DIFFERENTIAL_BACKUPS/) { $user_diff_mode = 1 } - if (/^OTHER_DIFFERENTIAL_BACKUPS/) { $other_diff_mode = 1 } - if (/^NO_CRITICAL_SYS/) { $no_critical_sys = 1 } - if (/^CRITICAL_SYS/) { $no_critical_sys = 0 } - if (/^DEL_HD_FILES/) { $del_hd_files = 1 } - } - close(CONF_FILE); - 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; - } -} - -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"); -} - -my $in; - -sub show_warning { - my ($mode, $warning) = @_; - $mode = N_("WARNING") if $mode eq "w"; - $mode = N_("FATAL") if $mode eq "f"; - $mode = N_("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("\n DrakBackup Report \n\n"); - $daemon and $results .= N("\n DrakBackup Daemon Report\n\n\n"); - $results .= "***********************************************************************\n\n"; - $results .= $system_state; - $results .= "\n\n***********************************************************************\n\n"; - $results .= N("\n DrakBackup Report Details\n\n\n"); - $results .= "***********************************************************************\n\n"; -} - -sub ftp_client() { - use Net::FTP; - my $ftp; - - $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_fraction(0); - $interactive and progress($pbar, $plabel, 0.5, $_); - $interactive and $pbar->set_text($_); - #- make perl_checker happy... - $ftp->put($_, undef, undef); - $interactive and progress($pbar, $plabel, 0.5, $_); - $interactive and $pbar->set_text($_); - $interactive and progress($pbar3, $plabel3, 1/@file_list_to_send_by_ftp, N("Total progess")); - } - $ftp->quit; - return(0); -} - -sub do_expect { - - #- Sort of a general purpose expect routine, we use it to backup files to - #- a remote server, as well as transfer a key and restore. - #- Using the key after it is setup is preferred. - - my ($mode) = @_; - - eval { require Expect }; - - if ($@) { - if ($mode eq 'sendkey') { - destroy_widget(); - check_pkg_needs(); - } else { - $log_buff .= "perl-Expect not installed!", - } - 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"; - - #- just bypass progress for sendkey for now - $interactive = 0 if $mode eq "sendkey"; - - @send_files = @file_list_to_send_by_ftp if $mode eq "backup"; - - $interactive and $pbar->set_fraction(0); - $interactive and $pbar3->set_fraction(0); - $interactive and progress($pbar, $plabel, 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('', N("%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('', N("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('', N("ERROR: Cannot spawn %s.", $exp_command)); - - $interactive and progress($pbar3, $plabel3, 1/@send_files, N("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"); - Expect::exp_continue() } ], - [ '-re', 'please try again', sub { $bad_passwd = 1; Expect::exp_continue() } ], - [ '-re', 'Permission denied', sub { $no_perm = 1; Expect::exp_continue() } ], - [ '-re', 'No such file or directory', sub { $bad_dir = 1; Expect::exp_continue() } ], -# [ '-re', '%', sub { update_scp_progress(); Expect::exp_continue(); } ], - [ eof => sub { - if (!$spawn_ok) { show_warning("f", N("No password prompt on %s at port %s", $host_name, $scp_port)) } - if ($bad_passwd) { show_warning("f", N("Bad password on %s", $host_name)) } - if ($no_perm) { show_warning("f", N("Permission denied transferring %s to %s", $_, $host_name)) } - if ($bad_dir) { show_warning("f", N("Can't find %s on %s", $host_path, $host_name)) } - } - ], - [ timeout => sub { show_warning("f", N("%s not responding", $host_name)) } ], - ); - - my $exit_stat = $exp->exitstatus; - $in->ask_warn('', N("Transfer successful\nYou may want to verify you can login to the server with:\n\nssh -i %s %s\@%s\n\nwithout being prompted for a password.", $backup_key, $login_user, $host_name)) if $exit_stat == 0 && $mode eq "sendkey"; - $log_buff .= "$_\n" if $exit_stat == 0 && $mode eq "backup"; - $exp->hard_close(); - } - $interactive and progress($pbar, $plabel, 0.5, "Done..."); - $interactive = 1 if $mode eq "sendkey"; -} - -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_fraction(0); - $interactive and progress($pbar, $plabel, 0.5, "File Transfer..."); - $interactive and $stext->set_text($_); - $log_buff .= $command . "\n\n"; - local *TMP; - open TMP, "$command 2>&1 |"; - while ($value = <TMP>) { - $log_buff .= $value; - } - close TMP; - $log_buff .= "\n"; - $interactive and progress($pbar, $plabel, 0.5, "Done..."); - $interactive and progress($pbar3, $plabel3, 1/@file_list_to_send_by_ftp, N("Total 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", N_("WebDAV remote site already in sync!")); - return(1); - } - if ($log_buff !~ /Update completed successfully/) { - show_warning("f", N_("WebDAV transfer failed!")); - return(1); - } - return(0); -} - -sub rsync_client() { - $DEBUG and print "file list to send: $_\n " foreach @file_list_to_send_by_ftp; - my $rsync_cmd = "rsync -tv $save_path/* "; - $rsync_cmd = $rsync_cmd . "--password-file=$cfg_dir/rsync.user " if $passwd_user; - $rsync_cmd = $rsync_cmd . "$login_user\@" if $login_user; - $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", N_("No CDR/DVDR in drive!")); - return(1); - } - if ($log_buff !~ /ATIP info from disk/) { - show_warning("f", N_("Does not appear to be recordable media!")); - return(1); - } - if ($log_buff =~ /Is not erasable/ && $media_erase) { - show_warning("f", N_("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('', N("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, $plabel3, 0, translate($descr)); - $interactive and $pbar3->set_fraction(0); - $interactive and $timer = Gtk2->timeout_add(2, \&progress_timeout); - - $log_buff .= "\n" . $descr . ":\n"; - $log_buff .= $command . "\n\n"; - - local *TMP; - open TMP, "$command 2>&1 |"; - while ($value = <TMP>) { - $log_buff .= $value; - if ($interactive) { - $stext->set_text($value); - gtkflush(); - } - } - close TMP; - $interactive and Gtk2->timeout_remove($timer); -} - -sub progress_timeout() { - my $new_val; - $new_val = $pbar3->get_fraction + 0.1; - if ($new_val > 1) { $new_val = 0 } - $pbar3->set_fraction($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(); - local *TMP; - open TMP, "volname $check_device 2>&1 |"; - local $_; - while (<TMP>) { - $vol_name = $_; - } - close TMP; - $vol_name =~ s/[ \t]+\n$//; - $vol_name; -} - -sub build_iso() { - if ($multi_session && $session_offset) { - $vol_name = get_cd_volname(); - } else { - $vol_name = "Drakbackup" . $the_time; - } - #this is safe to change the volname on rewrites, as is seems to get ignored anyway - my $command = "mkisofs -r -J -T -v -V '$vol_name' "; - $command .= "-C $session_offset -M $cd_device " if $multi_session && $session_offset; - $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", N_("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", N("No tape in %s!", $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"); - } -} - -# share this with logdrake -sub send_mail { - my ($result) = @_; - my $datem = `date`; - - local *F; - 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 $base_sys_exist = 0; - my @dir_content; - my $incr; - - local $_; - $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) { - $interactive and progress($pbar, $plabel, 0.5, N("Backup system files...")); - if ($backup_sys) { - if ($backup_sys_versions) { - $incr = "incr_sys"; - $incr =~ s/incr/diff/ if $sys_diff_mode; - #- 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) && !$sys_diff_mode) { - 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$the_time.txt"); - if (!cat_("$save_path/list_$incr$the_time.txt")) { - system("rm $save_path/list_$incr$the_time.txt"); - } else { - system("$tar_cmd_sys -f $save_path/backup_$incr$the_time.$tar_ext -T $save_path/list_$incr$the_time.txt"); - push @file_list_to_send_by_ftp, "$save_path/backup_$incr$the_time.$tar_ext"; - push @file_list_to_send_by_ftp, "$save_path/list_$incr$the_time.txt"; - $results .= "\nfile: $save_path/backup_$incr$the_time.$tar_ext\n"; - $results .= cat_("$save_path/list_$incr$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, $plabel, 0.5, N("Backup system files...")); - $interactive and progress($pbar3, $plabel3, 0.3, N("Hard Disk Backup files...")); - - if ($backup_user) { - foreach (@user_list) { - my $user = $_; - $path_name = return_path($user); - if ($backup_user_versions) { - $incr = "incr_user_"; - $incr =~ s/incr/diff/ if $user_diff_mode; - #- 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) && !$user_diff_mode) { - 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$the_time.txt"); - if (!cat_("$save_path/list_$incr$user$the_time.txt")) { - system("rm $save_path/list_$incr$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$the_time.txt"); - push @file_list_to_send_by_ftp, "$save_path/backup_$incr$user$the_time.$tar_ext"; - push @file_list_to_send_by_ftp, "$save_path/list_$incr$user$the_time.txt"; - $results .= "\nfile: $save_path/backup_$incr$user$the_time.$tar_ext\n"; - $results .= cat_("$save_path/list_$incr$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, $plabel1, 1, N("Backup User files...")); - $interactive and progress($pbar3, $plabel3, 0.4, N("Hard Disk Backup files...")); - - if (@list_other) { - if ($backup_other_versions) { - $incr = "incr_other"; - $incr =~ s/incr/diff/ if $other_diff_mode; - if ((grep { /^list_incr_other/ } @dir_content) && !$user_diff_mode) { - my @more_recent = grep { /^list_incr_other/ } sort @dir_content; - $more_recent = pop @more_recent; - $DEBUG and print "more recent file: $more_recent\n"; - system("find @list_other -cnewer $save_path/$more_recent ! -type d -print > $save_path/list_incr_other$the_time.txt"); - if (!cat_("$save_path/list_incr_other$the_time.txt")) { - system("rm $save_path/list_incr_other$the_time.txt"); - } else { - system("$tar_cmd_other -f $save_path/backup_incr_other$the_time.$tar_ext -T $save_path/list_incr_other$the_time.txt"); - push @file_list_to_send_by_ftp, "$save_path/backup_incr_other$the_time.$tar_ext"; - push @file_list_to_send_by_ftp, "$save_path/list_incr_other$the_time.txt"; - $results .= "\nfile: $save_path/backup_incr_other$the_time.$tar_ext\n"; - $results .= cat_("$save_path/list_incr_other$the_time.txt"); - } - } elsif (grep { /^list_base_other/ } @dir_content) { - my @more_recent = grep { /^list_base_other/ } sort @dir_content; - $more_recent = pop @more_recent; - $DEBUG and print "more recent file: $more_recent\n"; - system("find @list_other -cnewer $save_path/$more_recent ! -type d -print > $save_path/list_$incr$the_time.txt"); - if (!cat_("$save_path/list_$incr$the_time.txt")) { - system("rm $save_path/list_$incr$the_time.txt"); - } else { - system("$tar_cmd_other -f $save_path/backup_$incr$the_time.$tar_ext -T $save_path/list_$incr$the_time.txt"); - push @file_list_to_send_by_ftp, "$save_path/backup_$incr$the_time.$tar_ext"; - push @file_list_to_send_by_ftp, "$save_path/list_$incr$the_time.txt"; - $results .= "\nfile: $save_path/backup_$incr$the_time.$tar_ext\n"; - $results .= cat_("$save_path/list_$incr$the_time.txt"); - } - } else { - #- need this for the first pass too, if we're offloading the backups to other media (sb) - system("find @list_other ! -type d -print > $save_path/list_base_other$the_time.txt"); - system("$tar_cmd_other -f $save_path/backup_base_other$the_time.$tar_ext @list_other"); - push @file_list_to_send_by_ftp, "$save_path/backup_base_other$the_time.$tar_ext"; - push @file_list_to_send_by_ftp, "$save_path/list_base_other$the_time.txt"; - $results .= "\nfile: $save_path/backup_base_other$the_time.$tar_ext\n"; - } - } else { - system("cd $save_path && rm -f backup_other* backup_base_other* backup_incr_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"; - } - } - $interactive and progress($pbar1, $plabel2, 1, N("Backup Other files...")); - $interactive and progress($pbar3, $plabel3, 0.3, N("Hard Disk Backup Progress...")); - } - - my $filecount = @file_list_to_send_by_ftp; - if (!$filecount) { - show_warning("w", N_("No changes to backup!")); - $interactive and cursor_norm(); - $interactive and interactive_mode(); - return(1); - } - - #- should hit this block if running daemon mode only - if ($daemon && $daemon_media) { -# 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 .= N("\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 .= N("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("\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 && $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 .= N("\nDrakbackup activities via %s:\n\n", $net_proto); - } - - if ($where_cd) { - build_cd(); - $results .= N("\nDrakbackup activities via CD:\n\n"); - } - - if ($where_tape) { - build_tape(); - $results .= N("\nDrakbackup activities via tape:\n\n"); - } - $results .= $log_buff; - - } - - if ($send_mail) { - if (send_mail($results)) { - $interactive and send_mail_pb(); - $interactive or print N(" Error while sending mail. \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; - $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 && !$sys_diff_mode; - $catalog .= ":D" if $backup_sys_versions && $backup_sys && $sys_diff_mode; - $catalog .= ":F" if !$backup_sys_versions && $backup_sys; - $catalog .= ":Users=(@user_list)" if $backup_user; - $catalog .= ":I" if $backup_user_versions && $backup_user && !$user_diff_mode; - $catalog .= ":D" if $backup_user_versions && $backup_user && $user_diff_mode; - $catalog .= ":F" if !$backup_user_versions && $backup_user;; - $catalog .= ":Other=(@list_other)" if @list_other; - $catalog .= ":I" if $backup_other_versions && @list_other && !$other_diff_mode; - $catalog .= ":D" if $backup_other_versions && @list_other && $other_diff_mode; - $catalog .= ":F" if !$backup_other_versions && @list_other; - $catalog .= "\n"; - - local *CATALOG; - open CATALOG, ">> $cfg_dir/drakbackup_catalog" or show_warning("w", N_("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 || $xfer_keys); - } - $extra_pkg = 'mt-st' if $where_tape; - if ($extra_pkg) { - 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 Gtk2::Gdk::Cursor("GDK_WATCH")); - gtkflush(); -} - -sub cursor_norm() { - # restore normal cursor - $window1->window->set_cursor(new Gtk2::Gdk::Cursor("GDK_LEFT_PTR")); - gtkflush(); -} - -sub show_status() { - #- just a generic routine to display an array of text in the GUI screen - my $text = new Gtk2::TextView; - destroy_widget(); - my $scrolled_window = Gtk2::ScrolledWindow->new; - $scrolled_window->set_border_width(10); - $scrolled_window->add_with_viewport($text); - gtktext_insert(gtkset_editable($text, 0), [ [ $results ] ]); - - gtkpack($advanced_box, - $table = gtkpack_(new Gtk2::VBox(0,10), 1, $scrolled_window) - ); - $central_widget = \$table; - $table->show_all(); -} - -sub file_ok_sel { - my ($file_selection) = @_; - my $file_name = $file_selection->get_filename(); - if (!member($file_name, @list_other)) { - push(@list_other, $file_name); - $list_model->append($iter); - $list_model->set($iter, [ 0 => $file_name ]); - } -} - -sub filedialog_where_hd() { - my $file_dialog; - - $file_dialog = gtksignal_connect(new Gtk2::FileSelection(N("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 Gtk2::FileSelection(N("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 - #- a title prompt, the widget to get updated and the variable to update - my ($prompt, $widget, $set_var) = @_; - my $file_dialog; - - $file_dialog = gtksignal_connect(new Gtk2::FileSelection(translate($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->show(); -} - -sub filedialog() { - my $file_dialog; - - $file_dialog = gtksignal_connect(new Gtk2::FileSelection(N("Select the files or directories and click on 'OK'")), destroy => sub { $file_dialog->destroy() }); - $file_dialog->ok_button->signal_connect(clicked => sub { file_ok_sel($file_dialog) }); - $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy() }); - $file_dialog->show(); -} - -################################################ ADVANCED ################################################ - -sub check_list { - foreach (@_) { - my $ref = $_->[1]; - gtksignal_connect(gtkset_active($_->[0], $$ref), toggled => sub { - invbool $ref; - destroy_widget(); - $current_widget->(); - }); - } -} - -sub fonction_env { - ($central_widget, $current_widget, $previous_widget, $custom_help, $next_widget) = @_; -} - -sub advanced_what_sys() { - my $box_what_sys; - - gtkpack($advanced_box, - $box_what_sys = gtkpack_(new Gtk2::VBox(0, 15), - 1, N("\nPlease check all options that you need.\n"), - 1, N("These options can backup and restore all files in your /etc directory.\n"), - 0, my $check_what_sys = new Gtk2::CheckButton(N("Backup your System files. (/etc directory)")), - 0, my $check_what_versions = new Gtk2::CheckButton(N("Use Incremental/Differential Backups (do not replace old backups)")), - 0, gtkpack__(new Gtk2::HBox(0,0), - my @mode_buttons = gtkradio((N("Use Incremental Backups")) x 2, N("Use Differential Backups")), - ), - 0, my $check_what_critical = new Gtk2::CheckButton(N("Do not include critical files (passwd, group, fstab)")), - 0, N("With this option you will be able to restore any version\n of your /etc directory."), - 1, new Gtk2::VBox(0, 15), - ), - ); - check_list([$check_what_sys, \$backup_sys], [$check_what_critical, \$no_critical_sys]); - $check_what_versions->set_active($backup_sys_versions); - $check_what_versions->signal_connect('toggled' => sub { - invbool \$backup_sys_versions; - $mode_buttons[0]->set_sensitive($backup_sys_versions); - $mode_buttons[1]->set_sensitive($backup_sys_versions); - - }); - $mode_buttons[1]->set_active($sys_diff_mode); - $mode_buttons[0]->signal_connect('toggled' => sub { $sys_diff_mode = $mode_buttons[1]->get_active() }); - $mode_buttons[0]->set_sensitive($backup_sys_versions); - $mode_buttons[1]->set_sensitive($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 Gtk2::VBox(0, 15), - 0, N("Please check all users that you want to include in your backup."), - 0, new Gtk2::HSeparator, - 1, create_scrolled_window( - gtkpack__(new Gtk2::VBox(0,0), - map { my $name = $_; - my @user_list_tmp; - my $b = new Gtk2::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 Gtk2::CheckButton(N("Do not include the browser cache")), - 0, my $check_what_user_versions = new Gtk2::CheckButton(N("Use Incremental/Differential Backups (do not replace old backups)")), - 0, gtkpack__(new Gtk2::HBox(0,0), - my @mode_buttons = gtkradio((N("Use Incremental Backups")) x 2, N("Use Differential Backups")), - ), - ), - ); - check_list([$check_what_browser, \$what_no_browser]); - $check_what_user_versions->set_active($backup_user_versions); - $check_what_user_versions->signal_connect('toggled' => sub { - invbool \$backup_user_versions; - $mode_buttons[0]->set_sensitive($backup_user_versions); - $mode_buttons[1]->set_sensitive($backup_user_versions); - }); - $mode_buttons[1]->set_active($user_diff_mode); - $mode_buttons[0]->signal_connect('toggled' => sub { $user_diff_mode = $mode_buttons[1]->get_active() }); - $mode_buttons[0]->set_sensitive($backup_user_versions); - $mode_buttons[1]->set_sensitive($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; - my $file_iter; - $iter = Gtk2::TreeIter->new; - my $other_file; - - $list_model = Gtk2::ListStore->new(Gtk2::GType->STRING); - my $list_others = Gtk2::TreeView->new_with_model($list_model); - $list_others->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $list_others->set_headers_visible(0); - - foreach (@list_other) { - $list_model->append($iter); - $list_model->set($iter, [ 0 => $_ ]); - } - - $list_others->get_selection->signal_connect(changed => sub { - my ($model, $iter) = $_[0]->get_selected; - $model && $iter or return; - $other_file = $model->get($iter, 0); - $file_iter = $iter; - }); - - gtkpack($advanced_box, - $box_what_other = gtkpack_(new Gtk2::VBox(0, 15), - 1, gtkpack_(new Gtk2::HBox(0,4), - 1, create_scrolled_window($list_others), - ), - 0, gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("Add")), clicked => sub { filedialog() }), - gtksignal_connect(new Gtk2::Button(N("Remove Selected")), clicked => sub { - $list_model->remove($file_iter); - my $iindex = 0; - foreach (@list_other) { - if ($list_other[$iindex] eq $other_file) { - splice(@list_other, $iindex, 1); - last; - } - $iindex++; - } - }), - ), - 0, my $check_what_other_versions = new Gtk2::CheckButton(N("Use Incremental/Differential Backups (do not replace old backups)")), - 0, gtkpack__(new Gtk2::HBox(0,0), - my @mode_buttons = gtkradio((N("Use Incremental Backups")) x 2, N("Use Differential Backups")), - ), - ), - - ); - $check_what_other_versions->set_active($backup_other_versions); - $check_what_other_versions->signal_connect('toggled' => sub { - invbool \$backup_other_versions; - $mode_buttons[0]->set_sensitive($backup_other_versions); - $mode_buttons[1]->set_sensitive($backup_other_versions); - }); - $mode_buttons[1]->set_active($other_diff_mode); - $mode_buttons[0]->signal_connect('toggled' => sub { $other_diff_mode = $mode_buttons[1]->get_active() }); - $mode_buttons[0]->set_sensitive($backup_other_versions); - $mode_buttons[1]->set_sensitive($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; - - gtkpack($advanced_box, - $box_what = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack_(new Gtk2::VBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtksignal_connect(my $button_what_other = new Gtk2::Button(), - clicked => sub { destroy_widget(); message_underdevel() }), - 1, gtksignal_connect(my $button_what_all = new Gtk2::Button(), - clicked => sub { destroy_widget(); message_underdevel() }), - 1, new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - $button_what_other->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("bootloader"), - new Gtk2::Label(N("Linux")), - new Gtk2::HBox(0, 5) - )); - $button_what_all->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("user"), - new Gtk2::Label(N("Windows (FAT32)")), - new Gtk2::HBox(0, 5) - )); - fonction_env(\$box_what, \&advanced_what_entire_sys, \&advanced_what, ""); - $up_box->show_all(); -} - -sub advanced_what() { - my $box_what; - - gtkpack($advanced_box, - $box_what = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack_(new Gtk2::VBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtksignal_connect(my $button_what_sys = new Gtk2::Button(), - clicked => sub { $box_what->destroy(); advanced_what_sys() }), - 1, gtksignal_connect(my $button_what_user = new Gtk2::Button(), - clicked => sub { destroy_widget(); advanced_what_user() }), - 1, gtksignal_connect(my $button_what_other = new Gtk2::Button(), - clicked => sub { destroy_widget(); advanced_what_other() }), -# 1, gtksignal_connect(my $button_what_all = new Gtk2::Button(), -# clicked => sub { destroy_widget(); advanced_what_entire_sys(); }), - 1, new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - $button_what_sys->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-system-40"), - new Gtk2::Label(N("System")), - new Gtk2::HBox(0, 5) - )); - $button_what_user->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-users-40"), - new Gtk2::Label(N("Users")), - new Gtk2::HBox(0, 5) - )); - $button_what_other->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-others-40"), - new Gtk2::Label(N("Other")), - new Gtk2::HBox(0, 5) - )); -# $button_what_all->add(gtkpack(new Gtk2::HBox(0,10), -# gtkcreate_img("ic82-systemeplus-40"), -# new Gtk2::Label(N("An Entire System")), -# new Gtk2::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 Gtk2::VBox(0, 10), - 0, new Gtk2::HSeparator, - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, my $check_where_use_net = new Gtk2::CheckButton(N("Use network connection to backup")), - 1, new Gtk2::HBox(0,10), - 0, new Gtk2::Label(N("Net Method:")), - 0, gtkset_sensitive(my $entry_net_type = new Gtk2::Combo(), $where_net), - ), - 0, gtkpack_(new Gtk2::HBox(0,5), - 0, gtkset_sensitive(my $check_use_expect = new Gtk2::CheckButton(N("Use Expect for SSH")), ($where_net && $net_proto eq 'ssh')), - 0, gtkset_sensitive(my $check_xfer_keys = new Gtk2::CheckButton(N("Create/Transfer\nbackup keys for SSH")), ($where_net && $net_proto eq 'ssh')), - 0, gtkset_sensitive(my $button_xfer_keys = new Gtk2::Button(N(" Transfer \nNow")), $xfer_keys), - 0, gtkset_sensitive(my $check_user_keys = new Gtk2::CheckButton(N("Other (not drakbackup)\nkeys in place already")), ($where_net && $net_proto eq 'ssh')), - ), - 0, new Gtk2::HSeparator, - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the host name or IP.")), $where_net), - 1, new Gtk2::HBox(0,10), - 0, gtkset_sensitive(my $host_name_entry = new Gtk2::Entry(), $where_net), - ), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the directory (or module) to\n put the backup on this host.")), $where_net), - 1, new Gtk2::HBox(0,10), - 0, gtkset_sensitive(my $host_path_entry = new Gtk2::Entry(), $where_net), - ), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter your login")), $where_net), - 1, new Gtk2::HBox(0,10), - 0, gtkset_sensitive(my $login_user_entry = new Gtk2::Entry(), $where_net), - ), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter your password")), $where_net), - 1, new Gtk2::HBox(0,10), - 0, gtkset_sensitive(my $passwd_user_entry = new Gtk2::Entry(), $where_net), - ), - 0, gtkpack_(new Gtk2::HBox(0,10), - 1, new Gtk2::HBox(0,10), - 0, gtkset_sensitive(my $check_remember_pass = new Gtk2::CheckButton(N("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->set_property('editable', 0); - $button_xfer_keys->signal_connect('clicked', sub { - if ($passwd_user && $login_user && $host_name) { - do_expect("sendkey"); - } else { - $in->ask_warn('', N("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 == 1) { - $where_cd = 0; - $where_tape = 0; - } - $net_proto = '' if $where_net == 0; - destroy_widget(); - $current_widget->(); - }); - gtksignal_connect(gtkset_active($check_use_expect, $use_expect), toggled => sub { - invbool \$use_expect; - #- assure other methods disabled - if ($use_expect == 1) { - $xfer_keys = 0; - $user_keys = 0; - } - destroy_widget(); - $current_widget->(); - }); - gtksignal_connect(gtkset_active($check_xfer_keys, $xfer_keys), toggled => sub { - invbool \$xfer_keys; - #- assure other methods disabled - if ($xfer_keys == 1) { - $use_expect = 0; - $user_keys = 0; - } - destroy_widget(); - $current_widget->(); - }); - gtksignal_connect(gtkset_active($check_user_keys, $user_keys), toggled => sub { - invbool \$user_keys; - #- assure other methods disabled - if ($user_keys == 1) { - $xfer_keys = 0; - $use_expect = 0; - } - destroy_widget(); - $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 Gtk2::Combo(); - $combo_where_cd_device->set_popdown_strings(sort keys %cd_devices) if keys %cd_devices; - - my $combo_where_cd_time = new Gtk2::Combo(); - $combo_where_cd_time->set_popdown_strings("650 Mb", "700 Mb", "750 Mb", "800 Mb"); - - my $combo_where_cdrecord_device = new Gtk2::Combo(); - my @dev_codes; - - foreach my $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 Gtk2::VBox(0, 6), - 0, my $check_where_cd = new Gtk2::CheckButton(N("Use CD/DVDROM to backup")), - 0, new Gtk2::HSeparator, - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("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 Gtk2::VBox(0, 5), - 0, gtkset_sensitive(gtkset_size_request($combo_where_cd_device, 200, 20), $where_cd), - ), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please choose your CD/DVD media size (Mb)")), $where_cd), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(gtkset_size_request($combo_where_cd_time, 200, 20), $where_cd), - ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please check for multisession CD")), $where_cd), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(my $check_multisession = new Gtk2::CheckButton(), $where_cd), - ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please check if you are using CDRW media")), $where_cd), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(my $check_cdrw = new Gtk2::CheckButton(), $where_cd), - ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please check if you want to erase your RW media (1st Session)")), $cdrw && $where_cd), - 0, gtkset_sensitive(my $button_erase_now = new Gtk2::Button(N(" Erase Now ")), $cdrw), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(my $check_cdrw_erase = new Gtk2::CheckButton(), $cdrw && $where_cd), - ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please check if you are using a DVDR device")), $where_cd), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(my $check_dvdr = new Gtk2::CheckButton(), $where_cd), - ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please check if you are using a DVDRAM device")), $where_cd), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(my $check_dvdram = new Gtk2::CheckButton(), $where_cd), - ), -# don't know what this is about - hold off for now (SB) -# 0, new Gtk2::VBox(0, 5), -# 0, gtkpack_(new Gtk2::HBox(0,10), -# 0, gtkset_sensitive(new Gtk2::Label(N("Please check if you want to include\n install boot on your CD.")), $where_cd), -# 1, new Gtk2::VBox(0, 5), -# 0, gtkset_sensitive(my $check_cd_with_install_boot = new Gtk2::CheckButton(), $where_cd), -# ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter your CD Writer device name\n ex: 0,1,0")), $where_cd), - 1, new Gtk2::VBox(0, 5), -# 0, gtkset_size_request(gtkset_sensitive($cd_device_entry = new Gtk2::Entry(), $where_cd), 200, 20), - 0, gtkset_sensitive(gtkset_size_request($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 == 1) { - $where_net = 0; - $where_tape = 0; - } - destroy_widget(); - $current_widget->(); - }); - gtksignal_connect(gtkset_active($check_cdrw, $cdrw), toggled => sub { - $cdrw = $cdrw ? 0 : 1; - $check_cdrw_erase->set_sensitive($cdrw); - destroy_widget(); - $current_widget->(); - }); - $button_erase_now->signal_connect('clicked', sub { - if ($cd_device) { - erase_cdrw(); - } else { - $in->ask_warn('', N("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 Gtk2::Combo(); - $combo_where_tape_device->set_popdown_strings(@tape_devices) if @tape_devices; - - my $box_where_tape; - my $adj = new Gtk2::Adjustment(550.0, 1.0, 10000.0, 1.0, 5.0, 0.0); - #my ($pix_fs_map, $pix_fs_mask) = gtkcreate_img("filedialog"); - local $_; - my $spinner; - - gtkpack($advanced_box, - $box_where_tape = gtkpack_(new Gtk2::VBox(0, 6), - 0, new Gtk2::HSeparator, - 0, my $check_where_tape = new Gtk2::CheckButton(N("Use tape to backup")), - 0, new Gtk2::HSeparator, - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the device name to use for backup")), $where_tape), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_sensitive(gtkset_size_request($combo_where_tape_device, 200, 20), $where_tape), - ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please check if you want to use the non-rewinding device.")), $where_tape), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(my $check_tape_rewind = new Gtk2::CheckButton(), $where_tape), - ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please check if you want to erase your tape before the backup.")), $where_tape), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(my $check_tape_erase = new Gtk2::CheckButton(), $where_tape), - ), - 0, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please check if you want to eject your tape after the backup.")), $where_tape), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(my $check_tape_eject = new Gtk2::CheckButton(), $where_tape), - ), - 0, new Gtk2::VBox(0, 6), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the maximum size\n allowed for Drakbackup")), $where_tape), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_size_request(gtkset_sensitive($spinner = new Gtk2::SpinButton($adj, 0, 0), $where_tape), 200, 20), - ), - 0, gtkpack_(new Gtk2::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 == 1) { - $where_net = 0; - $where_cd = 0; - } - destroy_widget(); - $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); - destroy_widget(); - $current_widget->(); - - }); - gtksignal_connect(gtkset_active($check_tape_erase, $media_erase), toggled => sub { - $media_erase = $media_erase ? 0 : 1; - destroy_widget(); - $current_widget->(); - }); - gtksignal_connect(gtkset_active($check_tape_eject, $media_eject), toggled => sub { - $media_eject = $media_eject ? 0 : 1; - destroy_widget(); - $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 Gtk2::Adjustment(550.0, 1.0, 10000.0, 1.0, 5.0, 0.0); - my $spinner; - - gtkpack($advanced_box, - $box_where_hd = gtkpack_(new Gtk2::VBox(0, 6), - 0, new Gtk2::HSeparator, -# 0, my $check_where_hd = new Gtk2::CheckButton( N("Use Hard Disk to backup")), -# 0, new Gtk2::HSeparator, - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the directory to save to:")), $where_hd), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_size_request(gtkset_sensitive($save_path_entry = new Gtk2::Entry(), $where_hd), 152, 20), - 0, gtkset_sensitive($button = gtksignal_connect(new Gtk2::Button(), clicked => sub { - filedialog_where_hd() - }), $where_hd), - ), - 0, new Gtk2::VBox(0, 6), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the maximum size\n allowed for Drakbackup")), $where_hd), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_size_request(gtkset_sensitive($spinner = new Gtk2::SpinButton($adj, 0, 0), $where_hd), 200, 20), - ), - 0, gtkpack_(new Gtk2::HBox(0,10), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_sensitive(my $check_where_hd_quota = new Gtk2::CheckButton(N("Use quota for backup files.")), $where_hd), - 0, new Gtk2::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; -# destroy_widget(); -# $current_widget->(); -# }); - $button->add(gtkpack(new Gtk2::HBox(0,10), gtkcreate_img("ic82-dossier-32"))); - $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; - - gtkpack($advanced_box, - $box_where = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack_(new Gtk2::VBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtksignal_connect(my $button_where_net = new Gtk2::Button(), clicked => sub { - destroy_widget(); - advanced_where_net_types(); - }), - 1, gtksignal_connect(my $button_where_cd = new Gtk2::Button(), clicked => sub { - destroy_widget(); - if (require_rpm("mkisofs", "cdrecord")) { - advanced_where_cd(); - } else { - destroy_widget(); - install_rpm(\&advanced_where); - } - }), - 1, gtksignal_connect(my $button_where_hd = new Gtk2::Button(), clicked => sub { - destroy_widget(); - advanced_where_hd(); - }), - 1, gtksignal_connect(my $button_where_tape = new Gtk2::Button(), clicked => sub { - destroy_widget(); - # message_underdevel(); - advanced_where_tape() }), - 1, new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - $button_where_net->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-network-40"), - new Gtk2::Label(N("Network")), - new Gtk2::HBox(0, 5) - )); - $button_where_cd->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-CD-40"), - new Gtk2::Label(N("CDROM / DVDROM")), - new Gtk2::HBox(0, 5) - )); - $button_where_hd->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-discdurwhat-40"), - new Gtk2::Label(N("HardDrive / NFS")), - new Gtk2::HBox(0, 5) - )); - $button_where_tape->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-tape-40"), - new Gtk2::Label(N("Tape")), - new Gtk2::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 $combo_when_space = new Gtk2::Combo(); - my %trans = (N("hourly") => 'hourly', - N("daily") => 'daily', - N("weekly") => 'weekly', - N("monthly") => 'monthly'); - my %trans2 = ('hourly' => N("hourly"), - 'daily' => N("daily"), - 'weekly' => N("weekly"), - 'monthly' => N("monthly")); - $combo_when_space->set_popdown_strings(N("hourly"), N("daily"), N("weekly"), N("monthly")); - - #- drop down list of possible medias - default to config value - my $entry_media_type = new Gtk2::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 Gtk2::VBox(0, 15), - 0, gtkpack_(new Gtk2::HBox(0,10), - 1, new Gtk2::HBox(0,10), - 1, gtkcreate_img("ic82-when-40"), - 0, my $check_when_daemon = new Gtk2::CheckButton(N("Use daemon")), - 1, new Gtk2::HBox(0,10), - ), - 0, new Gtk2::HSeparator, - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please choose the time \ninterval between each backup")), $backup_daemon), - 1, new Gtk2::HBox(0,10), - 0, gtkset_sensitive($combo_when_space, $backup_daemon), - ), - 0, new Gtk2::HBox(0,10), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please choose the\nmedia for backup.")), $backup_daemon), - 1, new Gtk2::HBox(0,10), - 0, gtkpack_(new Gtk2::VBox(0,10), - 0, gtkset_sensitive($entry_media_type, $backup_daemon), - ), - ), - 0, new Gtk2::HSeparator, - 1, gtkset_sensitive(new Gtk2::Label(N("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; - destroy_widget(); - 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; - - gtkpack($advanced_box, - $box_options = gtkpack_(new Gtk2::VBox(0, 15), -# 0, gtkpack_(new Gtk2::HBox(0,10), -# 1, new Gtk2::VBox(0,10), -# 1, gtkcreate_img("ic82-moreoption-40"), -# 1, N("Please choose correct options to backup."), -# 1, new Gtk2::VBox(0,10), -# ), -# 0, new Gtk2::HSeparator, -# 0, gtkpack_(new Gtk2::VBox(0,10), -# 0, gtkset_sensitive(my $check_tar_bz2 = new Gtk2::CheckButton( N("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 Gtk2::CheckButton( N("Use .backupignore files")), 0), - 0, new Gtk2::VBox(0,10), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, my $check_mail = new Gtk2::CheckButton(N("Send mail report after each backup to:")), - 1, new Gtk2::HBox(0,10), - 0, my $mail_entry = new Gtk2::Entry(), - ), -# ), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, my $check_del_hd_files = new Gtk2::CheckButton(N("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; - - gtkpack($advanced_box, - $box_adv = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack_(new Gtk2::VBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtksignal_connect(my $button_what = new Gtk2::Button(), clicked => sub { - destroy_widget(); advanced_what() }), - 1, gtksignal_connect(my $button_where = new Gtk2::Button(), clicked => sub { - destroy_widget(); advanced_where() }), - 1, gtksignal_connect(my $button_when = new Gtk2::Button(), clicked => sub { - destroy_widget(); advanced_when() }), - 1, gtksignal_connect(my $button_options = new Gtk2::Button(), clicked => sub { - destroy_widget(); advanced_options() }), - 1, new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - $button_what->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-discdurwhat-40"), - new Gtk2::Label(N("What")), - new Gtk2::HBox(0, 5) - )); - $button_where->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-where-40"), - new Gtk2::Label(N("Where")), - new Gtk2::HBox(0, 5) - )); - $button_when->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-when-40"), - new Gtk2::Label(N("When")), - new Gtk2::HBox(0, 5) - )); - $button_options->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-moreoption-40"), - new Gtk2::Label(N("More Options")), - new Gtk2::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 Gtk2::TextView; - save_conf_file(); - read_conf_file(); - system_state(); - gtktext_insert($text, [ [ $system_state ] ]); - button_box_restore_main(); - - gtkpack($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, gtkpack_(new Gtk2::VBox(0,10), - 0, N("Drakbackup Configuration"), - 1, create_scrolled_window($text), - ), - ), - ); - fonction_env(\$box2, \&wizard_step3, \&wizard_step2, ""); - button_box_wizard_end(); - $up_box->show_all(); -} - -sub wizard_step2() { - my $box2; - - gtkpack($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack_(new Gtk2::VBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 0, N("Please choose where you want to backup"), - 0, gtkpack_(new Gtk2::HBox(0, 15), - 0, my $check_wizard_hd = new Gtk2::CheckButton(N("on Hard Drive")), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("Configure")), clicked => sub { - destroy_widget(); - to_ok(); - advanced_where_hd(\&wizard_step2); - to_normal(); - }), $where_hd), - ), - 0, gtkpack_(new Gtk2::HBox(0, 15), - 0, my $check_wizard_net = new Gtk2::CheckButton(N("across Network")), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("Configure")), clicked => sub { - destroy_widget(); - to_ok(); - advanced_where_net_types(\&wizard_step2); - to_normal(); - }), $where_net), - ), - 0, gtkpack_(new Gtk2::HBox(0, 15), - 0, my $check_wizard_cd = new Gtk2::CheckButton(N("on CDROM")), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("Configure")), clicked => sub { - destroy_widget(); - advanced_where_cd(\&wizard_step2); - }), $where_cd), - ), - 0, gtkpack_(new Gtk2::HBox(0, 15), - 0, my $check_wizard_tape = new Gtk2::CheckButton(N("on Tape Device")), - 1, new Gtk2::VBox(0, 5), - 0, gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("Configure")), clicked => sub { - destroy_widget(); - advanced_where_tape(\&wizard_step2); - }), $where_tape), - ), - 1, new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::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 - } - destroy_widget(); - 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 Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack_(new Gtk2::VBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 0, N("Please choose what you want to backup"), - 0, my $check_wizard_sys = new Gtk2::CheckButton(N("Backup system")), - 0, my $check_wizard_user = new Gtk2::CheckButton(N("Backup Users")), - 0, gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 0, gtksignal_connect(new Gtk2::Button(N("Select user manually")), clicked => sub { - destroy_widget(); - advanced_what_user(\&wizard); - }), - ), - 1, new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::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 = (); - local $_; - - @user_backuped = (); - -d $path_to_find_restore and @list_backup_tmp2 = all($path_to_find_restore); - - foreach (@list_backup_tmp2) { - s/_base//gi; - s/_incr//gi; - push @list_backup , $_; - } - 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 = N("\nBackup Sources: \n"); - $backup_sys and $system_state .= N("\n- System Files:\n"); - $backup_sys and $system_state .= "\t\t$_\n" foreach @sys_files; - $backup_user and $system_state .= N("\n- User Files:\n"); - $backup_user and $system_state .= "\t\t$_\n" foreach @user_list; - @list_other and $system_state .= N("\n- Other Files:\n"); - @list_other and $system_state .= "\t\t$_\n" foreach @list_other; - $where_hd and $system_state .= N("\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("\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("\n- Burn to CD"); - $where_cd and $cdrw and $system_state .= N("RW"); - $where_cd and $system_state .= N(" on device: %s", $cd_device); - $where_cd and $multi_session and $system_state .= N(" (multi-session)"); - $where_tape and $system_state .= N("\n- Save to Tape on device: %s", $tape_device); - (($where_cd || $where_tape) && $media_erase) and $system_state .= N("\t\tErase=%s", $erase_media); - $where_cd || $where_tape and $system_state .= "\n"; - - $where_net and $system_state .= N("\n- Save via %s on host: %s\n", $net_proto, $host_name); - $where_net and $system_state .= N("\t\t user name: %s\n\t\t on path: %s \n", $login_user, $host_path); - $system_state .= N("\n- Options:\n"); - $backup_sys or $system_state .= N("\tDo not include System Files\n"); - - if ($comp_mode) { - $system_state .= N("\tBackups use tar and bzip2\n"); - } else { - $system_state .= N("\tBackups use tar and gzip\n"); - } - - $daemon_media and $system_state .= N("\n- Daemon (%s) include:\n", $when_space); - $daemon_media eq 'hd' and $system_state .= N("\t-Hard drive.\n"); - $daemon_media eq 'cd' and $system_state .= N("\t-CDROM.\n"); - $daemon_media eq 'tape' and $system_state .= N("\t-Tape \n"); - $daemon_media eq 'ftp' and $system_state .= N("\t-Network by FTP.\n"); - $daemon_media eq 'ssh' and $system_state .= N("\t-Network by SSH.\n"); - $daemon_media eq 'rsync' and $system_state .= N("\t-Network by rsync.\n"); - $daemon_media eq 'webdav' and $system_state .= N("\t-Network by webdav.\n"); - } else { - $system_state = N("No configuration, please click Wizard or Advanced.\n"); - } -} - -sub restore_state() { - my @tmp = split(' ', $restore_step_sys_date); - $restore_state = N("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; - local $_; - 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 = (); - local $_; - - -d $path_to_find_restore and my @list_backup_tmp2 = grep { /^backup/ } all($path_to_find_restore); - @list_tmp2 = @list_backup_tmp2; - foreach (@list_backup_tmp2) { - s/_base//gi; - s/_incr//gi; - push @list_backup , $_; - } - foreach my $var_tmp (@user_list_backuped) { - $var_eq = 1; - my $more_recent = (split(' ', select_most_recent_selected_of($var_tmp)))[0]; - foreach (grep { /^backup_user_$var_tmp/ } sort @list_backup) { - s/.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; - local $_; - - -d $path_to_find_restore and @list_tmp = grep { /^backup/ } all($path_to_find_restore); - my @more_recent = split(' ', $restore_step_sys_date); - my $more_recent = pop @more_recent; - foreach my $var_exist (grep { /_sys_/ } sort @list_tmp) { - if ($var_exist =~ /$more_recent/) { - push @sys_list_to_restore, $var_exist; - $var_eq = 0; - } else { - $var_eq and push @sys_list_to_restore, $var_exist; - } - } - $DEBUG and print "sys list to restore: $_\n " foreach @sys_list_to_restore; -} - -sub show_backup_details { - my ($function, $mode, $name) = @_; - my $archive_file_detail; - my $value; -# dies in gtk2 -# my $fixed_font = Gtk2::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; - - local *TMP; - 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 Gtk2::Text; - my $advanced_box_archive; - $text->insert_text($archive_file_detail, 0); - gtkpack($advanced_box, - $advanced_box_archive = gtkpack_(new Gtk2::VBox(0,10), - 1, gtkpack_(new Gtk2::HBox(0,0), - 1, $text, - 0, new Gtk2::VScrollbar($text->vadj), - ), - 0, gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("Done")), clicked => sub { - destroy_widget(); - $function->() }), - ), - ) - ); - $central_widget = \$advanced_box_archive; - $up_box->show_all(); -} - -sub valid_backup_test { - my (@files_list) = @_; - @files_corrupted = (); - my $is_corrupted = 0; - 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 $text = new Gtk2::TextView; - my $restore_pbs_state = N("List of data corrupted:\n\n"); - $restore_pbs_state .= "\t\t$_\n" foreach @files_corrupted; - $restore_pbs_state .= N("Please uncheck or remove it on next time."); - gtktext_insert($text, [ [ $restore_pbs_state ] ]); - button_box_restore_main(); - - gtkpack($advanced_box, - $do_restore = gtkpack_(new Gtk2::VBox(0,10), - 0, new Gtk2::VBox(0,10), - 1, gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 0, gtkcreate_img('warning'), - 0, N("Backup files are corrupted"), - 1, new Gtk2::VBox(0, 5), - ), - 0, new Gtk2::VBox(0,10), - 1, create_scrolled_window($text), - ), - ); - button_box_restore_pbs_end(); - fonction_env(\$do_restore, \&restore_aff_backup_problems, "", "restore_pbs"); - $up_box->show_all(); -} - -sub restore_aff_result() { - my $do_restore; - my $text = new Gtk2::TextView; - gtktext_insert($text, [ [ $restore_state ] ]); - button_box_restore_main(); - - gtkpack($advanced_box, - $do_restore = gtkpack_(new Gtk2::VBox(0,10), - 1, new Gtk2::VBox(0,10), - 0, N(" All of your selected data have been "), - 0, N(" Successfuly Restored on %s ", $restore_path), - 1, new Gtk2::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"; - local *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; - local $_; - - 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 $text = new Gtk2::TextView; - restore_state(); - gtktext_insert($text, [ [ $restore_state ] ]); - button_box_restore_main(); - - gtkpack($advanced_box, - $do_restore = gtkpack_(new Gtk2::VBox(0,10), - 0, N(" Restore Configuration "), - 1, create_scrolled_window($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 Gtk2::TextView; - my $other_rest = cat_("$path_to_find_restore/list_other"); - gtktext_insert($text, [ [ $other_rest ] ]); - gtkpack($advanced_box, - $retore_step_other = gtkpack_(new Gtk2::VBox(0,10), - 1, new Gtk2::VBox(0,10), - 1, create_scrolled_window($text), - 0, my $check_restore_other_sure = new Gtk2::CheckButton(N("OK to restore the other files.")), - 1, new Gtk2::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 Gtk2::VBox(0,10), - 0, new Gtk2::VBox(0,10), - 0, N("User list to restore (only the most recent date per user is important)"), - 1, create_scrolled_window(gtkpack__(new Gtk2::VBox(0,0), - map { my $name; - my $var2; - my $name_complet = $_; - $name = (split(' ', $name_complet))[0]; - my @user_list_tmp; - my $restore_row = new Gtk2::HBox(0,5); - my $b = new Gtk2::CheckButton($name_complet); - my $details = new Gtk2::Button(" Details "); - - $restore_row->pack_start($b, 1, 1, 0); - $restore_row->pack_end(new Gtk2::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 - destroy_widget(); - show_backup_details(\&restore_step_user, "user", $name); - }); - $restore_row } (@user_backuped) - ), - ), - ), - ); - if ($restore_other) { fonction_env(\$retore_step_user, \&restore_step_user, "", "restore", \&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 $check_backup_before; - my $combo_restore_step_sys = new Gtk2::Combo(); - $combo_restore_step_sys->set_popdown_strings(@sys_backuped); - - gtkpack($advanced_box, - $restore_step_sys = gtkpack_(new Gtk2::VBox(0,10), - 1, new Gtk2::VBox(0,10), - 0, $check_backup_before = new Gtk2::CheckButton(N("Backup the system files before:")), - 0, gtkpack_(new Gtk2::HBox(0,10), - 1, N("please choose the date to restore"), - 0, $combo_restore_step_sys, - 0, my $details = new Gtk2::Button(" Details "), - 0, new Gtk2::HBox(0,10), - ), - 1, new Gtk2::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(); - destroy_widget(); - 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 Gtk2::Adjustment(550.0, 1.0, 10000.0, 1.0, 5.0, 0.0); - my $spinner; - - gtkpack($advanced_box, - $box_where_hd = gtkpack_(new Gtk2::VBox(0, 6), - 0, new Gtk2::HSeparator, - 0, my $check_where_hd = new Gtk2::CheckButton(N("Use Hard Disk to backup")), - 0, new Gtk2::HSeparator, - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the directory to save:")), $where_hd), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_size_request(gtkset_sensitive($save_path_entry = new Gtk2::Entry(), $where_hd), 152, 20), - 0, gtkset_sensitive($button = gtksignal_connect(new Gtk2::Button(), clicked => sub { - filedialog_where_hd() }), $where_hd), - ), - 0, new Gtk2::VBox(0, 6), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the maximum size\n allowed for Drakbackup")), $where_hd), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_size_request(gtkset_sensitive($spinner = new Gtk2::SpinButton($adj, 0, 0), $where_hd), 200, 20), - ), - 0, gtkpack_(new Gtk2::HBox(0,10), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_sensitive(my $check_where_hd_quota = new Gtk2::CheckButton(N("Use quota for backup files.")), $where_hd), - 0, new Gtk2::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; - destroy_widget(); - $current_widget->(); - }); - $button->add(gtkpack(new Gtk2::HBox(0,10), gtkcreate_img("ic82-dossier-32"))); - $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_other_media() { - my $box_find_restore; - my $button; - - gtkpack($advanced_box, - $box_find_restore = gtkpack_(new Gtk2::VBox(0, 6), - 0, new Gtk2::HSeparator, - 0, my $check_other_media_hd = new Gtk2::CheckButton(N("Restore from Hard Disk.")), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, gtkset_sensitive(new Gtk2::Label(N("Please enter the directory where backups are stored")), $other_media_hd), - 1, new Gtk2::VBox(0, 6), - 0, gtkset_size_request(gtkset_sensitive($restore_find_path_entry = new Gtk2::Entry(), $other_media_hd), 152, 20), - 0, gtkset_sensitive($button = gtksignal_connect(new Gtk2::Button(), clicked => sub { - filedialog_restore_find_path(); - }), $other_media_hd), - ), - 1, new Gtk2::VBox(0, 6), -# 0, new Gtk2::HSeparator, -# 0, my $check_other_media_net = new Gtk2::CheckButton( N("Restore from Network")), -# 0, new Gtk2::VBox(0, 6), -# 1, gtkpack(new Gtk2::HBox(0,10), -# new Gtk2::VBox(0, 6), -# gtkset_sensitive(gtksignal_connect(new Gtk2::Button("Network"), clicked => sub { -# destroy_widget(); -# restore_find_net(\&restore_other_media);}), !$other_media_hd), -# new Gtk2::VBox(0, 6), -# ), -# 1, new Gtk2::VBox(0, 6), -# 0, new Gtk2::HSeparator, - 0, new Gtk2::VBox(0, 6), - ), - ); - gtksignal_connect(gtkset_active($check_other_media_hd, $other_media_hd), toggled => sub { - $other_media_hd = $other_media_hd ? 0 : 1; - destroy_widget(); - $current_widget->(); - }); -# gtksignal_connect(gtkset_active($check_other_media_net, !$other_media_hd), toggled => sub { -# $other_media_hd = $other_media_hd ? 0 : 1; -# destroy_widget(); -# $current_widget->(); -# }); - $button->add(gtkpack(new Gtk2::HBox(0,10), gtkcreate_img("ic82-dossier-32"))); - $restore_find_path_entry->set_text($path_to_find_restore); - $restore_find_path_entry->signal_connect('changed', sub { $path_to_find_restore = $restore_find_path_entry->get_text() }); -#- 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; - local $_; - - 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 { $other_exist = 0; $restore_other = 0 } - if (grep { /_sys_/ } grep { /^$info_prefix/ } all("$restore_info_path/")) { $sys_exist = 1 } - else { $sys_exist = 0; $restore_sys = 0 } - if (grep { /_user_/ } grep { /^$info_prefix/ } all("$restore_info_path/")) { $user_exist = 1 } - else { $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 Gtk2::VBox(0,10), - 1, new Gtk2::VBox(0,10), - 1, new Gtk2::VBox(0,10), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, my $check_restore_other_src = new Gtk2::CheckButton(N("Select another media to restore from")), - 1, new Gtk2::HBox(0,10), - 0, gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("Other Media")), clicked => sub { - destroy_widget(); - restore_other_media(); - }), $restore_other_src), - ), - 0, gtkset_sensitive(my $check_restore_sys = new Gtk2::CheckButton(N("Restore system")), $sys_exist), - 0, gtkset_sensitive(my $check_restore_user = new Gtk2::CheckButton(N("Restore Users")), $user_exist), - 0, gtkset_sensitive(my $check_restore_other = new Gtk2::CheckButton(N("Restore Other")), $other_exist), - 0, gtkpack_(new Gtk2::HBox(0,10), - 0, my $check_restore_other_path = new Gtk2::CheckButton(N("select path to restore (instead of /)")), - 1, new Gtk2::HBox(0,10), - 0, gtkset_sensitive(my $restore_path_entry = new Gtk2::Entry(), $restore_other_path), - ), - 0, gtkset_sensitive(my $check_backup_bef_restore = new Gtk2::CheckButton(N("Do new backup before restore (only for incremental backups.)")), - $backup_sys_versions || $backup_user_versions), - 0, gtkset_sensitive(my $check_remove_user_dir = new Gtk2::CheckButton(N("Remove user directories before restore.")), $user_exist), - 1, new Gtk2::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; - destroy_widget(); - $current_widget->(); - }); - gtksignal_connect(gtkset_active($check_restore_other_src, $restore_other_src), toggled => sub { - $restore_other_src = $restore_other_src ? 0 : 1; - destroy_widget(); - $current_widget->(); - }); - $central_widget = \$retore_step2; - fonction_env(\$retore_step2, \&restore_step2, \&restore_box, "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 $cat_entry; - my @restore_files; - my $restore_path_entry; - - #- catalog info in tree view - my $model = Gtk2::TreeStore->new(Gtk2::GType->STRING); - my $tree_catalog = Gtk2::TreeView->new_with_model($model); - $tree_catalog->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $tree_catalog->set_headers_visible(0); - $tree_catalog->get_selection->set_mode('single'); - - # file details in list widget - my $list_bu_files = new Gtk2::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 = Gtk2::TreeIter->new; - $model->append($t_catalog, undef); - $model->set($t_catalog, [ 0 => $t ]); - - gtksignal_connect($t_catalog, select => sub { - $cat_entry = $full_cat_entry; - @restore_files = (); - foreach my $filename (glob("$save_path/list*$t.txt")) { - my @contents = cat_($filename); - $list_bu_files->clear; - foreach (@contents) { - chop; - my $s = $_; - my $f_item = $list_bu_files->add(gtkshow(new Gtk2::ListItem($s))); - gtksignal_connect($f_item, select => sub { push @restore_files, $s }); - gtksignal_connect($f_item, deselect => sub { @restore_files = () }); - } - } - }); - - my $c_detail = Gtk2::TreeIter->new; - - my $indexer = 0; - foreach (@line_data) { - if ($indexer != 0) { - my $m; - $m = "Media: " if $indexer == 1; - $m = "Label or Host: " if $indexer == 2; - $m = "Device or Path: " if $indexer == 3; - $m = "Type: Incremental" if $_ eq "I"; - $m = "Type: Differential" if $_ eq "D"; - $m = "Type: Full" if $_ eq "F"; - $m .= $_ if $_ ne "I" && $_ ne "F"; - $model->append($c_detail, $t_catalog); - $model->set($c_detail, [ 0 => $m ]); - } - $indexer++; - } - $c_detail->free; - } - - gtkpack($advanced_box, - $catalog_box = gtkpack_(new Gtk2::HBox(0,10), - 0, new Gtk2::VBox(0,10), - 1, gtkpack_(new Gtk2::VBox(0,5), - 1, gtkpack_(new Gtk2::VBox(0, 10), - 1, create_scrolled_window($tree_catalog), - 1, create_scrolled_window($list_bu_files), - ), - 0, gtkpack_(new Gtk2::HBox(1, 10), - 1, gtksignal_connect(new Gtk2::Button(N("Restore Selected\nCatalog Entry")), clicked => sub { - if ($cat_entry) { - my $media_check = restore_catalog_entry($cat_entry, ()); - if ($media_check) { - destroy_widget(); -# button_box_restore(); - interactive_mode_box(); - } - } - }), - 1, gtksignal_connect(new Gtk2::Button(N("Restore Selected\nFiles")), clicked => sub { - my $files = @restore_files; - #- grab the array before the widget clears it - my @passed_files = @restore_files; - if ($cat_entry && $files) { - my $media_check = restore_catalog_entry($cat_entry, @passed_files); - if ($media_check) { - destroy_widget(); -# button_box_restore(); - interactive_mode_box(); - } - } - }), - 1, gtkpack_(new Gtk2::VBox(0, 5), - 0, new Gtk2::Label("Restore To Path"), - 0, $restore_path_entry = new Gtk2::Entry(), - ), - 1, gtksignal_connect(new Gtk2::Button(N("Change\nRestore Path")), clicked => sub { - filedialog_generic("Path To Restore To", \$restore_path_entry, \$restore_path); - }), - ), - 0, new Gtk2::VBox(0,10), - ), - 0, new Gtk2::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 - - restore_status(); - - 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 == 0) { - show_warning("f", N("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(N("Restore From CD"), N("Insert the CD with volume label %s\n in the CD drive under mount point /mnt/cdrom", $vol_host) ,1) ? ($vol_name = get_cd_volname()) : return 0; - if ($vol_name ne $vol_host) { - show_warning("f", N("Not the correct CD label. Disk is labelled %s.", $vol_name)); - return(0); - } else { - $restore_result = restore_hd_or_cd($cat_entry, '/mnt/cdrom', @restore_files); - } - } - - if ($media 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(N("Restore From Tape"), N("Insert the tape with volume label %s\n in the tape drive device %s", $vol_host, $dev_path) ,1) ? ($vol_name = get_tape_label($dev_path)) : return(0); - if ($vol_name ne $vol_host) { - show_warning("f", N("Not the correct tape label. Tape is labelled %s.", $vol_name)); - return(0); - } else { - $restore_result = restore_tape($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(N("Restore Via Network"), N("Restore Via Network Protocol: %s", $media), - [ { label => N("Host Name"), val => \$vol_host }, - { label => N("Host Path or Module"), val => \$dev_path }, - { label => N("Username"), val => \$username }, - { label => N("Password"), val => \$userpass, hidden => 1 }, - ]) or goto return(0); - - if ($media eq 'ftp' || $media eq 'rsync') { - if ($userpass eq '') { - show_warning("f", N_("Password required")); - return(0); - } - } - if ($media eq 'ftp' || $media eq 'rsync' || $media eq 'ssh') { - if ($username eq '') { - show_warning("f", N_("Username required")); - return(0); - } elsif ($vol_host eq '') { - show_warning("f", N_("Hostname required")); - return(0); - } - } - if ($dev_path eq '') { - show_warning("f", N_("Path or Module required")); - return(0); - } - - $restore_result = restore_ftp($cat_entry, $vol_host, $dev_path, $username, $userpass, @restore_files) if $media eq 'ftp'; - $restore_result = restore_rsync_ssh_webdav($cat_entry, $vol_host, $dev_path, $username, $media, @restore_files) - if $media eq 'rsync' || $media eq 'ssh' || $media eq 'webdav'; - } - - # cleanup our restore dir - unlink fails here? - system("rm -f $cfg_dir/restores/*"); - - if (!$restore_result) { - show_warning("i", N_("Files Restored...")); - return(0); - } else { - show_warning("f", N_("Restore Failed...")); - return(1); - } - -} - -sub restore_hd_or_cd { - my ($cat_entry, $tarfile_dir, @restore_files) = @_; - my $indv_files = @restore_files; - my $command; - - my $wild_card = catalog_to_wildcard($cat_entry); - - if ($indv_files == 0) { - #- full catalog specified - foreach (wildcard_to_tarfile($wild_card)) { - $command = "tar -C $restore_path -xzf $tarfile_dir/$_"; - spawn_progress($command, "Untarring from \n$_ \nto $restore_path."); - } - } else { - #- individual files - pull from appropriate catalog - foreach (@restore_files) { - my $tarfile = file_to_tarfile($_, $wild_card); - $_ = substr($_, 1); - $command = "tar -C $restore_path -xzf $tarfile_dir/$tarfile $_"; - spawn_progress($command, "Untarring \n$_ from \n$tarfile \nto $restore_path."); - } - } - return(0); -} - -sub restore_tape { - my ($cat_entry, $dev_path, @restore_files) = @_; - my $indv_files = @restore_files; - my $command; - - my $wild_card = catalog_to_wildcard($cat_entry); - $dev_path =~ s|/st|/nst|; - - if ($indv_files == 0) { - #- full catalog specified - foreach (wildcard_to_tarfile($wild_card)) { - my $offset = find_tape_offset($cat_entry); - $command = "mt -f $dev_path rewind"; - spawn_progress($command, "Rewinding tape on $dev_path."); - $command = "mt -f $dev_path fsf $offset"; - spawn_progress($command, "Moving forward $offset file records."); - $command = "tar -C cfg_dir/restores -xf $dev_path"; - spawn_progress($command, "Untarring from $dev_path to work directory."); - if (-e "$cfg_dir/restores/$_") { - $command = "tar -C $restore_path -xzf $cfg_dir/restores/$_"; - spawn_progress($command, "Untarring \n$_ \nto $restore_path."); - } 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); - $command = "mt -f $dev_path rewind"; - spawn_progress($command, "Rewinding tape on $dev_path."); - $command = "mt -f $dev_path fsf $offset"; - spawn_progress($command, "Moving forward $offset file records."); - $command = "tar -C cfg_dir/restores -xf $dev_path"; - spawn_progress($command, "Untarring from $dev_path to work directory."); - } - if (-e "$cfg_dir/restores/$tarfile") { - $command = "tar -C $restore_path -xzf $cfg_dir/restores/$tarfile $_"; - spawn_progress($command, "Untarring \n$_ from \n$tarfile \nto $restore_path."); - } 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; - my $command; - - $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 == 0) { - #- full catalog specified - foreach (wildcard_to_tarfile($wild_card)) { - $ftp->get($_, "$cfg_dir/restores/$_"); - $command = "tar -C $restore_path -xzf $cfg_dir/restores/$_"; - spawn_progress($command, "Untarring \n$_ \nto $restore_path."); - } - } 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"); - } - $command = "tar -C $restore_path -xzf $cfg_dir/restores/$tarfile $_"; - spawn_progress($command, "Untarring \n$_ from \n$tarfile \nto $restore_path."); - } - } - $ftp->quit; - return(0); -} - -sub restore_rsync_ssh_webdav { - my ($cat_entry, $hostname, $hostpath, $username, $mode, @restore_files) = @_; - my $indv_files = @restore_files; - my $command; - - my $wild_card = catalog_to_wildcard($cat_entry); - - if ($indv_files == 0) { - #- full catalog specified - foreach (wildcard_to_tarfile($wild_card)) { - if ($mode eq 'ssh') { - $command = "scp $username\@$hostname:$hostpath/$_ $cfg_dir/restores/"; - } elsif ($mode eq 'rsync') { - $command = "rsync --password-file=$cfg_dir/rsync.user $username\@$hostname::$hostpath/$_ $cfg_dir/restores/"; - } else { - $command = "wget http://$hostname/$hostpath/$_ -P $cfg_dir/restores/"; - } - spawn_progress($command, "Retrieving backup file \n$_ \nvia $mode."); - if (-e "$cfg_dir/restores/$_") { - $command = "tar -C $restore_path -xzf $cfg_dir/restores/$_"; - spawn_progress($command, "Untarring \n$_ \nto $restore_path."); - } 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') { - $command = "scp $username\@$hostname:$hostpath/$tarfile $cfg_dir/restores/"; - } elsif ($mode eq 'rsync') { - $command = "rsync --password-file=$cfg_dir/rsync.user $username\@$hostname::$hostpath/$tarfile $cfg_dir/restores/"; - } else { - $command = "wget http://$hostname/$hostpath/$tarfile -P $cfg_dir/restores/"; - } - spawn_progress($command, "Retrieving backup file \n$tarfile \nvia $mode."); - } - if (-e "$cfg_dir/restores/$tarfile") { - $command = "tar -C $restore_path -xzf $cfg_dir/restores/$tarfile $_"; - spawn_progress($command, "Untarring \n$_ from \n$tarfile \nto $restore_path."); - } 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 (index($_, $label)) { - if (!index($_, $cat_entry)) { - # tar seems to need 2 of these to get located - $offset++; - $offset++; - } else { - return($offset); - } - } - } -} - -sub restore_box() { - my $retore_box; - - 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 Gtk2::HBox(0,1), - 1, new Gtk2::VBox(0,10), - 1, gtkpack_(new Gtk2::VBox(0,10), - 1, new Gtk2::VBox(0,10), - 1, new Gtk2::VBox(0,10), - 1, gtksignal_connect(new Gtk2::Button(N("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 Gtk2::Button(N("Custom Restore")), clicked => sub { - $retore_box->destroy(); - button_box_restore(); - restore_step2(); - }), - 1, new Gtk2::VBox(0,10), - 1, new Gtk2::VBox(0,10), - ), - 1, new Gtk2::HBox(0,10), - ), - ); - } else { - destroy_widget(); - 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 $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) { - $message .= "Backups on unmountable media - Use Catalog to restore"; - $mount_media = 0; - } - $message .= "."; - - gtkpack($advanced_box, - $box2 = gtkpack_(new Gtk2::VBox(0, 5), - 1, gtkpack(new Gtk2::HBox(0, 15), - new Gtk2::VBox(0, 5), - gtkcreate_img('warning'), - translate($message), - new Gtk2::VBox(0, 5), - ), - 1, gtkpack(new Gtk2::HBox(0, 15), - new Gtk2::VBox(0, 5), - gtkpack(new Gtk2::VBox(0, 10), - gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("CD in place - continue.")), clicked => sub { - $good_restore_path = 1; - $box2->destroy(); - interactive_mode_box("restore"); - }), $mount_media), - $new_path_entry = gtkset_sensitive(new Gtk2::Entry(), $mount_media), - gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("Browse to new restore repository.")), clicked => sub { - filedialog_generic("Directory To Restore From", \$new_path_entry, \$path_to_find_restore); - }), $mount_media), - gtksignal_connect(new Gtk2::Button(N("Restore From Catalog")), clicked => sub { - $box2->destroy(); - catalog_restore(); - }), - ), - new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - $new_path_entry->set_text($path_to_find_restore); - - button_box_find_media($mount_media); - $up_box->show_all(); -} - -sub restore_status() { - destroy_widget(); - $pbar3 = new Gtk2::ProgressBar; - $stext = new Gtk2::Label(""); - gtkpack($advanced_box, - $table = gtkpack(new Gtk2::VBox(0, 5), - new Gtk2::HBox(0,5), - create_packtable({ col_spacings => 10, row_spacings => 5 }, - [""], - [""], - [""], - [""], - [N("Restore Progress")], - [""], - [""], - [$pbar3], - [""], - [""], - [$pbar3->{label} = new Gtk2::Label(' ')], - [""], - ), - $stext, - ), - ); - $custom_help = "options"; - $central_widget = \$table; - $up_box->show_all(); - gtkflush(); -} - -################################################ BUTTON_BOX ################################################ - -sub button_box_adv() { - $button_box_tmp->destroy(); - gtkpack($button_box, - $button_box_tmp = gtkpack_(new Gtk2::HButtonBox, - 0, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - interactive_mode_box(); - }), - 0, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help); - }), - 1, new Gtk2::HBox(0, 1), - 0, gtksignal_connect(new Gtk2::Button(N("Previous")), clicked => sub { - destroy_widget(); - $previous_widget->(); - }), - 0, gtksignal_connect(new Gtk2::Button(N("Save")), clicked => sub { - destroy_widget(); - unless (check_pkg_needs()) { - save_conf_file(); - $previous_widget->(); - } - }), - ), - ); -} - -sub button_box_restore_main() { - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack_(gtkpack_(new Gtk2::HButtonBox, - 0, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - destroy_widget(); - interactive_mode_box(); - }), - 0, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help); - }), - 1, new Gtk2::HBox(0, 1), - 0, gtksignal_connect(new Gtk2::Button(N("Previous")), clicked => sub { - destroy_widget(); - interactive_mode_box() - }), - 0, gtksignal_connect(new Gtk2::Button(N("Ok")), clicked => sub { - destroy_widget(); - interactive_mode_box() }), - ), - ), - ); -} - -sub button_box_backup_end() { - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack_(new Gtk2::HButtonBox, - 0, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - destroy_widget(); - interactive_mode_box() - }), - 0, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help) - }), - 1, new Gtk2::HBox(0, 1), - 0, gtksignal_connect(new Gtk2::Button(N("Previous")), clicked => sub { - destroy_widget(); - $previous_widget->() - }), - 0, gtksignal_connect(new Gtk2::Button(N("Build Backup")), clicked => sub { - destroy_widget(); - build_backup_status(); - build_backup_files(); - }), - ), - ); -} - -sub button_box_wizard_end() { - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack_(new Gtk2::HButtonBox, - 0, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - destroy_widget(); - interactive_mode_box(); - }), - 0, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help); - }), - 1, new Gtk2::HBox(0, 1), - 0, gtksignal_connect(new Gtk2::Button(N("Previous")), clicked => sub { - destroy_widget(); - $previous_widget->(); - }), - 0, gtksignal_connect(new Gtk2::Button(N("Save")), clicked => sub { - destroy_widget(); - save_conf_file(); - interactive_mode_box(); - }), - ), - ); -} - -sub button_box_restore_end() { - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack_(new Gtk2::HButtonBox, - 0, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - destroy_widget(); - interactive_mode_box(); - }), - 0, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help); - }), - 1, new Gtk2::HBox(0, 1), - 0, gtksignal_connect(new Gtk2::Button(N("Previous")), clicked => sub { - destroy_widget(); - $previous_widget->(); - }), - 0, gtksignal_connect(new Gtk2::Button(N("Restore")), clicked => sub { - destroy_widget(); - restore_backend(); - }), - ), - ); -} - -sub button_box_build_backup_end() { - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack_(new Gtk2::HButtonBox, - 1, new Gtk2::HBox(0, 5), - 1, new Gtk2::HBox(0, 5), - 0, gtksignal_connect(new Gtk2::Button(N("Ok")), clicked => sub { -# destroy_widget(); - interactive_mode_box(); - }), - ), - ); -} - -sub button_box_restore_pbs_end() { - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack_(new Gtk2::HButtonBox, - 1, new Gtk2::HBox(0, 5), - 1, new Gtk2::HBox(0, 5), - 1, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help); - }), - 0, gtksignal_connect(new Gtk2::Button(N("Ok")), clicked => sub { - destroy_widget(); - interactive_mode_box(); - }), - ), - ); -} - -sub button_box_build_backup() { - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack_(new Gtk2::HButtonBox, - 1, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - destroy_widget(); - interactive_mode_box(); - }), - 1, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help); - }), - 1, new Gtk2::HBox(0, 0), - 0, gtksignal_connect(new Gtk2::Button(N("Previous")), clicked => sub { - destroy_widget(); - $previous_widget->(); - }), - 1, gtksignal_connect(new Gtk2::Button(N("Next")), clicked => sub { - destroy_widget(); - $next_widget->(); - }), - ), - ); -} - -sub button_box_restore() { - - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack_(new Gtk2::HButtonBox, - 1, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - destroy_widget(); - interactive_mode_box(); - }), - 1, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help); - }), - 1, new Gtk2::HBox(0, 0), - 0, gtksignal_connect(new Gtk2::Button(N("Previous")), clicked => sub { - destroy_widget(); - $previous_widget->(); - }), - 1, gtksignal_connect(new Gtk2::Button(N("Next")), clicked => sub { - destroy_widget(); - $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 Gtk2::HButtonBox, - 1, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - $box2->destroy(); - interactive_mode_box(); - }), - 1, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - $box2->destroy(); - adv_help(\&$current_widget, $custom_help); - }), - 1, new Gtk2::HBox(0, 0), - 0, gtksignal_connect(new Gtk2::Button(N("Previous")), clicked => sub { - $box2->destroy(); - interactive_mode_box(); - }), - 1, gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("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 Gtk2::HButtonBox, - 1, gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { - destroy_widget(); - interactive_mode_box() - }), - 1, gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&$current_widget, $custom_help) - }), - 1, new Gtk2::HBox(0, 0), - 0, gtksignal_connect(new Gtk2::Button($next_widget ? N("Previous") : N("OK")), clicked => sub { - destroy_widget(); - $previous_widget ? $previous_widget->() : $next_widget->(); - }), - if_($next_widget, 1, gtksignal_connect(new Gtk2::Button(N("Next")), clicked => sub { - destroy_widget(); - $next_widget ? $next_widget->() : $previous_widget->(); - })), - ), - ); -} - -sub button_box_main() { - $button_box_tmp->destroy(); - - gtkpack($button_box, - $button_box_tmp = gtkpack(gtkset_layout(new Gtk2::HButtonBox, 'start'), - gtksignal_connect(new Gtk2::Button(N("Close")), clicked => sub { ugtk2->exit(0) }), - gtksignal_connect(new Gtk2::Button(N("Help")), clicked => sub { - adv_help(\&interactive_mode_box, $custom_help) - }), - ), - ); -} - -################################################ MESSAGES ################################################ - -sub dialog_one { - $table->destroy(); - my ($label) = @_; - - gtkadd($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 0, gtkpack_(new Gtk2::HBox(0, 15), - 0, new Gtk2::VBox(0, 5), - 0, gtkcreate_img('warning'), - 0, $label), - 0, new Gtk2::VBox(0, 5), - 1, new Gtk2::VBox(0, 5), - ), - ); - button_box_restore_main(); - $custom_help = "mail_pb"; - $central_widget = \$box2; - $up_box->show_all(); -} - -sub send_mail_pb() { - dialog_one(N("Error during sendmail. - Your report mail was not sent. - Please configure sendmail")); -} - -sub client_ftp_pb() { - dialog_one(N("Error during sending file via FTP. - Please correct your FTP configuration.")); -} - -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 Gtk2::VBox(0, 15), - 0, N("The following packages need to be installed:\n") . join(' ', @list_of_rpm_to_install), - 0, new Gtk2::HSeparator, - 0, gtksignal_connect(new Gtk2::Button(N("Install")), clicked => sub { - system("/usr/sbin/urpmi --X @list_of_rpm_to_install"); - destroy_widget(); - $previous_widget->(); - }), - ), - ); - fonction_env(\$box_what_user, \&install_rpm, \&$previous_function, "what"); - $up_box->show_all(); -} - - -sub message_norestore_box() { - $box2->destroy(); - - gtkadd($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack(new Gtk2::HBox(0, 15), - new Gtk2::VBox(0, 5), - gtkcreate_img('warning'), - N("Please select data to restore..."), - new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - button_box_restore_main(); - $central_widget = \$box2; - $up_box->show_all(); -} - - -sub message_common_box { - $box2->destroy(); - my ($label) = @_; - - gtkadd($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack(new Gtk2::HBox(0, 15), - new Gtk2::VBox(0, 5), - gtkcreate_img('warning'), - $label, - new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - $previous_widget = \&wizard; - $next_widget = \&wizard; - $central_widget = \$box2; - $up_box->show_all(); -} - -sub message_noselect_box() { - message_common_box(N("Please select media for backup...")); - $previous_widget = \&wizard_step2; - $next_widget = \&wizard_step2; - $central_widget = \$box2; - $up_box->show_all(); -} - -sub message_noselect_what_box() { - message_common_box(N("Please select data to backup...")); - $previous_widget = \&wizard; - $next_widget = \&wizard; - $central_widget = \$box2; - $up_box->show_all(); -} - -sub message_common_box_2 { - my ($label, $restore_main) = @_; - - $box2->destroy(); - - gtkadd($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack(new Gtk2::HBox(0, 15), - new Gtk2::VBox(0, 5), - gtkcreate_img('warning'), - N("%s", $label), - new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - button_box_restore_main() if $restore_main; - $central_widget = \$box2; - $up_box->show_all(); -} -sub message_noconf_box() { - message_common_box_2(N("No configuration file found \nplease click Wizard or Advanced."), 1); -} - -sub message_underdevel() { - message_common_box_2(N("Under Devel ... please wait."), 1); -} - -################################################ BUILD_BACKUP ################################################ - -sub progress { - my ($progressbar, $plabel, $incr, $label_text) = @_; - my ($new_val) = $progressbar->get_fraction; - $new_val += $incr; - if ($new_val > 1) { $new_val = 1 } - $progressbar->fraction($new_val); - $plabel->set_text($label_text); - gtkflush(); -} - -sub find_backup_to_put_on_cd() { - @data_backuped = (); - local $_; - - -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 Gtk2::ProgressBar; - $pbar1 = new Gtk2::ProgressBar; - $pbar2 = new Gtk2::ProgressBar; - $pbar3 = new Gtk2::ProgressBar; - $plabel = new Gtk2::Label(" "); - $plabel1 = new Gtk2::Label(" "); - $plabel2 = new Gtk2::Label(" "); - $plabel3 = new Gtk2::Label(" "); - - $stext = new Gtk2::Label(""); - button_box_build_backup_end(); - - my $table = Gtk2::Table->new(10, 2, 1); - $table->set_row_spacings(5); - $table->set_col_spacings(10); - - $table->attach_defaults(new Gtk2::Label(N("Backup system files")), 0, 1, 0, 1); - $table->attach_defaults($pbar, 0, 1, 1, 2); - $table->attach_defaults($plabel, 1, 2, 1, 2); - $table->attach_defaults(new Gtk2::Label(N("Backup user files")), 0, 1, 2, 3); - $table->attach_defaults($pbar1, 0, 1, 3, 4); - $table->attach_defaults($plabel1, 1, 2, 3, 4); - $table->attach_defaults(new Gtk2::Label(N("Backup other files")), 0, 1, 4, 5); - $table->attach_defaults($pbar2, 0, 1, 5, 6); - $table->attach_defaults($plabel2, 1, 2, 5, 6); - $table->attach_defaults(new Gtk2::Label(N("Total Progress")), 0, 1, 6, 7); - $table->attach_defaults($pbar3, 0, 1, 7, 8); - $table->attach_defaults($plabel3, 1, 2, 7, 8); - - gtkpack($advanced_box, - my $tbox = gtkpack(new Gtk2::VBox(0, 5), - $table, - $stext, - ), - ); - - $custom_help = "options"; - $central_widget = \$tbox; - $up_box->show_all(); - gtkflush(); -} - - -sub build_backup_ftp_status() { - $pbar = new Gtk2::ProgressBar; - $pbar3 = new Gtk2::ProgressBar; - destroy_widget(); - button_box_build_backup_end(); - $pbar->set_fraction(0); - $pbar3->set_fraction(0); - - - gtkpack($advanced_box, - $table = gtkpack_(new Gtk2::VBox(0, 15), - 1, N("Sending files by FTP"), - 1, new Gtk2::VBox(0, 15), - 1, create_packtable ({ col_spacings => 10, row_spacings => 5 }, - [N("Sending files...")], - [""], - [ $plabel = new Gtk2::Label(' ') ], - [ $pbar ], - [""], - [N("Total Progress")], - [ $plabel3 = new Gtk2::Label(' ') ], - [$pbar3], - ), - 1, new Gtk2::VBox(0, 15), - ), - ); - $custom_help = "options"; - $central_widget = \$table; - $up_box->show_all(); - gtkflush(); -} - -sub build_backup_box_see_conf() { - my $box2; - my $text = new Gtk2::TextView; - system_state(); - gtktext_insert($text, [ [ $system_state ] ]); - button_box_restore_main(); - - gtkpack($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, gtkpack_(new Gtk2::VBox(0,10), - 0, N("Drakbackup Configuration"), - 1, create_scrolled_window($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() { - destroy_widget(); - - gtkadd($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack_(new Gtk2::VBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtksignal_connect(my $button_from_conf_file = new Gtk2::Button(), clicked => sub { - destroy_widget(); - build_backup_box_see_conf(); - }), - 0, new Gtk2::VBox(0, 5), - 1, gtksignal_connect(my $button_see_conf = new Gtk2::Button(), clicked => sub { - destroy_widget(); - build_backup_box_see_conf(); - }), - 1, new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - - $button_from_conf_file->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-discdurwhat-40"), - new Gtk2::Label(N("Backup Now from configuration file")), - new Gtk2::HBox(0, 5) - )); - $button_see_conf->add(gtkpack(new Gtk2::HBox(0,10), - gtkcreate_img("ic82-moreoption-40"), - new Gtk2::Label(N("View Backup Configuration.")), - new Gtk2::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 { - - destroy_widget(); - my ($mode) = @_; - - gtkadd($advanced_box, - $box2 = gtkpack_(new Gtk2::HBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtkpack_(new Gtk2::VBox(0, 15), - 1, new Gtk2::VBox(0, 5), - 1, gtksignal_connect(new Gtk2::Button(N("Wizard Configuration")), clicked => sub { - destroy_widget(); - read_conf_file(); - wizard(); - }), - 1, gtksignal_connect(new Gtk2::Button(N("Advanced Configuration")), clicked => sub { - button_box_adv(); - destroy_widget(); - advanced_box(); - }), - 1, gtksignal_connect(new Gtk2::Button(N("Backup Now")), clicked => sub { - if ($cfg_file_exist) { - build_backup_box(); - } else { - message_noconf_box(); - } - }), - 1, gtksignal_connect(new Gtk2::Button(N("Restore")), clicked => sub { - destroy_widget(); - restore_box(); - }), - 1, new Gtk2::VBox(0, 5), - ), - 1, new Gtk2::VBox(0, 5), - ), - ); - button_box_main(); - $custom_help = "main"; - $central_widget = \$box2; - $up_box->show_all(); - if ($mode eq "restore") { - destroy_widget(); - restore_box(); - } -} - -sub interactive_mode() { - $interactive = 1; - - $in = 'interactive'->vnew; - - my $box; - $my_win = ugtk2->new('drakbackup'); - $window1 = $my_win->{window}; - unless ($::isEmbedded) { - $my_win->{rwindow}->set_position('center'); - $my_win->{rwindow}->set_title(N("Drakbackup")); - } - $my_win->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) }); - read_conf_file(); - - gtkadd($window1, - gtkpack(new Gtk2::VBox(0,0), - gtkpack(gtkset_size_request($up_box = new Gtk2::VBox(0, 5), 540, 400), - $box = gtkpack_(new Gtk2::VBox(0, 3), - if_(!$::isEmbedded, 0, gtkcreate_img("drakbackup.540x57")), - 1, gtkpack_(new Gtk2::HBox(0, 3), - 1, gtkpack_(new Gtk2::HBox(0, 15), - 0, new Gtk2::HBox(0, 5), - 1, $advanced_box = gtkpack_(new Gtk2::HBox(0, 15), - ), - 0, new Gtk2::HBox(0, 5), - ), - ), - 0, new Gtk2::HSeparator, - 0, $button_box = gtkpack(new Gtk2::VBox(0, 15), - $button_box_tmp = gtkpack(new Gtk2::VBox(0, 0),), - ), - ), - ), - ), - ); - interactive_mode_box(); - $custom_help = "main"; - button_box_main(); - $central_widget = \$box2; - $window1->show_all; - $window1->realize; - $window1->show_all(); - $my_win->main; - $my_win->exit(0); -} - -################################################ HELP & ABOUT ################################################ - - -sub adv_help { - my ($function, $custom_help) = @_; - -################################################ help definition ############################################## - - my %custom_helps = ( - "options" => - N("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" => - N(" - 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" => - N("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 the web browser's cache. - - - Backup Other Files: - - This option allows you to include additional data to save. - If you want to add individual files, select them from the - righthand 'Files' list pane. To add directories, enter the - directory by clicking on it in the lefthand 'Folders' pane, - and at that point click 'OK' without selecting any files. - - - 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 data 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. - - - Differential Backups: - - The differential backup, rather than comparing changes in the - data to the previous incremental backup, always compares the - data to the initial base backup. This method allows one to - restore the base and then the differential from a certain date. - -"), - "restore" => - N("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 for - backup. This option allows you to backup all your data - the first time, and only the changed data 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. - - - Differential Backups: - - The differential backup, rather than comparing changes in the - data to the previous incremental backup, always compares the - data to the initial base backup. This method allows one to - restore the base and then the differential from a certain date. - -"), - "main" => - N(" Copyright (C) 2001-2002 MandrakeSoft by DUPONT Sebastien <dupont_s\@epita.fr>") . -"\n" . -N(" updates 2002 MandrakeSoft by Stew Benedict <sbenedict\@mandrakesoft.com>") . -"\n\n" . $::license . -"\n\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 backups will be stored on your - /var/lib/drakbackup directory - - Configuration file: - /etc/drakconf/drakbackup/drakbackup.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" => - N("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" => - N(" -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. -") -); - -################################################ help function ############################################## - destroy_widget(); - my $text = new Gtk2::TextView; - gtktext_insert($text, $custom_helps{$custom_help} || $custom_helps{main}); - gtkpack($advanced_box, - my $advanced_box_help = gtkpack_(new Gtk2::VBox(0,10), - 1, create_scrolled_window($text), - 0, gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("OK")), clicked => sub { - destroy_widget(); - $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; -} - -sub destroy_widget() { - if ($central_widget ne '') { - $$central_widget->destroy; - $central_widget = ''; - } -} diff --git a/perl-install/standalone/drakboot b/perl-install/standalone/drakboot deleted file mode 100755 index e75045c6b..000000000 --- a/perl-install/standalone/drakboot +++ /dev/null @@ -1,356 +0,0 @@ -#!/usr/bin/perl - -# DrakBoot -# $Id$ -# Copyright (C) 2001-2003 MandrakeSoft -# Yves Duret, Thierry Vignaud -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use strict; -use diagnostics; -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' -use c; -use common; -use interactive; -use any; -use bootloader; -use detect_devices; -use fsedit; -use fs; -use Config; -use POSIX; -use Xconfig::various; -use log; - -my $in = 'interactive'->vnew('su'); - -if (!$in->isa('interactive::gtk')) { - lilo_choice(); - $in->exit(0); -} -require ugtk2; -ugtk2->import(qw(:helpers :wrappers :create)); - -my $no_bootsplash; -my $x_mode = Xconfig::various::runlevel() == 5; -my $auto_mode = any::get_autologin(); -my $lilogrub = bootloader::detect_bootloader(); - -my $w = ugtk2->new(N("Boot Style Configuration")); -my $window = $w->{window}; -$::main_window = $w->{rwindow} if !$::isEmbedded; - -$window->signal_connect(delete_event => sub { utk2->exit(0) }); -unless ($::isEmbedded) { - $window->set_border_width(2); - - ### menus definition - # the menus are not shown but they provides shiny shortcut like C-q - my @menu_items = ({ path => N("/_File"), type => '<Branch>' }, - { - path => N("/File/_Quit"), accelerator => N("<control>Q"), callback => sub { ugtk2->exit(0) } }, - ); - create_factory_menu($w->{rwindow}, @menu_items); - ######### menus end -} - -my $user_combo = new Gtk2::Combo; -$user_combo->set_popdown_strings(list_users()); -$user_combo->entry->set_text($auto_mode->{autologin}) if $auto_mode->{autologin}; -my $desktop_combo = new Gtk2::Combo; -$desktop_combo->set_popdown_strings(split(' ', `/usr/sbin/chksession -l`)); -$desktop_combo->entry->set_text($auto_mode->{desktop}) if $auto_mode->{desktop}; - -my $disp_mode = arch() =~ /ppc/ ? N("Yaboot mode") : N("Lilo/grub mode"); - -my %themes = ('path' => '/usr/share/bootsplash/themes/', - 'default' => 'Mandrake', - 'def_thmb' => '/usr/share/libDrakX/pixmaps/nosplash_thumb.png', - 'lilo' => {'file' => '/lilo/message', - 'thumb' => '/lilo/thumb.png' }, - 'boot' => {'path' => '/images/', - #'thumb'=>'/images/thumb.png', - }, - ); -my $cur_res = top(cat_('/etc/lilo.conf') =~ /[^#]*vga=(.*)/); -#- verify that current resolution is ok -if (member( $cur_res, qw( 785 788 791 794))) { - ($cur_res) = $bootloader::vga_modes{$cur_res} =~ /^([0-9x]+).*?$/; -} else { - $no_bootsplash = 1; #- we can't select any theme we're not in Framebuffer mode :-/ -} - -#- and check that lilo is the correct loader -$no_bootsplash ||= chomp_(`detectloader -q`) ne 'LILO'; -$no_bootsplash = 0 if $::testing; -my @thms; -my @lilo_thms = if_(!$themes{default}, qw(default)); -my @boot_thms = if_(!$themes{default}, qw(default)); -chdir($themes{path}); #- we must change directory for correct @thms assignement -foreach (all('.')) { - if (-d $themes{path} . $_ && m/^[^.]/) { - push @thms, $_; - -f $themes{path} . $_ . $themes{lilo}{file} and push @lilo_thms, $_; - -f $themes{path} . $_ . $themes{boot}{path} . "bootsplash-$cur_res.jpg" and push @boot_thms, $_; - } - # $_ eq $themes{'defaut'} and $default = $themes{'defaut'}; -} -my %combo = ('thms' => '', 'lilo' => '', 'boot' => ''); -foreach (keys(%combo)) { - $combo{$_} = gtkset_size_request(Gtk2::Combo->new, 10, -1); - $combo{$_}->set_value_in_list(1, 0); -} - -$combo{thms}->set_popdown_strings(@thms); -$combo{lilo}->set_popdown_strings(@lilo_thms); -$combo{boot}->set_popdown_strings(@boot_thms) if !$no_bootsplash; - -my $lilo_pixbuf; -my $lilo_pic = gtkcreate_img($themes{def_thmb}); - -my $boot_pic = gtkcreate_img($themes{def_thmb}); - -my $thm_button = new Gtk2::Button(N("Install themes")); -my $logo_thm = new Gtk2::CheckButton(N("Display theme\nunder console")); -my $B_create = new Gtk2::Button(N("Create new theme")); -my $keep_logo = 1; -$logo_thm->set_active(1); -$logo_thm->signal_connect(clicked => sub { invbool(\$keep_logo) }); -$B_create->signal_connect(clicked => sub { - system('/usr/sbin/draksplash '); - }); -#- ******** action to take on changing combos values - -$combo{thms}->entry->signal_connect(changed => sub { - my $thm_txt = $combo{thms}->entry->get_text(); - $combo{lilo}->entry->set_text(member($thm_txt, @lilo_thms) ? $thm_txt : $themes{default} || 'default'); - $combo{boot}->entry->set_text(member($thm_txt, @boot_thms) ? $thm_txt : $themes{default} || 'default'); - - }); - -$combo{lilo}->entry->signal_connect(changed => sub { - my $new_file = $themes{path} . $combo{lilo}->entry->get_text() . $themes{lilo}{thumb}; - undef($lilo_pixbuf); - $lilo_pixbuf = gtkcreate_pixbuf(-r $new_file ? $new_file : $themes{def_thmb}); - $lilo_pixbuf = $lilo_pixbuf->scale_simple(155, 116, 'nearest'); - $lilo_pic->set_from_pixbuf($lilo_pixbuf); - }); - -$no_bootsplash == 0 - and $combo{boot}->entry->signal_connect( changed => sub { - my $img_file = $themes{path}.$combo{boot}->entry->get_text().$themes{boot}{path}."bootsplash-$cur_res.jpg"; - $boot_pic = gtkcreate_img( $img_file); - }); - -$combo{thms}->entry->set_text($themes{default}); - -$thm_button->signal_connect('clicked', - sub { - my $error = 0; - my $boot_conf_file = '/etc/sysconfig/bootsplash'; - my $lilomsg = '/boot/message-graphic'; - #lilo installation - if (-f $themes{path}.$combo{lilo}->entry->get_text() . $themes{lilo}{file}) { - use MDK::Common::File; - cp_af($lilomsg, "/boot/message-graphic.old"); - #can't use this anymore or $in->ask_warn(N("Error"), N("unable to backup lilo message")); - cp_af($themes{path} . $combo{lilo}->entry->get_text() . $themes{lilo}{file}, $lilomsg); - #can't use this anymore or $in->ask_warn(N("Error"), N("can't change lilo message")); - } else { - $error = 1; - $in->ask_warn(N("Error"), N("Lilo message not found")); - } - #bootsplash install - if ($::testing || -f $themes{path} . $combo{boot}->entry->get_text() . $themes{boot}{path} . "bootsplash-$cur_res.jpg") { - my $bootsplash_cont = "# -*- Mode: shell-script -*- -# Specify here if you want add the splash logo to initrd when -# generating an initrd. You can specify : -# -# SPLASH=no to don't have a splash screen -# -# SPLASH=auto to make autodetect the splash screen -# -# SPLASH=INT When Integer could be 800x600 1024x768 1280x1024 -# -SPLASH=$cur_res -# Choose the themes. The should be based in -# /usr/share/bootsplash/themes/ -THEME=" . $combo{boot}->entry->get_text() . " -# Say yes here if you want to leave the logo on the console. -# Three options : -# -# LOGO_CONSOLE=no don't display logo under console. -# -# LOGO_CONSOLE=yes display logo under console. -# -# LOGO_CONSOLE=theme leave the theme to decide. -# -LOGO_CONSOLE=" . ($keep_logo ? 'yes' : 'no') . "\n"; - if (-f $boot_conf_file) { - eval { output($boot_conf_file, $bootsplash_cont) }; - $@ && $in->ask_warn(N("Error"), N("Can't write /etc/sysconfig/bootsplash.")); - } else { - $in->ask_warn(N("Error"), N("Can't write /etc/sysconfig/bootsplash\nFile not found.")); - $error = 1; - } - } else { - $in->ask_warn("Error", "BootSplash screen not found"); - return; - } - #here is mkinitrd time - if (!$error && !$::testing) { - foreach (map { if_(m|^initrd-(.*)\.img|, $1) } all('/boot')) { - if (system("mkinitrd -f /boot/initrd-$_.img $_")) { - $in->ask_warn(N("Error"), - N("Can't launch mkinitrd -f /boot/initrd-%s.img %s.", $_,$_)); - $error = 1; - } - } - } - if (system('lilo')) { - $in->ask_warn(N("Error"), - N("Can't relaunch LiLo! -Launch \"lilo\" as root in command line to complete LiLo theme installation.")); - $error = 1; - } - $in->ask_warn($error ? N("Error") : N("Notice"), - $error ? N("Theme installation failed!") : N("LiLo and Bootsplash themes installation successfull")); - }); - -my $x_box; - -gtkadd($window, - gtkpack__(new Gtk2::VBox(0,0), - gtkadd(new Gtk2::Frame($disp_mode), - # gtkpack__(new Gtk2::VBox(0,0), - (gtkpack_(gtkset_border_width(new Gtk2::HBox(0, 0),5), - 1, my $boot_label = Gtk2::Label->new(""), - 0, gtksignal_connect(new Gtk2::Button(N("Configure")), clicked => \&lilo_choice), - )), - # "" #we need some place under the button -- replaced by gtkset_border_width( for the moment - # ) - - ), - #Splash Selector - gtkadd(my $thm_frame = new Gtk2::Frame( N("Splash selection")), - gtkpack(gtkset_border_width(new Gtk2::HBox(0, 5), 5), - gtkpack__(new Gtk2::VBox(0, 5), - N("Themes"), - $combo{thms}, - N("\nSelect the theme for\nlilo and bootsplash,\nyou can choose\nthem separately"), - $logo_thm), - Gtk2::VSeparator->new, - gtkpack__(new Gtk2::VBox(0, 5), - N("Lilo screen"), - $combo{lilo}, - $lilo_pic, - $B_create), - Gtk2::VSeparator->new, - gtkpack__(new Gtk2::VBox(0, 5), - N("Bootsplash"), - $combo{boot}, - $boot_pic, - $thm_button)) - ), - - gtkadd(new Gtk2::Frame(N("System mode")), - gtkpack__(new Gtk2::VBox(0, 5), - gtksignal_connect(gtkset_active(new Gtk2::CheckButton(N("Launch the graphical environment when your system starts")), $x_mode), clicked => sub { - $x_box->set_sensitive(!$x_mode); - $x_mode = !$x_mode; - }), - gtkpack__(gtkset_sensitive($x_box = Gtk2::VBox->new(0, 0), $x_mode), - gtkpack__(Gtk2::VBox->new(0, 0), - my @auto_buttons = gtkradio((N("Yes, I want autologin with this (user, desktop)")) x 2, N("No, I don't want autologin")), - ), - gtkpack__(my $auto_box = new Gtk2::VBox(0, 10), - $user_combo, - $desktop_combo - ) - ) - ) - ), - gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'end'), - gtksignal_connect(new Gtk2::Button(N("OK")), clicked => sub { - Xconfig::various::runlevel($x_mode ? 5 : 3); - updateAutologin(); - ugtk2->exit(0); - }), - gtksignal_connect(new Gtk2::Button(N("Cancel")), clicked => sub { ugtk2->exit(0) }) - ) - ) - ); - -$auto_buttons[0]->signal_connect('toggled' => sub { $auto_box->set_sensitive($auto_buttons[0]->get_active()) }); -$auto_buttons[1]->signal_connect('toggled' => sub { $auto_box->set_sensitive(!$auto_buttons[1]->get_active()) }); -$auto_buttons[0]->set_active(1) if $auto_mode->{autologin}; -$auto_buttons[1]->set_active(1) if !$auto_mode->{autologin}; - -$x_box->set_sensitive($x_mode); -$auto_box->set_sensitive($auto_mode->{autologin} ? 1 : 0); -$window->show_all(); -$no_bootsplash and $thm_frame->hide(); -update_bootloader_label($lilogrub); -gtkflush(); -$w->main; -$in->exit(0); - - -sub update_bootloader_label { - my ($bootloader) = @_; - $boot_label->set_label(N("You are currently using %s as your boot manager. -Click on Configure to launch the setup wizard.", $bootloader)); -} - -sub lilo_choice() { - my $bootloader = bootloader::read(); - - my ($all_hds) = fsedit::get_hds(); - my $fstab = [ fsedit::get_all_fstab($all_hds) ]; - fs::merge_info_from_fstab($fstab, '', 0, undef); - - $::expert=1; - - ask: - local $::isEmbedded = 0; - eval { any::setupBootloader($in, $bootloader, $all_hds, $fstab, $ENV{SECURE_LEVEL}) }; - my $loader = arch() =~ /ppc/ ? "Yaboot" : "LILO"; - my $err = $@; - if ($err) { - $in->ask_warn('', - [ N("Installation of %s failed. The following error occured:", $loader), $err ]); - goto ask; - } - update_bootloader_label(bootloader::detect_bootloader()); -} - - - -#------------------------------------------------------------- -# launch autologin functions -#------------------------------------------------------------- - -sub updateAutologin() { - my ($usern, $deskt) = ($user_combo->entry->get_text(), $desktop_combo->entry->get_text()); - if ($auto_buttons[0]->get_active()) { - $in->do_pkgs->install('autologin') if $x_mode; - any::set_autologin($usern, $deskt); - } else { - any::set_autologin(); - } -} diff --git a/perl-install/standalone/drakbug b/perl-install/standalone/drakbug deleted file mode 100755 index 94131c6b9..000000000 --- a/perl-install/standalone/drakbug +++ /dev/null @@ -1,191 +0,0 @@ -#!/usr/bin/perl - -# Drak Bug Report -# Copyright (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 strict; -use diagnostics; -use lib qw(/usr/lib/libDrakX); - -use standalone; -use interactive; -use common; -use ugtk2 qw(:all); -use Config; - - -my $in = 'interactive'->vnew; - -my $bugzilla_url = "http://drakbug.mandrakesoft.com"; -my $version = "0.9.0"; -my $prog; -my $incident = 0; - -foreach (@ARGV) { - next unless defined $_; - /^--report$/ and $prog = shift @ARGV; - /^--incident$/ and do { $incident = 1; $prog = shift @ARGV }; -} - -my $window = ugtk2->new('drakbug', center => 1); -my $window_g = $window->{window}; -#$window->{rwindow}->set_policy($false,$false,$true); -$window->{rwindow}->set_border_width(5); -$window->{rwindow}->set_title(N("Mandrake Bug Report Tool")); -$window->{window}->signal_connect("delete_event", \&quit_global); - -my $mdk_app = { - N("Mandrake Control Center") => 'drakconf', - N("First Time Wizard") => 'drakfw', - N("Synchronization tool") => 'draksync', - N("Standalone Tools") => ['adduserdrake', 'diskdrake', 'drakautoinst', 'drakbackup', 'drakboot', 'drakbug', 'drakfloppy', 'drakfont', 'drakgw', 'drakconnect', 'drakxservices', 'drakxtv', 'keyboardrake', 'logdrake', 'mousedrake', 'net_monitor', 'printerdrake', 'scannerdrake', 'drakfirewall', 'XFdrake'], - N("HardDrake") => 'harddrake2', - N("Mandrake Online") => 'mdkonline', - N("Menudrake") => 'menudrake', - N("Msec") => 'msec', - N("Remote Control") => 'rfbdrake', - N("Software Manager") => 'rpmdrake', - N("Urpmi") => 'urpmi', - N("Windows Migration tool") => 'transfugdrake', - N("Userdrake") => 'userdrake', - N("Configuration Wizards") => 'wizdrake', - }; - -my @generic_tool = keys %$mdk_app; -my @all_drakxtools = @{ $mdk_app->{N("Standalone Tools")} }; -push(@generic_tool,@all_drakxtools); - -my $kernel_release = chomp_(`uname -r`) . ""; - -my $table = new Gtk2::Table(4,2, 'TRUE'); -#$table->set_border_width(5); -$table->set_row_spacings(10); -$table->set_col_spacings(5); -$table->attach(new Gtk2::Label(N("Application:")), 0, 1, 0, 1, 'fill', 'fill',20,0); -$table->attach(new Gtk2::Label(N("Package: ")), 0, 1, 1, 2, 'fill', 'fill',0,0); -$table->attach(new Gtk2::Label(N("Kernel:")), 0, 1, 2, 3, 'fill', 'fill',0,0); -$table->attach(new Gtk2::Label(N("Release: ")), 0, 1, 3, 4, 'fill', 'fill',0,0); -$table->attach(my $comb_app = new Gtk2::Combo(), 1, 2, 0, 1, 'fill', 'fill',0,0); -$comb_app->set_size_request(270, undef); -$comb_app->set_popdown_strings("", sort(@generic_tool)); -$table->attach(my $package = new Gtk2::Entry(), 1, 2, 1, 2, 'fill', 'fill',0,0); -$package->set_text("..."); -$table->attach(my $kernel_rel = new Gtk2::Entry(), 1, 2, 2, 3, 'fill', 'fill',0,0); -$kernel_rel->set_text($kernel_release); -$table->attach(my $mdk_rel = new Gtk2::Entry(), 1, 2, 3, 4, 'fill', 'fill',0,0); -$mdk_rel->set_text(mandrake_release()); - -gtkpack2__( - gtkpack2__(my $vbx = new Gtk2::VBox(0,5), - gtkadd($table), - gtkpack(new Gtk2::HBox(0,0), - gtkpack(gtkset_justify(new Gtk2::Label(N("\n\nTo submit a bug report, click on the button report.\nThis will open a web browser window on https://drakbug.mandrakesoft.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 Gtk2::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 Gtk2::HBox(0,0); -my $Close_Button = new Gtk2::Button(N("Close")); -$Close_Button->signal_connect(clicked => sub { ugtk2->exit(0) }); -$hbx->pack_start($Close_Button,0,0,0); - -my $Report_Button = new Gtk2::Button(N("Report")); -$Report_Button->signal_connect(clicked => sub { my $options = "mdkbugreport=1"; - $options .= "&incident=1" if $incident; - my $p = $package->get_text(); my $k = $kernel_rel->get_text(); (my $r = parse_release()) =~ s/\s//; - $options .= "&package=$p" if $p =~ /mdk/; - $options .= "&kernel=$k"; - $options .= "&version=$r"; - print($bugzilla_url . "?" . $options . "\n"); - connect_bugzilla($bugzilla_url."?".$options) }); -my $help_button = new Gtk2::Button(" ".N("Help")." "); -$help_button->signal_connect(clicked => sub { system("drakhelp https://qa.mandrakesoft.com &") }); -$hbx->pack_end($Report_Button,0,0,0); -$hbx->pack_end($help_button,0,0,5); -$vbx->pack_start($hbx,0,0,0); -$window->{window}->add($vbx); - -$window->{window}->show_all(); -$window->main; -ugtk2->exit(0); - -sub update_app { - my ($text) = @_; - my $app_choice; - $ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}"; - if (member($text,@all_drakxtools) || $text eq N("Standalone Tools")) { - $app_choice = chomp_(`rpm -q drakxtools`); - } elsif (member($text, keys %$mdk_app) && $text ne N("Standalone Tools")) { - $app_choice = get_package($mdk_app->{$text}); - } else { - LOOP: while (my ($key, $value) = each %$mdk_app) { - next if $key eq N("Standalone Tools"); - if ($value eq $text) { - $app_choice = get_package($text); - $prog = $key; - last LOOP; - } - } - - } - $app_choice ? $package->set_text($app_choice) : $package->set_text(N("Not installed")); -} - -my %packages; - -sub get_package { - my ($executable) = @_; - my ($rpm_package, $which_app); - $rpm_package = $packages{$executable}; - if (!defined $rpm_package) { - $which_app = chomp_(`which '$executable' 2> /dev/null`); - # deush, rpm can takes some time aka it'll sleeps if something has opened rpm db ! - $rpm_package = $which_app eq "" ? N("Package not installed") : chomp_(`rpm -qf '$which_app' 2>&1`); - $packages{$executable} = $rpm_package; - } - $rpm_package; -} - -sub parse_release() { - my ($rel) = mandrake_release() =~ /release\s(\S+\s\(.*\))/; - $rel; -} - -sub connect_bugzilla { - my ($url) = @_; - my $_w = $in->wait_message('', N("connecting to Bugzilla wizard ...")); - sleep(3); - exec $ENV{BROWSER},$url if exists $ENV{BROWSER}; - my @browser = qw(mozilla konqueror galeon); - foreach (@browser) { - if (-e "/usr/bin/$_") { log::explanations("Contacting $url with $_\n "); exec $_,$url } - } - $in->ask_warn('', N("No browser available! Please install one")); -} - -sub quit_global() { - ugtk2->exit(0); -} diff --git a/perl-install/standalone/drakbug_report b/perl-install/standalone/drakbug_report deleted file mode 100755 index ca947d4a3..000000000 --- a/perl-install/standalone/drakbug_report +++ /dev/null @@ -1,14 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use common; -use any; - -my %other = ( - 'rpm -qa' => join('', sort `rpm -qa`), - 'mandrake version' => mandrake_release(), - 'df' => join('', `df`), -); - -print any::report_bug('', %other); diff --git a/perl-install/standalone/drakconnect b/perl-install/standalone/drakconnect deleted file mode 100755 index f2bf3e368..000000000 --- a/perl-install/standalone/drakconnect +++ /dev/null @@ -1,646 +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 strict; -use diagnostics; -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use interactive; -use common; -use network::netconnect; -use network::ethernet; -use network::tools; -use network::modem; -use network; -use c; -use modules; -use network::isdn; -use network::adsl; -use MDK::Common::Globals "network", qw($in $prefix $disconnect_file $connect_prog $connect_file); - -my $xpm_path = "/usr/share/libDrakX/pixmaps"; -local $_ = join '', @ARGV; - -my ($netcnx, $netc, $intf) = ({}, {}, {}); -my @conx_type = ('modem', 'isdn_internal', 'isdn_external', 'adsl', 'cable', 'lan'); - -my $in = 'interactive'->vnew('su'); -!$::isEmbedded and $in->isa('interactive::gtk'); -$::Wizard_pix_up = "wiz_drakconnect.png"; -$::Wizard_title = "Network & Internet Configuration"; - -my $activate_profile = 0; #- deactivated by default (in order to keep code) - -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 ugtk2; -ugtk2->import(qw(:helpers :wrappers :create)); -my $expert_mode = 0; -network::netconnect::read_net_conf('', $netcnx, $netc); -modules::load_category('net'); -my @all_cards = network::ethernet::conf_network_card_backend($netc, $intf); -network::netconnect::load_conf($netcnx, $netc, $intf); -network::network::probe_netcnx_type('', $netc, $intf, $netcnx); - -my $window1 = ugtk2->new('drakconnect'); -$window1->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) }); -unless ($::isEmbedded) { - $window1->{rwindow}->set_position('center'); - $window1->{rwindow}->set_title(N("Network configuration (%d adapters)", @all_cards)); - $window1->{rwindow}->set_size_request(500, 400); -} -$window1->{rwindow}->set_border_width(10); - -my $combo1 = new Gtk2::Combo; -$combo1->set_popdown_strings(network::netconnect::get_profiles()); -my $old_profile = $netcnx->{PROFILE}; -$combo1->entry->set_text($netcnx->{PROFILE} || "default"); -$combo1->entry->set_editable(0); -my $button_del = new Gtk2::Button(N("Del profile...")); -$button_del->signal_connect(clicked => sub { - my $dialog = new_dialog(); - $dialog->vbox->pack_start(new Gtk2::Label(N("Profile to delete:")),1,1,0); - my $combo_dialog = new Gtk2::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 Gtk2::HButtonBox; - $dialog->action_area->add($bbox_dialog); - $bbox_dialog->set_layout('end'); - my $button_ok = new Gtk2::Button(N("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"; - Gtk2->main_quit(); - }); - $bbox_dialog->add($button_ok); - my $button_cancel = new Gtk2::Button(N("Cancel")); - $button_cancel->signal_connect(clicked => sub { Gtk2->main_quit() }); - $bbox_dialog->add($button_cancel); - $dialog->show_all; - $dialog->set_modal(1); - Gtk2->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(); - }); -$button_del->set_sensitive(network::netconnect::get_profiles() > 1); -my $button_new = new Gtk2::Button(N("New profile...")); -$button_new->signal_connect(clicked => sub { - my $dialog = new_dialog(); - $dialog->vbox->pack_start(new Gtk2::Label(N("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 Gtk2::Entry; - $dialog->vbox->pack_start($entry_dialog,1,1,0); - my $bbox_dialog = new Gtk2::HButtonBox; - $dialog->action_area->add($bbox_dialog); - $bbox_dialog->set_layout('end'); - my $button_ok = new Gtk2::Button(N("OK")); - $button_ok->signal_connect(clicked => sub { - network::netconnect::add_profile($netcnx, $entry_dialog->get_text()); - $netcnx->{PROFILE} = $entry_dialog->get_text(); - Gtk2->main_quit(); - }); - $bbox_dialog->add($button_ok); - my $button_cancel = new Gtk2::Button(N("Cancel")); - $button_cancel->signal_connect(clicked => sub { Gtk2->main_quit() }); - $bbox_dialog->add($button_cancel); - $dialog->show_all; - $dialog->set_modal(1); - Gtk2->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()); - }); - -my $hostname = chomp_(`hostname`); -my $type_label = new Gtk2::Label($netcnx->{type}); -my $int_label = new Gtk2::Label($netcnx->{type} eq 'lan' ? N("Gateway:") : N("Interface:")); -my $interface_name = new Gtk2::Label($netcnx->{type} eq 'lan' ? $netc->{GATEWAY} : $netcnx->{NET_INTERFACE}); -my $isconnected = -1; -my $warning_label1 = new Gtk2::Label(""); -my $int_connect = new Gtk2::Button(N("Wait please")); -$int_connect->set_sensitive(0); -$int_connect->signal_connect(clicked => sub { - if (!$isconnected) { - if (cat_($connect_prog) =~ m|/usr/bin/kppp| && -e '/usr/bin/kppp') { - run_program::rooted($prefix, "/usr/bin/kppp &"); - } else { - connect_backend(); - } - } else { - disconnect_backend(); - } - update2(); -}); - -my $button_internet = gtksignal_connect(Gtk2::Button->new(N("Configure Internet Access...")), - clicked => sub { configure_net('', $netcnx, $netc, $intf) }); - -my $tree_model = Gtk2::TreeStore->new(Gtk2::GType->OBJECT, map { Gtk2::GType->STRING } 2..6); -my $list = Gtk2::TreeView->new_with_model($tree_model); -$list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererPixbuf->new, 'pixbuf' => 0)); -each_index { $list->append_column(Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i + 1)) } (N("Interface"), N("IP address"), N("Protocol"), N("Driver"), N("State")); - -my $ip_regexp = qr/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/; - -build_list(); - -my $button_lan = gtksignal_connect(Gtk2::Button->new(N("Configure Local Area Network...")), - clicked => sub { configure_lan('', $netcnx, $netc, $intf) }); - -my ($bbox0, $label_host, $int_state); - -$window1->{window}->add( - gtkpack_(Gtk2::VBox->new(0,10), - if_($activate_profile, - 0, gtkpack_(Gtk2::HBox->new(0,0), - 0, new Gtk2::Label(N("Profile: ")), - 0, $combo1, - 0, $button_del, - 0, $button_new, - ), - ), - 0, gtkpack_(Gtk2::HBox->new(0,0), - 0, new Gtk2::Label(N("Hostname: ")), - 0, $label_host = new Gtk2::Label($hostname), - ), - 0, gtkadd(Gtk2::Frame->new(N("Internet access")), - gtkpack_(gtkset_border_width(Gtk2::VBox->new(0,0), 5), - 1, gtkset_border_width(create_packtable({ col_spacings => 5, row_spacings => 5 }, - [ new Gtk2::Label(N("Type:")), $type_label ], - [ $int_label, $interface_name ], - [ Gtk2::Label->new(N("Status:")), - $int_state = Gtk2::Label->new(N("Testing your connection...")), - $int_connect, ] # $button_internet ] - ), - 5), - 0, $warning_label1, - 0, gtkpack_(new Gtk2::HBox(0, 0), - 0, $button_internet), - ) - ), - 1, gtkadd(Gtk2::Frame->new(N("LAN configuration")), - gtkpack_(gtkset_border_width(Gtk2::VBox->new(0,0), 5), - 0, $list, - 0, new Gtk2::HBox(0,0), - 0, gtkpack_(new Gtk2::HBox(0, 0), - 0, $button_lan), - ) - ), - 0, gtkadd(gtkset_layout(Gtk2::HButtonBox->new, 'end'), - Gtk2::Label->new(N("Click here to launch the wizard ->")), - gtksignal_connect(Gtk2::Button->new(N("Wizard...")), - clicked => sub { - system("drakconnect"); - #- reload everything... - $netcnx = {}; $netc = {}; $intf = {}; - network::netconnect::read_net_conf('', $netcnx, $netc); - modules::load_category('net'); - @all_cards = network::ethernet::conf_network_card_backend($netc, $intf); - network::netconnect::load_conf($netcnx, $netc, $intf); - network::network::probe_netcnx_type('', $netc, $intf, $netcnx); - $combo1->entry->set_text(-e "/etc/sysconfig/network-scripts/drakconnect_conf." . ($combo1->entry->get_text || "default")); - update(); - }), - ), - 0, Gtk2::HSeparator->new, - 0, gtkset_layout($bbox0 = new Gtk2::HButtonBox, 'end') - ), - ); - -my $button_expert = new Gtk2::Button(N("Expert Mode")); -$button_expert->signal_connect(clicked => sub { - foreach ($button_internet, $button_lan) { $expert_mode ? $_->hide() : $_->show() } - $button_expert->child->set($expert_mode ? N("Expert Mode") : N("Normal Mode")); - $expert_mode = !$expert_mode; - }); -$bbox0->add($button_expert); - -my $button_apply = new Gtk2::Button(N("Apply")); -$button_apply->signal_connect(clicked => \&apply); -$button_apply->set_sensitive(0); -$bbox0->add($button_apply); - -my $button_cancel = new Gtk2::Button(N("Cancel")); -$button_cancel->signal_connect(clicked => sub { - $combo1->entry->set_text($old_profile); - update(); - quit_global(); - }); -$bbox0->add($button_cancel); -my $button_ok = new Gtk2::Button(N("OK")); -$button_ok->signal_connect(clicked => sub { - my $dialog = new_dialog(); - $dialog->vbox->pack_start(new Gtk2::Label(N("Please Wait... Applying the configuration")),1,1,20); - $dialog->show_all; - gtkflush(); - apply(); - $dialog->destroy; - update(); - quit_global(); - }); -$bbox0->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); - update(); - $button_apply->set_sensitive(1); - }); - -$window1->{rwindow}->show_all(); -$_->hide foreach $button_internet, $button_lan; -gtkflush(); -my $tag = Gtk2->timeout_add(4000, \&update2); -$window1->main; -ugtk2->exit(0); - -dd: -$::isWizard = 1; -network::netconnect::main('', $netcnx, $in); -$in->exit(0); - -sub build_list() { - foreach my $i (0..$#all_cards) { - my ($ip, $state); - if (-x "/sbin/ifconfig") { - local $_ = `LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C /sbin/ifconfig "eth$i"`; - /inet addr\:$ip_regexp/ or warn "Bad Ip\n"; - $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$i"}{IPADDR}; - $state = "n/a"; - } - $tree_model->append_set(undef, [ map_index { $::i => $_ } (gtkcreate_pixbuf("eth_card_mini2.png"), "eth$i", $ip , $intf->{"eth$i"}{BOOTPROTO}, $all_cards[$i][1], $state) ])->free; - } -} - -sub apply() { - $old_profile = $netcnx->{PROFILE} || "default"; - network::netconnect::save_conf($netcnx); - - $netcnx->{type} eq 'modem' and network::modem::ppp_configure($in, $netcnx->{$netcnx->{type}}); - $netcnx->{type} eq 'isdn_internal' and network::isdn::isdn_write_config_backend($netcnx->{$netcnx->{type}}, $netc, $netcnx); #$light - $netcnx->{type} eq 'isdn_external' and network::modem::ppp_configure($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); - $type_label->set($netcnx->{type}); - $int_label->set($netcnx->{type} eq 'lan' ? N("Gateway:") : N("Interface:")); - $interface_name->set($netcnx->{type} eq 'lan' ? $netc->{GATEWAY} : $netcnx->{NET_INTERFACE}); - $tree_model->clear; - build_list(); - $button_del->set_sensitive(network::netconnect::get_profiles() > 1); - return 1 if $isconnected == -1; - $int_state->set($isconnected ? N("Connected") : N("Not connected")); - $int_connect->child->set($isconnected ? N("Disconnect...") : N("Connect...")); - $int_connect->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(N("Warning, another Internet connection has been detected, maybe using your network")); - $isconnected = 0; - } else { $warning_label1->set("") } - $int_state->set($isconnected ? N("Connected") : N("Not connected")); - $int_connect->child->set($isconnected ? N("Disconnect...") : N("Connect...")); - $int_connect->set_sensitive(1); - } - } - update(); - 1; -} - -sub quit_global() { - ugtk2->exit(0); -} - -sub configure_lan { - my ($prefix, $netcnx, undef, $intf) = @_; - my $window = Gtk2::Window->new('toplevel'); - - my @card_tab; - - if (@all_cards < 1) { - my $dialog = new_dialog(); - $dialog->vbox->pack_start(new Gtk2::Label(N("You don't have any configured interface. -Configure them first by clicking on 'Configure'")),1,1,0); - $dialog->action_area->add(gtkadd(gtkset_layout(Gtk2::HButtonBox->new, 'end'), - gtksignal_connect(new Gtk2::Button(N("OK")), - clicked => sub { Gtk2->main_quit() }) - ) - ); - $dialog->show_all; - $dialog->set_modal(1); - Gtk2->main(); - $dialog->destroy; - return; - } - - $window->signal_connect(delete_event => sub { Gtk2->main_quit }); - $window->set_position('center'); - $window->set_title(N("LAN configuration")); - $window->set_border_width(10); - my $vbox0 = new Gtk2::VBox(0,0); - $window->add($vbox0); - $vbox0->pack_start(new Gtk2::Label(N("LAN Configuration")),0,1,0); - my $notebook = new Gtk2::Notebook; - $vbox0->pack_start($notebook,0,1,0); - foreach (0..$#all_cards) { - my @infos; - my @conf_data; - $card_tab[2*$_] = \@infos; - $card_tab[2*$_+1] = \@conf_data; - my $vbox_local = new Gtk2::VBox(0,0); - $vbox_local->set_border_width(10); - $vbox_local->pack_start(new Gtk2::Label(N("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 = ([N("IP address"), \$intf->{"eth$_"}{IPADDR}], - [N("Netmask"), \$intf->{"eth$_"}{NETMASK}], - [N("Boot Protocol"), \$intf->{"eth$_"}{BOOTPROTO}, ["static", "dhcp", "bootp"]], - [N("Started on boot"), \$intf->{"eth$_"}{ONBOOT} , ["yes", "no"]], - [N("DHCP client"), \$netcnx->{dhcp_client}] - ); - my $i = 0; - foreach my $j (@conf_data) { - $infos[2*$i] = new Gtk2::HBox(0,0); - my $l = new Gtk2::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 Gtk2::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 Gtk2::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 Gtk2::Button(ethisup($c) ? N("deactivate now") : N("activate now")), - clicked => sub { - system("/sbin/if" . (ethisup($c) ? "down" : "up") . " eth$c"); - ugtk2::gtkbuttonset($_[0], ethisup($c) ? N("deactivate now") : N("activate now")); - }); - } else { - $widget_temp = N("This interface has not been configured yet.\nLaunch the configuration wizard in the main window"); - } - $vbox_local->pack_start(gtkpack__(new Gtk2::HBox(0,0), - $widget_temp - ),0,0,0); - # $list->append($_+1, "eth$_", $intf->{"eth$_"}{IPADDR}, $intf->{"eth$_"}{BOOTPROTO}, $all_cards[$_]->[1]); - # $list->set_selectable($_, 0); - my $hbox_local = new Gtk2::HBox(0,0); - my $pix = gtkcreate_img("/usr/share/libDrakX/pixmaps/eth_card_mini.png"); - $hbox_local->pack_start($pix,0,0,0); - $hbox_local->pack_start(new Gtk2::Label("eth$_"),0,0,0); - $hbox_local->show_all; - $notebook->append_page($vbox_local, $hbox_local); - } - my $bbox8 = new Gtk2::HButtonBox; - $vbox0->pack_start($bbox8,0,0,10); - $bbox8->set_layout('end'); - my $button_ok = new Gtk2::Button(N("OK")); - $button_ok->signal_connect(clicked => sub { - foreach (0..$#all_cards) { - my @infos = @{$card_tab[2*$_]}; - each_index { - ${$_->[1]} = $infos[2*$::i+1]->get_text(); - } @{$card_tab[2*$_+1]}; - if ($intf->{"eth$_"}{BOOTPROTO} eq "dhcp") { - delete @{$intf->{"eth$_"}}{qw(IPADDR NETWORK NETMASK BROADCAST)}; - } - } - update(); - $button_apply->set_sensitive(1); - $window->destroy(); Gtk2->main_quit; - }); - $bbox8->add($button_ok); - - my $button_cancel = new Gtk2::Button(N("Cancel")); - $button_cancel->signal_connect(clicked => sub { $window->destroy(); Gtk2->main_quit }); - $bbox8->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'); - Gtk2->main; -} - - -sub configure_net { - my ($_prefix, $netcnx, $netc, $_intf) = @_; - if (!$netcnx->{type}) { - my $dialog = new_dialog(); - $dialog->vbox->pack_start(new Gtk2::Label(N("You don't have an Internet connection. -Create one first by clicking on 'Configure'")),1,1,0); - my $bbox_dialog = new Gtk2::HButtonBox; - $dialog->action_area->add($bbox_dialog); - $bbox_dialog->set_layout('end'); - my $button_ok = new Gtk2::Button(N("OK")); - $button_ok->signal_connect(clicked => sub { - Gtk2->main_quit(); - }); - $bbox_dialog->add($button_ok); - $dialog->show_all; - $dialog->set_modal(1); - Gtk2->main(); - $dialog->destroy; - return; - } - my $cnx = {}; - $cnx = $netcnx->{$netcnx->{type}}; - my $window = Gtk2::Window->new('toplevel'); - $window->signal_connect(delete_event => sub { Gtk2->main_quit }); - $window->set_position('center'); - $window->set_title(N("Internet connection configuration")); - $window->set_border_width(10); - my $table1 = new Gtk2::Table(2, 4, 0); - $table1->set_row_spacings(5); - $table1->set_col_spacings(5); - $table1->attach(new Gtk2::Label(N("Profile: ")), 0, 1, 0, 1, 'fill', 'fill',0,0); - $table1->attach(new Gtk2::Label(translate($netcnx->{PROFILE})), 1, 2, 0, 1, 'fill', 'fill',0,0); - $table1->attach(new Gtk2::Label(N("Connection type: ")), 0, 1, 1, 2, 'fill', 'fill',0,0); - $table1->attach(new Gtk2::Label(translate($netcnx->{type})), 1, 2, 1, 2, 'fill', 'fill',0,0); -# my $button_internet = new Gtk2::Button(N("Reconfigure using wizard...")); -# $table1->attach($button_internet, 2, 4, 0, 2, 'fill', 'fill',0,0); - - my $vbox2 = new Gtk2::VBox(0,0); - my $i = 0; - 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'; - - #- duplicated code (waiting for 9.1 to be out to merge everything correctly, avoid bug elsewhere). - if ($netcnx->{type} =~ /adsl/) { - require network::adsl; - network::adsl::adsl_probe_info($cnx, $netc, $intf); - } - my @conf_data = ([ N("Card IRQ"), \$cnx->{irq} ], - [ N("Card mem (DMA)"), \$cnx->{mem} ], - [ N("Card IO"), \$cnx->{io} ], - [ N("Card IO_0"), \$cnx->{io0} ], - [ N("Card IO_1"), \$cnx->{io1} ], - [ N("Your personal phone number"), \$cnx->{phone_in} ], - [ N("Provider name (ex provider.net)"), \$netc->{DOMAINNAME2} ], - [ N("Provider phone number"), \$cnx->{phone_out} ], - [ N("Provider dns 1 (optional)"), \$netc->{dnsServer2} ], - [ N("Provider dns 2 (optional)"), \$netc->{dnsServer3} ], - [ N("Account Login (user name)"), \$cnx->{login} ], - [ N("Account Password"), \$cnx->{passwd} ], - [ N("Dialing mode"), \$cnx->{dialing_mode}, [ "auto", "manual" ] ], - [ N("Gateway"), \$netc->{GATEWAY} ], - [ N("Connection name"), \$cnx->{connection} ], - [ N("Phone number"), \$cnx->{phone} ], - [ N("Login ID"), \$cnx->{login} ], - [ N("Password"), \$cnx->{passwd} ], - [ N("Authentication"), \$cnx->{auth}, [ N("PAP"), N("Terminal-based"), N("Script-based"), N_("CHAP") ] ], - [ N("Domain name"), \$cnx->{domain} ], - [ N("First DNS Server (optional)"), \$cnx->{dns1} ], - [ N("Second DNS Server (optional)"), \$cnx->{dns2} ], - [ N("Ethernet Card"), \$netc->{NET_DEVICE}, [ 'eth0', 'eth1', 'eth2', 'eth3', 'eth4', 'eth5', 'eth6', 'eth7', 'eth8', 'eth9' ] ], - [ N("DHCP Client"), \$netcnx->{dhcp_client}, ["dhcp-client", "dhcpcd", "dhcpxd"] ], - [ N("Connection speed"), \$cnx->{speed}, ["64 Kb/s", "128 Kb/s"] ], - [ N("Connection timeout (in sec)"), \$cnx->{huptimeout} ] -); - my @infos; - foreach (@conf_data) { - if (!$mask[$i]) { - $i++; - next; - } - $infos[2*$i] = new Gtk2::HBox(0,0); - my $l = new Gtk2::Label($_->[0]); - $l->set_justify('left'); - $infos[2*$i]->pack_start($l, 0, 0, 0); - $vbox2->pack_start($infos[2*$i], 0, 0, 0); - if (defined $_->[2]) { - my $c = new Gtk2::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 Gtk2::Entry(); - $infos[2*$i]->pack_start($infos[2*$i+1], 0, 0, 0); - #hide password if Entry Password - if ($_->[0] eq N("Account Password") || $_->[0] eq N("Password")) { $infos[2*$i+1]->set_visibility(0) }; - } - $infos[2*$i+1]->set_text(${$_->[1]}); - $i++; - } - - my $button_ok = new Gtk2::Button(N("OK")); - $button_ok->signal_connect(clicked => sub { - each_index { - ${$conf_data[$::i][1]} = $infos[2*$::i+1]->get_text() if $_; - } @mask; - update(); - $button_apply->set_sensitive(1); - $window->destroy(); Gtk2->main_quit; - }); - my $button_cancel = new Gtk2::Button(N("Cancel")); - $button_cancel->signal_connect(clicked => sub { $window->destroy(); Gtk2->main_quit }); - - $window->set_modal(1); - - gtkadd($window, - gtkpack__(new Gtk2::VBox(0, 0), - new Gtk2::Label(N("Internet Connection Configuration")), - new Gtk2::HSeparator, - $table1, - new Gtk2::HSeparator, - gtkadd(Gtk2::Frame->new(N("Parameters")), $vbox2), - new Gtk2::HSeparator, - gtkadd(gtkset_layout(Gtk2::HButtonBox->new, 'end'), - $button_ok, - $button_cancel, - ), - ), - ); - - $window->show_all(); - Gtk2->main; -} - -sub new_dialog() { - my $dialog = new Gtk2::Dialog(); - $dialog->set_position('center-on-parent'); - $dialog->vbox->set_border_width(10); - $dialog->signal_connect(delete_event => sub { Gtk2->main_quit() }); - $dialog; -} diff --git a/perl-install/standalone/drakedm b/perl-install/standalone/drakedm deleted file mode 100644 index f70c585d5..000000000 --- a/perl-install/standalone/drakedm +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/perl -# DrakxDM -- Display Manager chooser -# Copyright (C) 2003 MandrakeSoft (tvignaud@mandrakesoft.com) -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use strict; -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' -use common; -use interactive; - -my $in = 'interactive'->vnew('su'); - -my $cfg_file = '/etc/sysconfig/desktop'; - -my %dm = ('GNOME' => [ 'GDM (GNOME Display Manager)', '/usr/bin/gdm', 'gdm' ], - 'KDM' => [ 'KDM (KDE Display Manager)', '/usr/bin/kdm', 'kdebase-kdm' ], - 'KDE' => [ 'MdkKDM (Mandrake Display Manager)', '/usr/bin/mdkkdm', 'mdkkdm' ], - 'XDM' => [ 'XDM (X Display Manager)', '/usr/bin/X11/xdm', 'XFree86' ], - ); - -my $dm = 'KDE'; - -foreach (cat_($cfg_file)) { - $dm = uc($1) if /^DISPLAYMANAGER=(.*)$/; -} - -start: -if ($in->ask_from(N("Choosing a display manager"), - formatAlaTeX(N("X11 Display Manager allows you to graphically log -into your system with the X Window System running and supports running -several different X sessions on your local machine at the same time.")), - [ - { - list => [ sort keys %dm ], - val => \$dm, - type => 'list', - format => sub { $dm{$_[0]}[0] }, - sort => 1, - } - ] - ) - ) { - log::explanations("modified file $cfg_file"); - ! -x $dm{$dm}[1] and do { $in->do_pkgs->ensure_is_installed($dm{$dm}[2], $dm{$dm}[1]) or goto start }; - substInFile { - s/^(DISPLAYMANAGER)=.*(\n|)//; - s/^\n//g; - $_ .= "\nDISPLAYMANAGER=$dm\n" if eof; - } $cfg_file; -} - -$in->exit(0); diff --git a/perl-install/standalone/drakfirewall b/perl-install/standalone/drakfirewall deleted file mode 100755 index 233445ad2..000000000 --- a/perl-install/standalone/drakfirewall +++ /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::drakfirewall; - -my $in = 'interactive'->vnew('su'); - -network::drakfirewall::main($in); - -$in->exit; diff --git a/perl-install/standalone/drakfloppy b/perl-install/standalone/drakfloppy deleted file mode 100755 index c3a7575ef..000000000 --- a/perl-install/standalone/drakfloppy +++ /dev/null @@ -1,332 +0,0 @@ -#!/usr/bin/perl - -# DrakFloppy -# $Id$ -# -# Copyright (C) 2001-2003 MandrakeSoft -# Yves Duret -# Thierry Vignaud -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, -# MA 02111-1307, USA. - - -use strict; -use diagnostics; -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' -use common; -use ugtk2 qw(:helpers :create :wrappers); -use detect_devices; - -#- languages that can't be displayed with gtk1, so we unset translations -#- for them until this tool is ported to gtk2 -$ENV{LANGUAGE} = "C" if $ENV{LANGUAGE} =~ /\b(ar|he|hi|ta)/; - -require_root_capability(); - -my $expert_mode = $::expert; - -my $list_model = Gtk2::ListStore->new((Gtk2::GType->STRING) x 2); -my $list = Gtk2::TreeView->new_with_model($list_model); -each_index { - $list->append_column(my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i)); - $col->set_min_width((200, 50)[$::i]); - # $col->set_alignment(1.0) if $::i == 1; -} (N("Module name"), N("Size")); - -my $window = ugtk2->new('drakfloppy'); -unless ($::isEmbedded) { - $window->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) }); - $window->{rwindow}->set_title(N("drakfloppy")); - $window->{rwindow}->set_border_width(5); - - ### menus definition - # the menus are not shown but they provides shiny shortcut like C-q - create_factory_menu($window->{rwindow}, ( - { - path => N("/_File"), type => '<Branch>' }, - { - path => N("/File/_Quit"), accelerator => N("<control>Q"), callback => sub { ugtk2->exit(0) } }, - ) - ); -} - - -######## up part - -# device part -my $device_combo = new Gtk2::Combo(); -$device_combo->entry->set_editable(0); -$device_combo->set_popdown_strings(map { "/dev/" . $_->{device} } detect_devices::floppies()); - - -# kernel part -my $kernel_combo = new Gtk2::Combo(); -$kernel_combo->disable_activate(); -$kernel_combo->set_popdown_strings(sort grep { !/^\.\.?$/ } all("/lib/modules")); -$kernel_combo->entry->set_text(chomp_(`uname -r`)); -$kernel_combo->entry->signal_connect(changed => sub { - change_tree($kernel_combo->entry->get_text()); - $list_model->clear(); - }); - - -# Create root tree -my $tree_model = Gtk2::TreeStore->new((Gtk2::GType->STRING) x 2); -my $tree = Gtk2::TreeView->new_with_model($tree_model); -#$tree->get_selection->set_mode('browse'); -$tree->set_headers_visible(0); -$tree->append_column(my $textcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); -#$tree->append_column(my $dummy_textcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); -$tree->signal_connect('row-expanded', \&expand_tree); -$tree->get_selection()->signal_connect('changed' => \&selected_tree); - - -fill_tree($kernel_combo->entry->get_text()); - - -### -my ($output, @modules); - - -# Create list box -########################################################## from here my $list - - -### main window -$window->{window}->add( - gtkpack_(Gtk2::VBox->new, - if_($::isEmbedded, 0, new Gtk2::Label(N("boot disk creation"))), - 0, gtkadd(Gtk2::Frame->new(N("General")), - gtkpack__(new Gtk2::VBox(0, 0), - gtkpack__(new Gtk2::HBox(1, 0), - Gtk2::Label->new(N("device")), - $device_combo, - gtksignal_connect(Gtk2::Button->new(N("default")), - clicked => sub { $device_combo->entry->set_text("/dev/fd0") }), - ), - gtkpack__(new Gtk2::HBox(1, 0), - Gtk2::Label->new(N("kernel version")), - $kernel_combo, - gtksignal_connect(Gtk2::Button->new("default"), - clicked => sub { - $kernel_combo->entry->set_text(chomp_(`uname -r`)); - $list_model->clear(); - }), - ), - ), - ), - 1, gtkadd(my $expert_mod_frame = new Gtk2::Frame(N("Expert Area")), - gtkpack_(gtkset_border_width(Gtk2::VBox->new(0, 5), 5), - 0, gtkadd(Gtk2::Frame->new(N("mkinitrd optional arguments")), - gtkpack__(Gtk2::HBox->new(0, 5), - my $force_button = new Gtk2::ToggleButton(N("force")), - my $raid_button = new Gtk2::ToggleButton(N("omit raid modules")), - my $needed_button = new Gtk2::ToggleButton(N("if needed")), - my $scsi_button = new Gtk2::ToggleButton(N("omit scsi modules")), - ), - ), - 1, gtkadd(Gtk2::Frame->new(N("Add a module")), - create_hpaned( - gtkset_size_request( - create_scrolled_window($tree), - 200, $::isEmbedded ? 0 : 175), - gtkpack_(Gtk2::VBox->new(0, 0), - 1, gtkadd(Gtk2::ScrolledWindow->new, - $list - ), - 0, gtksignal_connect(Gtk2::Button->new(N("Remove a module")), - clicked => sub { - my $iter = ($list->get_selection->get_selected)[1]; - return unless $iter; - $list_model->remove($iter); - }), - ), - ), - ), - ), - ), - 1, gtkadd(Gtk2::Frame->new(N("Output")), - gtkpack_(gtkset_size_request( - gtkset_border_width( - Gtk2::HBox->new(0, 0), - 5), - 30, 75), - 1, $output = Gtk2::TextView->new, - ), - ), - 0, gtkpack__(new Gtk2::HBox(0, 0), - gtksignal_connect(Gtk2::Button->new(N("Cancel")), - clicked => sub { ugtk2->exit(0) } - ), - gtksignal_connect(Gtk2::Button->new(N("Build the disk")), - clicked => \&build_it - ), - gtksignal_connect(my $expert_button = Gtk2::Button->new(""), - clicked => sub { - $expert_mode = !$expert_mode; - toggle_expert_button(); - }), - ), - ), - ); - -$window->{rwindow}->show_all(); -toggle_expert_button(); - -$window->main; -ugtk2->exit(0); - - -sub toggle_expert_button() { - if ($expert_mode) { - $expert_mod_frame->show(); - $expert_button->child->set(N("Normal Mode")); - } else { - $expert_mod_frame->hide(); - $expert_button->child->set(N("Expert Mode")); - } -} - -#------------------------------------------------------------- -# tree functions -#------------------------------------------------------------- -### Subroutines - -sub fill_tree { - my ($root_dir) = @_; - $root_dir = "/lib/modules/" . $root_dir; - # Create root tree item widget - my $parent_iter = $tree_model->append_set(undef, [ 0 => $root_dir, 1 => $root_dir ]); - - # Create the subtree - expand_tree($tree, $parent_iter, $tree_model->get_path($parent_iter)) if has_sub_trees($root_dir); -} - -sub change_tree { - $tree_model->clear; - fill_tree(@_); -} - -# Called whenever an item is clicked on the tree widget. -sub selected_tree { - my ($select) = @_; - my ($model, $iter) = $select->get_selected(); - return unless $model; # no real selection - my $file = $model->get($iter, 1); - $iter->free; - - return if -d $file; - - my $size = (lstat($file))[7]; - - return if member($file, @modules); - push @modules, $file; - $file =~ s|/lib/modules/.*?/||g; - $list_model->append_set([ 0 => $file, 1 => $size ])->free; -} - - -# Callback for expanding a tree - find subdirectories, files and add them to tree -sub expand_tree { - my ($tree, $parent_iter, $path) = @_; - - my $dir = $tree_model->get($parent_iter, 1); - my $child = $tree_model->iter_children($parent_iter); - - #- hackish: if first child has '' as name, then we need to expand on the fly - if ($child && $tree_model->get($child, 0) eq '') { - $tree_model->remove($child); - } - unless ($child && $tree_model->iter_has_child($parent_iter)) { - foreach my $dir_entry (all($dir)) { - my $entry_path = $dir . "/" . $dir_entry; - if (-d $entry_path || $dir_entry =~ /\.o(\.gz)?$/) { - $entry_path =~ s|//|/|g; - - my $iter = $tree_model->append_set($parent_iter, [ 0 => $dir_entry, 1 => $entry_path ]); - #- hackery for partial displaying of trees, used in rpmdrake: - #- if leaf is void, we may create the parent and one child (to have the [+] in front of the parent in the ctree) - #- though we use '' as the label of the child; then rpmdrake will connect on tree_expand, and whenever - #- the first child has '' as the label, it will remove the child and add all the "right" children - $tree_model->append_set($iter, [ 0 => '' ])->free if has_sub_trees($entry_path); - } - } - } - $tree->expand_row($path, 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; - my $val; - $list_model->foreach(sub { - my ($model, $_path, $iter) = @_; - my $module = $model->get($iter, 0); - $module =~ s|.*?/||g; - $co .= " --mkinitrdargs --with=" . $y; #. "/usr/lib/" . $kernel_combo->entry->get_text() . "/" . $y; - return 0; - }, $val); - } - $co .= " " . $kernel_combo->entry->get_text(); - $co .= " 2>&1 |"; - create_dialog(N("Warning"), N("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(N("Error"), N("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; - } - - local *STATUS; - open STATUS, $co or do { create_dialog(N("Error"), N("Unable to fork: %s", $!), 0); return }; - local $_; - while (<STATUS>) { - gtktext_append($output, [ [ $_ ] ]); - } - close STATUS or create_dialog(N("Error"), N("Unable to properly close 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) = @_; - - foreach my $file (glob_("$dir/*")) { - return 1 if -d $file || $file =~ /\.o(\.gz)?$/; - } - - return 0; -} diff --git a/perl-install/standalone/drakfont b/perl-install/standalone/drakfont deleted file mode 100755 index 4efd6d815..000000000 --- a/perl-install/standalone/drakfont +++ /dev/null @@ -1,912 +0,0 @@ -#!/usr/bin/perl -# -# Copyright (C) 2001-2002 by MandrakeSoft -# DUPONT Sebastien -# Damien Chaumette <dchaumette@mandrakesoft.com> -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -# drakfont Future Overview -# - Fonts import: -# pfb ( Adobe Type 1 binary ) -# pfa ( Adobe Type 1 ASCII ) -# ttf ( True-Type ) -# pcf.gz -# Speedo -# and Bitmap (PCF, BDF, and SNF) -# - Features -# - Install fonts from any directory -# - Get windows fonts on any vfat partitions -# - Get fonts on any partitions. -# - UN-installation of any fonts (even if not installed through drakfont) -# - Support -# - Xfs -# - ghostscript & printer -# - Staroffice & printer -# - abiword -# - netscape -# - Koffice, Gnumeric, ... studying -# - all fonts supported by printer -# - anti-aliases by RENDER in Xfree86 .... -# supported by KDE. -# will be supported by gnome 1.2. -# Visual Interface: -# Window interface: -# - Fontselectiondialog widget -# - Command buttons under Fontselectiondialog (like the actual frontend). -# Commands buttons: -# - import from windows partition. -# import from all fat32 partitions and look for winnt/windows/font -# and import all (delete doubles) but don't import if they already exist. -# - import from directory -# look to see if each font exists and do not delete the original. -# (replace all, no, none) -# expert options: -# specify the directory, and look to see if it exists before -# if it exists ask: (replace all, no, none) -# - uninstall with list per font type -# Expert additional switch -# - option support: ghostscript, Staroffice, etc... -# check-button. (by default all check) -# - Printer Application Fonts Support... -# check-button. (by default all check) -# -# TODO: -# - 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 strict; -use diagnostics; - -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use ugtk2 qw(:helpers :wrappers :create); -use common; - -require_root_capability(); - -# 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 $model; -my $list; -my $list_all_font_path; -my $left_list; -my $right_list; -my $left_model; -my $right_model; - -foreach (@ARGV) { - /--list|-l/ and $list_all_font_path = 1, $mode = -1; - /--xls_fonts/ and $xlsfonts = 1, $mode = -1; - /--windows_import|-wi/ and $windows = 1, $mode = -1; - /--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/fonts/fonts.conf'; -my $drakfont_dir = '/usr/X11R6/lib/X11/fonts/drakfont'; -my $ttf2pt1 = '/usr/sbin/ttf2pt1'; -my $pfm2afm = '/usr/sbin/pfm2afm'; -my $type1inst = '/usr/sbin/type1inst'; -my $chkfontpath = '/usr/sbin/chkfontpath'; -# mkttfdir only knows about iso-8859-1, using ttmkfdir -u instead -- pablo -my $ttmkfdir = '/usr/sbin/ttmkfdir'; -my $fccache = '/usr/bin/fc-cache'; -my $ghostscript; - -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 - -sub list_fontpath() { - foreach (grep { /\d+:\s/ } `$chkfontpath -l`) { - chomp; - s/\d+:\s//gi; - s/:\w*$//gi; - push @installed_fonts_path, $_; - } -} - -sub chk_empty_xfs_path() { - foreach my $tmp_path (@installed_fonts_path) { - if (!(any { if_(!(/^fonts/ || /^type/), $_) } all($tmp_path))) { - system("chkfontpath -r $tmp_path ") - or print "PERL::system command failed during chkfontpath\n"; - } - } -} - -sub search_installed_fonts() { - list_fontpath(); - interactive_progress($pbar, 0.1, N("Search installed fonts")); - push @installed_fonts, all($_) foreach @installed_fonts_path; - interactive_progress($pbar, 0.1, N("Unselect fonts installed")); -} - -sub search_installed_fonts_full_path() { - list_fontpath(); - foreach my $i (@installed_fonts_path) { - foreach my $j (all($i)) { - push @installed_fonts_full_path, "$i/$j"; - } - } -} - -sub search_windows_font() { - foreach my $fstab_line (grep { /vfat|ntfs/ } cat_('/etc/mtab')) { - my $win_dir = (split('\s', $fstab_line))[1]; - my @list_fonts_win = all("$win_dir/windows/fonts"); - my @list_fonts_winnt = all("$win_dir/winnt/fonts"); - my $nb_dir = @list_fonts_win + @list_fonts_winnt; - foreach ([ \@list_fonts_win, "windows" ], - [ \@list_fonts_winnt, "winnt" ]) { - foreach my $i (@{ $_->[0] }) { - if ($interactive) { - if ($nb_dir) { - progress($pbar, 0.25 / $nb_dir, N("parse all fonts")); - } else { - display_error(N("no fonts found")); - return 0; - } - } - !$replace && any { /$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, N("done")); - } - if (!@font_list) { - print "[35mdrakfont:: could not find any font in /win*/fonts [0m\n"; - $interactive - and display_error( - N("could not find any font in your mounted partitions")); - return 0; - } - 1; -} - -sub is_a_font($) { - my ($file) = @_; - any { $file =~ /\Q.$_\E$/i } qw(ttf pfa pfb pcf pcf.gz pfm gsf); -} - -# Optimisation de cette etape indispensable -sub search_dir_font() { - foreach my $fn (@install) { - my @font_list_tmp; - my $dir; - if (!(-e $fn)) { print "$fn :: 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 && any { /$i/ } @installed_fonts and next; - grep { /$i/ } @font_list or push @font_list, "$fn/$i"; - } - } - } - } - elsif (is_a_font($fn)) { - !$replace && any { /$fn/ } @installed_fonts and next; - !grep { /$fn/ } @installed_fonts and push @font_list, $fn; - } - } - interactive_progress($pbar, 0.50 / @install, N("Reselect correct fonts")); - } - interactive_progress($pbar, 1, N("done")); - !@font_list && $interactive and display_error(N("could not find any font.\n")); -} - -sub search_dir_font_uninstall { - my ($fn) = @_; - my @font_list_tmp; - if (-d $fn) { - @font_list_tmp = map { if_(is_a_font($_), $_) } all($fn); - } else { - push @font_list_tmp, $fn if is_a_font($fn); - } - @font_list = uniq(@font_list, @installed_fonts_full_path); - print "Fonts to uninstal: " . $_ . "\n" foreach @font_list; -} - -sub search_dir_font_uninstall_gi() { - @font_list = @uninstall; - interactive_progress($pbar, 1, N("Search for fonts in installed list")); -} - -sub print_list() { - print "Font(s) to Install:\n\n"; - print "$_\n" foreach @font_list; -} - -sub dir_created() { - -e $drakfont_dir or mkdir_p($drakfont_dir); - -e $drakfont_dir . "/Type1" or mkdir_p($drakfont_dir . "/Type1"); - -e $drakfont_dir . "/ttf" or mkdir_p($drakfont_dir . "/ttf"); - -e $drakfont_dir . "/tmp" or mkdir_p($drakfont_dir . "/tmp"); - -e $drakfont_dir . "/tmp/ttf" or mkdir_p($drakfont_dir . "/tmp/ttf"); - -e $drakfont_dir . "/tmp/Type1" or mkdir_p($drakfont_dir . "/tmp/Type1"); - -e $drakfont_dir . "/tmp/tmp" or mkdir_p($drakfont_dir . "/tmp/tmp"); -} - - -sub convert_fonts { - my ($fonts, $converter, $font_type, $o_generate_pfb) = @_; - $o_generate_pfb = $o_generate_pfb ? "-b" : ""; - foreach my $fontname (@$fonts) { - system("cd $drakfont_dir/tmp/tmp && $converter $o_generate_pfb $fontname"); - interactive_progress($pbar2, 0.50 / @$fontname, N("%s fonts conversion", $font_type)); - } -} - -sub convert_ttf_fonts { - my ($fonts, $o_generate_pfb) = @_; - convert_fonts($fonts, $o_generate_pfb, "TTF", $ttf2pt1); -} - - - -sub put_font_dir() { - -e "/usr/share/ghostscript" or do { $gs = 0; print "ghostscript is not installed on your system...\n" }; - if (@font_list) { - dir_created(); - foreach my $i (@font_list) { - cp_af($i, $drakfont_dir . "/tmp/tmp"); - interactive_progress($pbar1, 1 / @font_list, N("Fonts copy")); - } - interactive_progress($pbar1, 0.01, N("done")); - interactive_progress($pbar2, 0.10, N("True Type fonts installation")); - 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_progress($pbar2, 0.20, N("please wait during ttmkfdir...")); - - my $ttfdir = $drakfont_dir . "/ttf"; - system("cd $ttfdir && $fccache && $ttmkfdir -u > fonts.dir"); - interactive_progress($pbar2, 0.10, N("True Type install done")); - my $update_chkfontpath = "$chkfontpath -a $drakfont_dir/ttf"; - - if ($so && $gs) { - my @glob_drak = glob("$drakfont_dir/tmp/tmp/*.ttf"); - convert_ttf_fonts(\@glob_drak, 1); - system("cd $drakfont_dir/tmp/tmp && mv *.gsf *.pfb *.pfm *.afm ../Type1"); - system("cd $drakfont_dir/tmp/Type1 && $type1inst"); - interactive_progress($pbar2, 0.10, N("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 "); - my $type1dir = $drakfont_dir . "/Type1"; - system("cd $type1dir && $fccache && $type1inst"); - interactive_progress($pbar2, 0.05, N("Ghostscript referencing")); - $update_chkfontpath .= "; $chkfontpath -a $drakfont_dir/Type1"; - } - - if (!$so && $gs) { - convert_ttf_fonts([ glob("$/drakfont_dir/tmp/tmp/*.ttf") ], 1); - system("cd $drakfont_dir/tmp/tmp && mv *.gsf *.pfb *.pfm ../Type1"); - system("cd $drakfont_dir/tmp/Type1 && $type1inst"); - interactive_progress($pbar2, 0.1, N("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 "); - my $type1dir = $drakfont_dir . "/Type1"; - system("cd $type1dir && $fccache && $type1inst"); - interactive_progress($pbar2, 0.05, N("Ghostscript referencing")); - $update_chkfontpath .= "; $chkfontpath -a $drakfont_dir/Type1"; - } - - if ($so && !$gs) { - convert_ttf_fonts([ glob("$drakfont_dir/tmp/tmp/*.ttf") ]); - convert_fonts([ glob("$drakfont_dir/tmp/tmp/*.pfm") ], $pfm2afm, "PFM"); - system("cd $drakfont_dir/tmp/tmp && mv *.afm ../Type1"); - system("cd $drakfont_dir/tmp/Type1 && mv *.afm ../../Type1 "); - my $type1dir = $drakfont_dir . "/Type1"; - system("cd $type1dir && $fccache && $type1inst"); - interactive_progress($pbar2, 0.14, N("type1inst building")); - $update_chkfontpath .= "; $chkfontpath -a $drakfont_dir/Type1"; - } - - interactive_progress($pbar2, 1, N("done")); - interactive_progress($pbar3, 0.25, N("Suppress Temporary Files")); - rm_rf("$drakfont_dir/tmp/"); - print "\n\nretarting xfs......\n"; - interactive_progress($pbar3, 0.5, N("Restart XFS")); - system($update_chkfontpath); - system('/etc/rc.d/init.d/xfs restart'); - system('xset fp rehash'); - interactive_progress($pbar3, 0.30, N("done")); - } -} - -sub remove_gs_fonts() { - my @Fontmap_new; - - if (all("$drakfont_dir/remove")) { - system(" cd $drakfont_dir/remove && $type1inst"); - my @Fontmap_out = cat_("$drakfont_dir/remove/Fontmap"); - my $FontmapGS = `rpm -ql ghostscript | grep Fontmap.GS`; - chomp($FontmapGS); - my @FontmapGS_list = cat_($FontmapGS); - foreach my $font_gs (@FontmapGS_list) { - my @tmp_list = split(' ', $font_gs); - 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" or mkdir_p($drakfont_dir . "/remove"); - interactive_progress($pbar, 1, N("done")); - - foreach my $i (@font_list) { - local $_ = $i; - if (/.pfb$/ || /.gsf$/ || /.pfm$/ || /.pfa$/) { - system("mv $_ $drakfont_dir/remove "); - } else { - if (/.ttf$/) { - rm_rf($_); - # rebuild of the fonts.dir and fc-cache files - system("cd `dirname $_` && $fccache && $ttmkfdir -u > fonts.dir"); - } else { rm_rf($i) } - } - $i =~ s!/\w*\.\w*!!gi; - grep { $i } @list_dir or push @list_dir, $i; - interactive_progress($pbar1, 1 / @font_list, N("Suppress Fonts Files")); - } - interactive_progress($pbar1, 0.01, N("done")); - -e "/usr/share/ghostscript" and remove_gs_fonts(); - foreach my $i (@list_dir) { - if (listlength all($i) < 3) { - system("chkfontpath -r $i") or print "PERL::system command failed during chkfontpath\n"; - } else { - system("cd $i && type1inst") or print "PERL::system command failed during cd or type1inst\n"; - } - interactive_progress($pbar2, 1 / @list_dir, N("Suppress Fonts Files")); - } - interactive_progress($pbar2, 0.01, N("xfs restart")); - system("/etc/rc.d/init.d/xfs restart"); - system('xset fp rehash'); - -e "/usr/share/ghostscript" and rm_rf("$drakfont_dir/remove"); - interactive_progress($pbar2, 0.01, N("done")); -} - -sub license_msg() { - print N("Before installing any fonts, be sure that you have the right to use and install them on your system.\n\n-You can install the fonts the normal way. In rare cases, bogus fonts may hang up your X Server.") . "\n"; -} - -sub backend_mod() { - $xlsfonts and system("xlsfonts"); - $list_all_font_path and system($chkfontpath); - - if ($windows) { - license_msg(); - print "\nWindows fonts Installation........\n"; - search_installed_fonts(); - if (search_windows_font()) { - print_list(); - put_font_dir(); - } - print "\nThe End...........................\n"; - } - - if (@install) { - license_msg(); - print "\nInstall Specifics Fonts...........\n"; - search_installed_fonts(); - search_dir_font(); - print "Font to install: " . $_ . "\n" foreach @font_list; - put_font_dir(); - print "\nThe End...........................\n"; - } - - if (@uninstall) { - print "\nUninstall Specifics Fonts.........\n"; - search_installed_fonts_full_path(); - if ($interactive) { search_dir_font_uninstall_gi() } - else { search_dir_font_uninstall() foreach @uninstall } - remove_fonts(); - print "\nThe End............................\n"; - } -} - -sub create_fontsel() { - my $font_sel; - gtkpack($font_box, $font_sel = new Gtk2::FontSelection,); - $central_widget = \$font_sel; -} - -sub display_error { - my ($message) = @_; - my $error_box; - $$central_widget->destroy(); - gtkpack($font_box, - $error_box = gtkpack_(new Gtk2::VBox(0, 0), 1, - new Gtk2::Label($message), 0, - gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("OK")), - clicked => sub { $$central_widget->destroy(); create_fontsel() } - ), - ), - ) - ); - $central_widget = \$error_box; -} - -sub interactive_mode() { - my $font_sel; - $interactive = 1; - my $window1 = ugtk2->new('drakfont'); - $window1->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) }); - unless ($::isEmbedded) { - $window1->{rwindow}->set_position('center'); - $window1->{rwindow}->set_title(N("Import Fonts")); - } - my ($adv_opt_button, $font_button); - gtkadd($window1->{window}, - gtkpack_(new Gtk2::VBox(0, 2), if_(!$::isEmbedded, 0, gtkcreate_img("drakfont.620x57")), 1, - gtkpack_(new Gtk2::HBox(0, 2), 1, - gtkpack_(new Gtk2::VBox(0, 2), 1, - gtkpack($font_box = new Gtk2::VBox(0, 5), $font_sel = new Gtk2::FontSelection,), 1, - gtkpack_(new Gtk2::HBox(0, 2), 0, - gtkadd(gtkset_layout(new Gtk2::VButtonBox, 'end'), - gtksignal_connect(new Gtk2::Button(N("Get Windows Fonts")), - clicked => sub { - $$central_widget->destroy(); - $windows = 1; - appli_choice(); - }), - gtksignal_connect(new Gtk2::Button(N("Uninstall Fonts")), - clicked => sub { - $$central_widget->destroy(); - uninstall(); - }), - ), 0, - gtkadd(gtkset_layout(new Gtk2::VButtonBox, 'end'), - gtksignal_connect($adv_opt_button = new Gtk2::Button(N("Advanced Options")), - clicked => sub { - $font_button->set_sensitive(1); - $adv_opt_button->set_sensitive(0); - $$central_widget->destroy(); - $windows = 0; - advanced_install(); - }), - gtksignal_connect($font_button = new Gtk2::Button(N("Font List")), - clicked => sub { - $font_button->set_sensitive(0); - $adv_opt_button->set_sensitive(1); - $$central_widget->destroy(); - create_fontsel(); - }), - ), 1, - new Gtk2::HBox(0, 2), 0, - gtkadd(gtkset_layout(new Gtk2::VButtonBox, 'end'), - gtksignal_connect(new Gtk2::Button(N("About")), clicked => \&help), - gtksignal_connect(new Gtk2::Button(N("Close")), clicked => sub { Gtk2->main_quit() }), - ), - ), - ), - ), - ), - ); - $central_widget = \$font_sel; - $font_button->set_sensitive(0); - $window1->{rwindow}->show_all; - $window1->{rwindow}->realize; - $window1->main; - ugtk2->exit(0); -} - -$list_all_font_path || $xlsfonts || $windows || @install || @uninstall ? backend_mod() : interactive_mode(); - -sub text_view { - my ($text) = @_; - my $box; - gtkpack($font_box, - $box = gtkpack_(new Gtk2::VBox(0,10), 1, - gtkpack_(new Gtk2::HBox(0,0), 1, - create_scrolled_window(gtktext_insert(new Gtk2::TextView, [ [ $text ] ])) - ), 0, - gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("OK")), - clicked => sub { $$central_widget->destroy() }), - ), - ) - ); - $central_widget = \$box; - $font_box->show_all(); -} - -sub help() { - ugtk2::create_dialog(N("Help"), N(" - Copyright (C) 2001-2002 by MandrakeSoft - DUPONT Sebastien (original version) - CHAUMETTE Damien <dchaumette\@mandrakesoft.com> - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - - Thanks: - - pfm2afm: - by Ken Borgendale: - Convert a Windows .pfm file to a .afm (Adobe Font Metrics) - - type1inst: - by James Macnicol: - type1inst generates files fonts.dir fonts.scale & Fontmap. - - ttf2pt1: - by Andrew Weeks, Frank Siegert, Thomas Henlich, Sergey Babkin - Convert ttf font files to afm and pfb fonts -")); -} - -sub appli_choice() { - my $choice_box; - my $text = new Gtk2::TextView; - gtkpack($font_box, - $choice_box = gtkpack_(new Gtk2::HBox(0, 10), 0, - new Gtk2::VBox(0, 10), 0, - new Gtk2::VBox(0, 10), 1, - gtkpack_(new Gtk2::VBox(0, 10), 1, - gtkpack_(new Gtk2::VBox(0, 10), 1, - gtkpack(new Gtk2::HBox(0, 10), - new Gtk2::HBox(0, 10), - N("Choose the applications that will support the fonts:"), - new Gtk2::HBox(0, 10), - ), 0, - new Gtk2::HBox(0, 10), 0, - gtkpack_(new Gtk2::HBox(0, 10), 0, - N("Ghostscript"), 1, - new Gtk2::HBox(0, 10), 0, - my $check11 = new Gtk2::CheckButton(), - ), 0, - gtkpack_(new Gtk2::HBox(0, 10), 0, - N("StarOffice"), 1, - new Gtk2::HBox(0, 10), 0, - my $check22 = new Gtk2::CheckButton(), - ), 0, - gtkpack_(new Gtk2::HBox(0, 10), 0, - N("Abiword"), 1, - new Gtk2::HBox(0, 10), 0, - my $check33 = new Gtk2::CheckButton(), - ), 0, - gtkpack_(new Gtk2::HBox(0, 10), 0, - N("Generic Printers"), 1, - new Gtk2::HBox(0, 10), 0, - my $check44 = new Gtk2::CheckButton(), - ), - ), 0, - gtkpack_(new Gtk2::HBox(0, 10), 1, - gtktext_insert(gtkset_editable($text, 0), - [ [ N("Before installing any fonts, be sure that you have the right to use and install them on your system.\n\n-You can install the fonts the normal way. In rare cases, bogus fonts may hang up your X Server.") ] ] - ), 0, - new Gtk2::VBox(0, 10), - ), 0, - gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("OK")), - clicked => sub { - $$central_widget->destroy(); - import_status(); - }), - gtksignal_connect(new Gtk2::Button(N("Cancel")), - clicked => sub { - @install = (); - $$central_widget->destroy(); - create_fontsel(); - }), - ), - ), 0, - new Gtk2::VBox(0, 10), 0, - new Gtk2::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(); -} - -my $select_font_msg; - -sub font_choice() { - my $file_dialog; - $select_font_msg = N("Select the font file or directory and click on 'Add'"); - $file_dialog = gtksignal_connect(new Gtk2::FileSelection(N("File Selection")), destroy => sub { $file_dialog->destroy() }); - $file_dialog->ok_button->signal_connect(clicked => \&file_ok_sel, $file_dialog); - $file_dialog->ok_button->set_label(N("Add")); - $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy() }); - $file_dialog->cancel_button->set_label(N("Close")); - $file_dialog->set_filename($select_font_msg); - $file_dialog->show(); -} - -sub file_ok_sel { - my ($_widget, $file_selection) = @_; - my $file_name = $file_selection->get_filename(); - if ($file_name =~ /$select_font_msg/) { - create_dialog(N("Error"), N("You've not selected any font")); - } else { - print "-- @install\n"; - if (!member($file_name, @install)) { - push @install, $file_name; - $model->append_set(undef, [ 0 => $file_name ]); - } - } -} - -sub list_remove() { #- TODO : multi-selection - my ($treeStore, $iter) = $list->get_selection->get_selected; - my $to_remove = $treeStore->get($iter, 0); - my ($index) = map_index { if_($_ eq $to_remove, $::i) } @install; - splice @install, $index, 1; - $treeStore->remove($iter); -} - -sub advanced_install() { - my $adv_box; - $model = Gtk2::TreeStore->new(Gtk2::GType->STRING); - $list = Gtk2::TreeView->new_with_model($model); - $list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $list->set_headers_visible(0); - $list->get_selection->set_mode('browse'); - $list->set_rules_hint(1); - - gtkpack($font_box, - $adv_box = gtkpack_(new Gtk2::VBox(0, 10), 1, - gtkpack_(new Gtk2::HBox(0, 4), 1, create_scrolled_window($list),), 0, - gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("Add")), clicked => sub { font_choice() }), - gtksignal_connect(new Gtk2::Button(N("Remove Selected")), clicked => \&list_remove), - gtksignal_connect(new Gtk2::Button(N("Install List")), - clicked => sub { - if (@install) { - $$central_widget->destroy(); - appli_choice(); - } - }) - ) - ) - ); - $central_widget = \$adv_box; - $adv_box->show_all(); -} - -sub list_to_remove() { - #my @files_path = grep(!/fonts/, all($current_path)); garbage ? - gtkflush(); - my ($tree, @tux) = $left_list->get_selection->get_selected_rows(); #- get tree & paths - push @uninstall, map { $tree->get($tree->get_iter($_), 0) } @tux; - #push @uninstall, $current_path . "/" . $files_path[$_] foreach @number_to_remove; garbage ? - $$central_widget->destroy(); - show_list_to_remove(); -} - -sub show_list_to_remove() { - my $show_box; - my $model = Gtk2::TreeStore->new(Gtk2::GType->STRING); - my $list = Gtk2::TreeView->new_with_model($model); - $list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $list->set_headers_visible(0); - $list->get_selection->set_mode('browse'); - $list->set_rules_hint(1); - - $model->append_set(undef, [ 0 => $_ ]) foreach @uninstall; - - gtkpack($font_box, - $show_box = gtkpack_(new Gtk2::VBox(0, 10), 1, - gtkpack_(new Gtk2::HBox(0, 4), 1, create_scrolled_window($list)), 0, - gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("click here if you are sure.")), - clicked => sub { - $$central_widget->destroy(); - import_status_uninstall(); - }), - gtksignal_connect(new Gtk2::Button(N("here if no.")), - clicked => - sub { $$central_widget->destroy(); create_fontsel() } - ), - ), - ) - ); - $central_widget = \$show_box; - $show_box->show_all(); -} - -sub uninstall() { #- TODO : add item to right list with gtksignal_connect - my $uninst_box; - @install = (); - @installed_fonts_path = (); - list_fontpath(); - chk_empty_xfs_path(); - - #- left part - $left_model = Gtk2::TreeStore->new(Gtk2::GType->STRING); - $left_list = Gtk2::TreeView->new_with_model($left_model); - $left_list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $left_list->set_headers_visible(0); - $left_list->set_rules_hint(1); - $left_list->get_selection->set_mode('multiple'); - - $left_model->append_set(undef, [ 0 => $_ ]) foreach @installed_fonts_path; - - #- right part - $right_model = Gtk2::TreeStore->new(Gtk2::GType->STRING);; - $right_list = Gtk2::TreeView->new_with_model($right_model); - $right_list->append_column(Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 0)); - $right_list->set_headers_visible(0); - $right_list->get_selection->set_mode('multiple'); - $right_list->set_rules_hint(1); - - gtkpack($font_box, - $uninst_box = gtkpack_(new Gtk2::VBox(0, 10), 1, - gtkpack_(new Gtk2::HBox(0, 4), 1, - create_scrolled_window($left_list), #1, - #create_scrolled_window($right_list) - ), 0, - gtkadd(gtkset_layout(new Gtk2::HButtonBox, 'spread'), - gtksignal_connect(new Gtk2::Button(N("Unselected All")), - clicked => sub { $left_list->get_selection->unselect_all() } - ), - gtksignal_connect(new Gtk2::Button(N("Selected All")), - clicked => sub { $left_list->get_selection->select_all() } - ), - gtksignal_connect(new Gtk2::Button(N("Remove List")), clicked => sub { list_to_remove() }), - ), - ) - ); - $central_widget = \$uninst_box; - $uninst_box->show_all(); -} - -sub import_status() { - my $table; - $pbar = new Gtk2::ProgressBar; - $pbar1 = new Gtk2::ProgressBar; - $pbar2 = new Gtk2::ProgressBar; - $pbar3 = new Gtk2::ProgressBar; - gtkpack( - $font_box, - $table = create_packtable({ col_spacings => 10, row_spacings => 50 }, - [ "", "" ], - [ N("Initial tests"), $pbar, $pbar->set_text(' ') ], - [ N("Copy fonts on your system"), $pbar1, $pbar1->set_text(' ') ], - [ N("Install & convert Fonts"), $pbar2, $pbar2->set_text(' ') ], - [ N("Post Install"), $pbar3, $pbar3->set_text(' ') ], - ), - ); - $central_widget = \$table; - $font_box->show_all(); - gtkflush(); - backend_mod(); -} - -sub import_status_uninstall() { - my $table; - $pbar = new Gtk2::ProgressBar; - $pbar1 = new Gtk2::ProgressBar; - $pbar2 = new Gtk2::ProgressBar; - gtkpack( - $font_box, - $table = create_packtable({ col_spacings => 10, row_spacings => 50 }, - [ "", "" ], - [ "", "" ], - [ N("Initial tests"), $pbar, $pbar->set_text(' ') ], - [ N("Remove fonts on your system"), $pbar1, $pbar1->set_text(' ') ], - [ N("Post Uninstall"), $pbar2, $pbar2->set_text(' ') ], - ), - ); - $central_widget = \$table; - $font_box->show_all(); - gtkflush(); - backend_mod(); -} - -sub progress { - my ($progressbar, $incr, $label_text) = @_; - $progressbar->set_fraction(min(1, $progressbar->get_fraction + $incr)); - $progressbar->set_text($label_text); - gtkflush(); -} - -sub interactive_progress { - $interactive and progress(@_); -} diff --git a/perl-install/standalone/drakgw b/perl-install/standalone/drakgw deleted file mode 100755 index 881cb279b..000000000 --- a/perl-install/standalone/drakgw +++ /dev/null @@ -1,575 +0,0 @@ -#!/usr/bin/perl - -# -# author Guillaume Cottenceau (gc@mandrakesoft.com) -# modified by Florin Grad (florin@mandrakesoft.com) -# -# Copyright 2000-2003 MandrakeSoft -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2, as -# published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# - -use strict; -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use common; -use detect_devices; -use interactive; -use network; -use log; -use c; -use network::netconnect; -use network::shorewall; - -$::isInstall and die "Not supported during install.\n"; - - -local $_ = join '', @ARGV; - -$::Wizard_pix_up = "wiz_drakgw.png"; -$::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 $masq_file = "/etc/shorewall/masq"; -my $dhcpd_conf = "/etc/dhcpd.conf"; -my $cups_conf = "/etc/cups/cupsd.conf"; - -my $shorewall = network::shorewall::read(); - -my $in = 'interactive'->vnew('su'); -$::Wizard_title = N("Internet Connection Sharing"); - -!$::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 { - log::explanations("modified file $_[0]"); - my $f = shift; local *F; open F, ">>$f" or die "outpend in file $f failed: $!\n"; print F foreach @_; -} - -sub start_daemons () { - my $cups_used = 0; - log::explanations("Starting daemons"); - if (-f "/etc/rc.d/init.d/cups") { - if (system("/etc/rc.d/init.d/cups status >/dev/null") == 0) { - $cups_used = 1; - sys("/etc/rc.d/init.d/cups stop"); - } - } - system("/etc/rc.d/init.d/dhcpd status >/dev/null") == 0 and sys("/etc/rc.d/init.d/dhcpd stop"); - system("/etc/rc.d/init.d/named status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/named stop"); - - my $netscripts = '/etc/sysconfig/network-scripts'; - sys("$netscripts/net_cnx_down >/dev/null"); - sys("/etc/rc.d/init.d/network restart >/dev/null"); - sys("$netscripts/net_cnx_up >/dev/null"); - - sys("/etc/init.d/shorewall restart >/dev/null"); - - sys("/etc/rc.d/init.d/$_ start >/dev/null"), sys("/sbin/chkconfig --level 345 $_ on") foreach 'named', 'dhcpd', 'shorewall'; - sys("/etc/rc.d/init.d/cups start >/dev/null") if $cups_used; -} - -sub stop_daemons () { - log::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 >/dev/null"); - sys("/sbin/chkconfig --level 345 $_ off") foreach 'named', 'dhcpd'; -} - -my $wait_configuring; - -sub fatal_quit ($) { - log::l("[drakgw] FATAL: $_[0]"); - undef $wait_configuring; - $in->ask_warn('', $_[0]); - quit_global($in, -1); -} - -my ($kernel_version) = c::kernel_version() =~ /(...)/; -log::l("[drakgw] kernel_version $kernel_version"); - -$kernel_version >= 2.4 or fatal_quit(N("Sorry, we support only 2.4 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_(N("Internet Connection Sharing currently enabled"), -N("The setup of Internet Connection Sharing has already been done. -It's currently enabled. - -What would you like to do?"), - [ N_("disable"), N_("reconfigure"), N_("dismiss") ]) or quit_global($in, 0); - if ($r eq "disable") { - { - my $_wait_disabl = $in->wait_message('', N("Disabling servers...")); - stop_daemons(); - } - foreach ($dhcpd_conf, $masq_file) { - rename($_, "$_.drakgwdisable") or die "Could not rename $_ to $_.drakgwdisable" - } - sys("/etc/init.d/shorewall restart >/dev/null"); - log::l("[drakgw] Disabled"); - $::Wizard_finished = 1; - $in->ask_okcancel('', N("Internet Connection Sharing is now disabled.")); - quit_global($in, 0); - } - if ($r eq "dismiss") { - quit_global($in, 0); - } - } else { - my $r = $in->ask_from_list_(N("Internet Connection Sharing currently disabled"), -N("The setup of Internet connection sharing has already been done. -It's currently disabled. - -What would you like to do?"), - [ N_("enable"), N_("reconfigure"), N_("dismiss") ]); - if ($r eq "enable") { - foreach ($dhcpd_conf, $masq_file) { - rename($_, "$_.old") if -f $_; - rename("$_.drakgwdisable", $_) or die "Could not find configuration. Please reconfigure."; - } - { - my $_wait_enabl = $in->wait_message('', N("Enabling servers...")); - start_daemons(); - } - log::l("[drakgw] Enabled"); - $::Wizard_finished = 1; - $in->ask_okcancel('', N("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(N("Internet Connection Sharing"), -N("You are about to configure your computer to share its Internet connection. -With that feature, other computers on your local network will be able to use this computer's Internet connection. - -Make sure you have configured your Network/Internet access using drakconnect before going any further. - -Note: you need a dedicated Network Adapter to set up a Local Area Network (LAN)."), 1) or 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() || "eth0"; -defined $card_netconnect and log::l("[drakgw] Information from netconnect: ignore card $card_netconnect"); - - $in->ask_from('', - N("Please enter the name of the interface connected to the internet. - -Examples: - ppp+ for modem or DSL connections, - eth0, or eth1 for cable connection, - ippp+ for a isdn connection. -", $card_netconnect), - [ { label => N("Net Device"), val => \$card_netconnect, type => 'entry' } ]) - or goto step_warning_already_conf; - -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]} ? - N("Interface %s (using module %s)", $_[0], $aliased_devices{$_[0]}) : - N("Interface %s", $_[0]); -}; - -#- setup the network interface we shall use - -my $device; -if (!@cards) -{ - $in->ask_warn(N("No network adapter on your system!"), - N("No ethernet network adapter has been detected on your system. Please run the hardware configuration tool.")); - quit_global($in, 0); -} -elsif (@cards == 1) -{ - $device = $cards[0]; - $in->ask_okcancel(N("Network interface"), -N("There is only one configured network adapter on your system: - -%s - -I am about to setup your Local Area Network with that adapter.", $format->($device)), 1) or goto step_ask_confirm; -} else { - $device = $in->ask_from_listf(N("Choose the network interface"), - N("Please choose what network adapter will be connected to your Local Area Network."), - $format, - \@cards, - ) or goto step_ask_confirm; - defined $device or quit_global($in, 0); -} -log::explanations("Choosing network device: $device"); - -my $server_ip = network::network::read_dhcpd_conf()->{option_routers}[0] ||= "192.168.1.1"; -my $lan_address = $server_ip =~ m/(.*)\.(.*)/ && $1 ? "$1.0" : "192.168.1.0"; -my $nameserver_ip = network::network::read_dhcpd_conf()->{domain_name_servers}[0] ||= "192.168.1.1"; -my $netmask = network::network::read_dhcpd_conf()->{subnet_mask}[0] ||= "255.255.255.0"; -my $start_range = network::network::read_dhcpd_conf()->{dynamic_bootp}[0] ||= "16"; -my $end_range = network::network::read_dhcpd_conf()->{dynamic_bootp}[1] ||= "253"; -my $default_lease = network::network::read_dhcpd_conf()->{max_lease_time}[0] ||= "21600"; -my $max_lease = network::network::read_dhcpd_conf()->{default_lease_time}[0] ||= "43200"; -my $internal_domain_name = network::network::read_dhcpd_conf()->{domain_name}[0] ||= network::network::read_resolv_conf_raw()->{search}[0] ||= "homeland.net"; - -my $reconf_dhcp_server_intf = 1; - -if (grep { /$device/ } @configured_devices) { - step_warning_already_conf: - my $auto = N("Yes"); - my $_dhcp_details = N("Yes"); - my $conf = network::read_interface_conf("/etc/sysconfig/network-scripts/ifcfg-$device"); - - $in->ask_from(N("Network interface already configured"), - N("Warning, the network adapter (%s) is already configured. - -Do you want an automatic re-configuration? - -You can do it manually but you need to know what you're doing.", $device), - [ { label => N("Automatic reconfiguration"), val => \$auto, list => [ N("Yes"), N("No (experts only)") ] }, - { val => N("Show current interface configuration"), clicked => - sub { $in->ask_warn(N("Current interface configuration"), - N("Current configuration of `%s': - -Network: %s -IP address: %s -IP attribution: %s -Driver: %s", $device, $conf->{NETWORK}, $conf->{IPADDR}, $conf->{BOOTPROTO}, $aliased_devices{$device} || '(unknown)')) } } ]) or goto step_detectsetup; - - if ($auto ne N("Yes")) { - $reconf_dhcp_server_intf = 0; - $server_ip = network::network::read_dhcpd_conf()->{option_routers}[0] ||= $conf->{IPADDR} ||= "192.168.1.1"; - $nameserver_ip = network::network::read_dhcpd_conf()->{domain_name_servers}[0] ||= $conf->{IPADDR} ||= "192.168.1.1"; - $lan_address = $server_ip =~ m/(.*)\.(.*)/ && $1 ? "$1.0" : $conf->{NETWORK}; - $in->ask_from('', - N("I can keep your current configuration and assume you already set up a DHCP server; in that case please verify I correctly read the Network that you use for your local network; I will not reconfigure it and I will not touch your DHCP server configuration. - -The default DNS entry is the Caching Nameserver configured on the firewall. You can replace that with your ISP DNS IP, for example. - -Otherwise, I can reconfigure your interface and (re)configure a DHCP server for you. - -", $device), - [ { label => N("Local Network adress"), val => \$lan_address, type => 'entry' }, - { label => N("Netmask"), val => \$netmask, type => 'entry' } ]) - or goto step_warning_already_conf; - $in->ask_from('', - N("DHCP Server Configuration. - -Here you can select different options for the DHCP server configuration. -If you don't know the meaning of an option, simply leave it as it is. - -", $device), - [ { label => N("(This) DHCP Server IP"), val => \$server_ip, type => 'entry' }, - { label => N("The DNS Server IP"), val => \$nameserver_ip, type => 'entry' }, - { label => N("The internal domain name"), val => \$internal_domain_name, type => 'entry' }, - { label => N("The DHCP start range"), val => \$start_range, type => 'entry' }, - { label => N("The DHCP end range"), val => \$end_range, type => 'entry' }, - { label => N("The default lease (in seconds)"), val => \$default_lease, type => 'entry' }, - { label => N("The maximum lease (in seconds)"), val => \$max_lease, type => 'entry' }, - { label => N("Re-configure interface and DHCP server"), val => \$reconf_dhcp_server_intf, type => 'bool' } ]) - or goto step_warning_already_conf; - } -} - -if (!($lan_address =~ s/\.0$//)) { - $in->ask_warn('', - N("The Local Network did not finish with `.0', bailing out.")); - quit_global($in, 0); -} -log::explanations("Using LAN address <$lan_address>"); - - -#- test for potential conflict with other networks - -foreach (grep { $_ ne $device } @configured_devices) { - grep { /$lan_address/ } cat_("/etc/sysconfig/network-scripts/ifcfg-$_") and - ($in->ask_warn('', N("Potential LAN address conflict found in current config of %s!\n", $_)) or goto step_detectsetup); -} - - -#- test for potential conflict with previous firewall config -network::shorewall::check_iptables($in) or goto step_detectsetup; - -#- ********************************** -#- * 2nd step: configure - -$wait_configuring = $in->wait_message(N("Configuring..."), - N("Configuring scripts, installing software, starting servers...")); - - -#- setup the /etc/sysconfig/network-script/ script - -if ($reconf_dhcp_server_intf) { - log::explanations("Reconfiguring network parameters of $device"); - my $network_scripts = "/etc/sysconfig/network-scripts"; - my $ifcfg = "$network_scripts/ifcfg-$device"; - renamef($ifcfg, "$network_scripts/old.ifcfg-$device"); - output($ifcfg, qq(DEVICE=$device -BOOTPROTO=static -IPADDR=$server_ip -NETMASK=$netmask -NETWORK=$lan_address.0 -BROADCAST=$lan_address.255 -ONBOOT=yes -)); -} - - -#- install and setup the RPM packages - -my $rpms_to_install; -my %rpm2file = ('dhcp-server' => '/usr/sbin/dhcpd', - bind => '/usr/sbin/named', - shorewall => '/sbin/shorewall', - 'caching-nameserver' => '/var/named/named.local'); - -#- first: try to install all in one step -my @needed_to_install = grep { !-e $rpm2file{$_} } keys %rpm2file; -@needed_to_install and $in->do_pkgs->install(@needed_to_install); -#- 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(N("Problems installing package %s", $_)); - } -} - -put_in_hash($shorewall ||= {}, { - disabled => 0, - net_interface => $card_netconnect, - loc_interface => [ grep { $_ ne $device } @cards ], - masquerade => { interface => $device, subnet => "$lan_address.0/$netmask" }, -}); - -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) { - log::explanations("Configuring a DHCP server on $lan_address.0"); - renamef($dhcpd_conf, "$dhcpd_conf.old"); - output($dhcpd_conf, qq(subnet $lan_address.0 netmask $netmask { - # default gateway - option routers $server_ip; - option subnet-mask $netmask; - - option domain-name "$internal_domain_name"; - option domain-name-servers $nameserver_ip; - - range dynamic-bootp $lan_address.$start_range $lan_address.$end_range; - default-lease-time $default_lease; - max-lease-time $max_lease; -} -)); -} - -my $update_dhcp = '/usr/sbin/update_dhcp.pl'; --e $update_dhcp and system($update_dhcp); - - -#- put the interface for the dhcp server in the sysconfig-dhcp config, for the /etc/init.d script of dhcpd - -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) { - log::explanations("Updating CUPS configuration accordingly"); - - substInFile { - s/^ServerName[^:].*\n//; $_ .= "ServerName $server_ip\n" if eof; - s/^BrowseAddress.*\n//; $_ .= "BrowseAddress $lan_address.255\n" if eof; - s/^BrowseOrder.*\n//; $_ .= "BrowseOrder Deny,Allow\n" if eof; - s/^BrowseDeny.*\n//; $_ .= "BrowseDeny All\n" if eof; - s/^BrowseAllow.*\n//; $_ .= "BrowseAllow $lan_address.*\n" if eof; - } $cups_conf; - - my @cups_conf_content = cat_($cups_conf); - my @root_location; my $root_location_start; my $root_location_end; - - # Cut out the root location block so that it can be treated seperately - # without affecting the rest of the file - if (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(N("Congratulations!"), -N("Everything has been configured. -You may now share Internet connection with other computers on your Local Area Network, using automatic network configuration (DHCP).")); - - -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 ugtk2; - ugtk2->import(qw(:wrappers :helpers :create)); - my $setup_state = $shorewall && $shorewall->{masquerade} ? - ($shorewall->{disabled} ? - N("The setup has already been done, but it's currently disabled.") : - N("The setup has already been done, and it's currently enabled.")) : - N("No Internet Connection Sharing has ever been configured."); - - my $window1 = ugtk2->new('drakgw'); - $window1->{rwindow}->signal_connect(delete_event => sub { ugtk2->exit(0) }); - unless ($::isEmbedded) { - $window1->{rwindow}->set_position('center'); - $window1->{rwindow}->set_title(N("Internet Connection Sharing configuration")); - } - $window1->{rwindow}->set_border_width(10); - my $vbox1 = new Gtk2::VBox(0,0); - $window1->{window}->add($vbox1); - my $hbox1 = new Gtk2::HBox(0,0); - $vbox1->pack_start($hbox1,1,1,0); - my $label1 = new Gtk2::Label( -N("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 Gtk2::HBox(0,0); - $vbox1->pack_start($hbox2,1,1,0); - - my $bbox1 = new Gtk2::HButtonBox; - $vbox1->pack_start($bbox1,0,0,0); - $bbox1->set_layout('end'); - my $button_conf = Gtk2::Button->new(N("Configure")); - $button_conf->signal_connect(clicked => sub { - system("/usr/sbin/drakgw --wizard"); - ugtk2->exit(0); - }); - $bbox1->add($button_conf); - my $button_cancel = Gtk2::Button->new(N("Cancel")); - $button_cancel->signal_connect(clicked => sub { ugtk2->exit(0) }); - $bbox1->add($button_cancel); - $window1->{rwindow}->show_all(); - $window1->main; - ugtk2->exit(0); - -} diff --git a/perl-install/standalone/drakhelp b/perl-install/standalone/drakhelp deleted file mode 100644 index 592ed097e..000000000 --- a/perl-install/standalone/drakhelp +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/perl - -use strict; -use diagnostics; -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use interactive; -use common; -use lang; -use any; - -die "Usage: drakhelp <help_path>" if @ARGV != 1; - -my $in = interactive->vnew; - -my $locale = lang::read('', $>); -$locale->{lang} = 'en' unless member($locale->{lang}, qw(de en es fr it ru)); -my $path2help = "/usr/share/doc/mandrake/" . $locale->{lang} . "/"; -my $path = $ARGV[0] =~ /^http|^www/ ? $ARGV[0] : $path2help . $ARGV[0]; - --e $path or $in->do_pkgs->install('mandrake_doc-drakxtools-' . $locale->{lang}); - -my $wm = any::running_window_manager(); -my %launchhelp = ( - 'kwin' => sub { system("mdklaunchhelp " . $path . "&") }, - 'gnome-session' => sub { system("yelp ghelp://" . $path . "&") }, - 'other' => sub { my $browser = $ENV{BROWSER} || find { -x "/usr/bin/$_" } qw(mozilla konqueror galeon) or $in->ask_warn('drakhelp', N("No browser is installed on your system, Please install one if you want to browse the help system")); - standalone::explanations("Connection to help system at $path"); - system("$browser " . $path . "&") - } - ); -member($wm, 'kwin', 'gnome-session') or $wm = 'other'; -eval { $launchhelp{$wm}->() }; - - diff --git a/perl-install/standalone/drakperm b/perl-install/standalone/drakperm deleted file mode 100755 index 552e63ede..000000000 --- a/perl-install/standalone/drakperm +++ /dev/null @@ -1,401 +0,0 @@ -#!/usr/bin/perl - -use strict; -use diagnostics; -use lib qw(/usr/lib/libDrakX); -use standalone; - -use common; -use ugtk2 qw(:helpers :wrappers :create); -use interactive; - -my $in = 'interactive'->vnew('su'); -local $_ = join '', @ARGV; - -#- vars declaration -my ($default_perm_level) = "level ".chomp_(`cat /etc/sysconfig/msec | grep SECURE_LEVEL= |cut -d= -f2`); -my $perm_path = '/usr/share/msec/'; -my $local_path = '/etc/security/msec/'; -my %perm = ( 'level 1' => $perm_path.'perm.1', - 'level 2' => $perm_path.'perm.2', - 'level 3' => $perm_path.'perm.3', - 'level 4' => $perm_path.'perm.4', - 'level 5' => $perm_path.'perm.5', - 'editable' => $local_path.'perm.local', - ); -my $editable = 0; -my $modified = 0; -my $prec_txt = $default_perm_level; - -#- Widget declaration -my $w = ugtk2->new('drakperm'); -$w->{rwindow}->set_size_request(550, 400) unless $::isEmbedded; -my $W = $w->{window}; -$W->signal_connect(delete_event => sub { ugtk2->exit }); -my $treeModel = Gtk2::TreeStore->new((Gtk2::GType->STRING) x 4); -my $permList = Gtk2::TreeView->new_with_model($treeModel); - -my @column_sizes = (150, 100, 100, 15, -1); - -each_index { - my $col = Gtk2::TreeViewColumn->new_with_attributes($_, Gtk2::CellRendererText->new, 'text' => $::i); - $col->set_min_width($column_sizes[$::i]); - $permList->append_column($col); -} (N("path"), N("user"), N("group"), N("permissions")); - -#- widgets settings -my $combo_perm = new Gtk2::Combo; -$combo_perm->entry->set_editable(0); -$combo_perm->set_popdown_strings(sort(keys %perm)); - -sub add_callback() { - row_setting_dialog(); - $modified++; -} - -sub edit_callback() { - my (undef, $iter) = $permList->get_selection->get_selected; - return unless $iter; - row_setting_dialog($iter); -} - -my @buttons; - -sub del_callback() { - my ($tree, $iter) = $permList->get_selection->get_selected(); - $tree->remove($iter); - $iter->free; - sensitive_buttons(0); - $modified++; -} - -sub down_callback() { - my ($model, $iter) = $permList->get_selection->get_selected; - return unless $iter; - my $new_iter = $model->iter_next($iter); - goto CLEAN1 unless $new_iter; - - $model->move_after($iter, $new_iter); - $model->move_after($iter, $new_iter); - $permList->get_selection->select_iter($iter); - $permList->queue_draw; - $new_iter->free; - CLEAN1: $iter->free; -} - -sub up_callback() { - my ($model, $iter) = $permList->get_selection->get_selected; - return unless $iter; - my $path = $model->get_path($iter); - goto CLEAN1 unless $path; - $path->prev; - my $prev_iter = $model->get_iter($path); - $path->free; - goto CLEAN2 unless $prev_iter; - $model->move_before($iter, $prev_iter); - $model->move_before($iter, $prev_iter); - $permList->get_selection->select_iter($iter); - $permList->queue_draw; - - $prev_iter->free; - CLEAN2: $path->free; - CLEAN1: $iter->free; -} - -my $combo_sig = $combo_perm->entry->signal_connect( changed => sub { display_perm($combo_perm->entry->get_text , @_) }); -$permList->signal_connect(button_press_event => sub { - return unless $editable; - my (undef, $event) = @_; - my (undef, $iter) = $permList->get_selection->get_selected; - return unless $iter; - row_setting_dialog($iter) if $event->type eq '2button-press'; - $iter->free; - }); - - -my $tips = new Gtk2::Tooltips; - -$W->add(gtkpack_(Gtk2::VBox->new(0,5), - 0, gtkset_property(Gtk2::Label->new(N("Drakperm is used to see files to use in order to fix permissions, owners, and groups via msec.\nYou can also edit your own rules which will owerwrite the default rules.")), 'wrap', 1), - 1, gtkadd(Gtk2::Frame->new, - gtkpack_(Gtk2::VBox->new(0,5), - 0, gtkadd(Gtk2::HBox->new(0,5), - Gtk2::Label->new(N("select perm file to see/edit")), - $combo_perm - ), - 1, create_scrolled_window($permList), - 0, my $up_down_box = gtkadd(Gtk2::HBox->new(0, 5), @buttons = - map { - gtkset_tip($tips, - gtksignal_connect(Gtk2::Button->new($_->[0]), clicked => $_->[2]), - $_->[1]); - } ([ N("Up"), N("Move selected rule up one level"), \&up_callback ], - [ N("Down"), N("Move selected rule down one level"), \&down_callback ], - [ N("add a rule"), N("Add a new rule at the end"), \&add_callback ], - [ N("delete"), N("Delete selected rule"), \&del_callback ], - [ N("edit"), N("Edit current rule"), \&edit_callback ])), - 0, gtkpack(Gtk2::HBox->new(0, 5), - gtksignal_connect(Gtk2::Button->new(N("Save")), clicked => \&save_perm), - gtksignal_connect(Gtk2::Button->new(N("Quit")), clicked => sub { ugtk2->exit }) - ) - ) - ) - ) - ); -$W->show_all; -$w->{rwindow}->set_position('center') unless $::isEmbedded; - -display_perm($default_perm_level); -$combo_perm->entry->set_text($default_perm_level); - -$permList->get_selection()->signal_connect('changed' => sub { - my ($select) = @_; - my (undef, $iter) = $select->get_selected(); - my $editable = $editable; - $editable = 0 unless $iter; - sensitive_buttons($editable); - $iter->free if $iter; - }); - -$w->main; -ugtk2->exit; - - -sub check_save() { - $modified or return 0; - my $sav_ = $in->ask_okcancel('Warning', 'your changed will be lost do you wish to continue?'); - $sav_ - and $modified = 0; - return $sav_; -} - -sub display_perm { - my $perm_level = shift @_; - return unless $perm_level; - my $file = $perm{$perm_level}; - my $sav_ = &check_save; - if ($modified && ! $sav_) { - $combo_perm->entry->signal_handler_block($combo_sig); - $combo_perm->entry->set_text($prec_txt); - $combo_perm->entry->signal_handler_unblock($combo_sig); - return 0; - } - - $editable = $perm_level =~ /^level \d/ ? 0 : 1; - - $treeModel->clear(); - local *F; - open F, $file; - local $_; - while (<F>) { - if (m/^([^#]\S+)\s+([^.\s]+)\.(\S+)?\s+(\d+)/) { - $treeModel->append_set(undef, [ 0 => $1, 1 => $2, 2 => $3, 3 => $4 ]); - } elsif (m/^([^#]\S+)\s+current?\s+(\d+)/) { - $treeModel->append_set(undef, [ 0 => $1, 1 => 'current', 2 => '', 3 => $2 ]); - } - } - close F; - $up_down_box->set_sensitive($editable); - sensitive_buttons(0) if $editable; - - $prec_txt = $perm_level; -} - -sub save_perm() { - $modified or return 0; - my $val; - local *F; - open F, '>' . $perm{editable} or die("Impssible to process \"", $perm{editable}, "\""); - $treeModel->foreach(sub { - my ($model, $_path, $iter) = @_; - my $line = $model->get($iter, 0) . "\t" . $model->get($iter,1) . ($model->get($iter,2) ? "." . $model->get($iter,2) : "") . "\t" . $model->get($iter,3) . "\n"; - $iter->free; - print F $line; - return 0; - }, $val); - close F; - $modified = 0; -} - -sub row_setting_dialog { - my ($iter) = @_; - - my %perms; - my $dlg = new Gtk2::Dialog(); - $dlg->set_transient_for($w->{rwindow}) unless $::isEmbedded; - $dlg->set_modal(1); -# $dlg->set_resizable(0); - my $ok = new Gtk2::Button('ok'); - my $cancel = new Gtk2::Button('cancel'); - my $browse = new Gtk2::Button(N("browse")); - my $users = new Gtk2::Combo; - my $groups = new Gtk2::Combo; - my $file = new Gtk2::Entry; - my $usr_hbox = new Gtk2::HBox(0,5); - my $usr_vbox = new Gtk2::VBox(0,5); - my $usr_check = new Gtk2::CheckButton(N("Current user")); - my $hb_rights = new Gtk2::HBox(0,15); - my $vb_rights = new Gtk2::VBox(0,15); - my $F_rights = new Gtk2::Frame(N("Permissions")); - my $F_usr = new Gtk2::Frame(N("Property")); - my $vb_specials = new Gtk2::VBox(0,5); - my $sticky = new Gtk2::CheckButton(N("sticky-bit")); - my $suid = new Gtk2::CheckButton(N("Set-UID")); - my $gid = new Gtk2::CheckButton(N("Set-GID")); - my $rght = $treeModel->get($iter, 3) if $iter; - my $s = length($rght) == 4 ? substr($rght,0,1) : 0; - my $user = $s ? substr($rght,1,1) : substr($rght,0,1); - my $group = $s ? substr($rght,2,1) : substr($rght,1,1); - my $other = $s ? substr($rght,3,1) : substr($rght,2,1); - - my %rights = (user => $user, group => $group, other => $other); - my @check = ('', 'read', 'write', 'execute'); - - $vb_rights->add(new Gtk2::Label($_)) foreach @check; - $hb_rights->add($vb_rights); - - foreach my $r (keys %rights) { - $perms{$r} = { get_right($rights{$r}) }; - my $vbox = gtkadd(Gtk2::VBox->new(0,5), Gtk2::Label->new($r)); - foreach my $c (@check) { - $c eq '' and next; - my $active = $perms{$r}{$c}; - $perms{$r}{$c} = Gtk2::CheckButton->new; - $perms{$r}{$c}->set_active($active); - $vbox->add($perms{$r}{$c}); - } - $hb_rights->add($vbox); - } - - $vb_specials->add(new Gtk2::Label(' ')); - $vb_specials->add($suid); - $vb_specials->add($gid); - $vb_specials->add($sticky); - $hb_rights->add($vb_specials); - - #- dlg widgets settings - my %s_right = get_right($s); - $s_right{execute} and $sticky->set_active(1); - $s_right{write} and $gid->set_active(1); - $s_right{read} and $suid->set_active(1); - - $file->set_text($treeModel->get($iter, 0)) if $iter; - - $users->set_popdown_strings(&get_user_or_group('users')); - $users->entry->set_text($treeModel->get($iter, 1)) if $iter; - $users->entry->set_editable(0); - - $groups->set_popdown_strings(&get_user_or_group); - $groups->entry->set_text($treeModel->get($iter, 2)) if $iter; - $groups->entry->set_editable(0); - - if ($iter && $treeModel->get($iter, 1) eq 'current') { - $usr_check->set_active(1); - $groups->set_sensitive(0); - $users->set_sensitive(0); - } - - $tips->set_tip($sticky, N("Used for directory:\n only owner of directory or file in this directory can delete it")); - $tips->set_tip($suid, N("Use owner id for execution")); - $tips->set_tip($gid, N("Use group id for execution")); - $tips->set_tip($usr_check, N("when checked, owner and group won't be changed")); - - $cancel->signal_connect(clicked => sub { $dlg->destroy }); - $browse->signal_connect(clicked => sub { - my $file_dlg = new Gtk2::FileSelection(N("Path selection")); - $file_dlg->set_modal(1); - $file_dlg->set_transient_for($dlg); - $file_dlg->show; - $file_dlg->set_filename($file->get_text); - $file_dlg->cancel_button->signal_connect( clicked => sub { $file_dlg->destroy }); - $file_dlg->ok_button->signal_connect( clicked => sub { - $file->set_text($file_dlg->get_filename); - $file_dlg->destroy; - }); - }); - $ok->signal_connect(clicked => sub { - unless ($iter) { - $iter = Gtk2::TreeIter->new; - $treeModel->append($iter, undef); - } - $treeModel->set($iter, [ 0 => $file->get_text ]); - if ($usr_check->get_active) { - $treeModel->set($iter, [ 1 => 'current' ]); - $treeModel->set($iter, [ 2 => '' ]); - } else { - $treeModel->set($iter, [ 1 => $users->entry->get_text ]); - $treeModel->set($iter, [ 2 => $groups->entry->get_text ]); - } - $user = ($perms{user}{read}->get_active ? 4 : 0)+($perms{user}{write}->get_active ? 2 : 0)+($perms{user}{execute}->get_active ? 1 : 0); - $group = ($perms{group}{read}->get_active ? 4 : 0)+($perms{group}{write}->get_active ? 2 : 0)+($perms{group}{execute}->get_active ? 1 : 0); - $other = ($perms{other}{read}->get_active ? 4 : 0)+($perms{other}{write}->get_active ? 2 : 0)+($perms{other}{execute}->get_active ? 1 : 0); - my $s = ($sticky->get_active ? 1 : 0) + ($suid->get_active ? 4 : 0) + ($gid->get_active ? 2 : 0); - $treeModel->set($iter, [ 3 => ($s || '') . $user . $group . $other ]); - $dlg->destroy; - $modified++; - $iter->free; - }); - $usr_check->signal_connect(clicked => sub { - my $bool = $usr_check->get_active; - $groups->set_sensitive(!$bool); - $users->set_sensitive(!$bool); - }); - - - $usr_vbox->add($usr_check); - $usr_vbox->add($usr_hbox); - - $usr_hbox->add(new Gtk2::Label(N("user :"))); - $usr_hbox->add($users); - $usr_hbox->add(new Gtk2::Label(N("group :"))); - $usr_hbox->add($groups); - - $F_rights->add($hb_rights); - $F_usr->add($usr_vbox); - - gtkpack_($dlg->vbox, - 0, gtkadd(new Gtk2::Frame(N("Path")), - gtkpack_(Gtk2::HBox->new(0,5), - 1, $file, - 0, $browse - ) - ), - 0, $F_usr, - 1, $F_rights - ); - $dlg->action_area->add($ok); - $dlg->action_area->add($cancel); - - $dlg->show_all; - -} - -sub get_user_or_group { - my $what = @_; - my @users; - local *F; - open F, $what eq 'users' ? '/etc/passwd' : '/etc/group'; - - local $_; - while (<F>) { - m/^([^#:]+):[^:]+:[^:]+:/ or next; - push @users, $1; - } - close F; - return sort(@users); -} - -sub get_right { - my ($right) = @_; - my %rght = ('read' => 0, 'write' => 0, 'execute' => 0); - $right - 4 >= 0 and $rght{read}=1 and $right = $right-4; - $right - 2 >= 0 and $rght{write}=1 and $right = $right-2; - $right - 1 >= 0 and $rght{execute}=1 and $right = $right-1; - return %rght; -} - -sub sensitive_buttons { - foreach my $i (0, 1, 3, 4) { - $buttons[$i]->set_sensitive($_[0]); - } -} diff --git a/perl-install/standalone/drakproxy b/perl-install/standalone/drakproxy deleted file mode 100755 index 9b979e105..000000000 --- a/perl-install/standalone/drakproxy +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl - -# DrakProxy - -# 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 network::network; -use any; -use common; - -my $u = { getVarsFromSh('/etc/profile.d/proxy.sh') }; -my $in = 'interactive'->vnew('su'); -network::network::miscellaneous_choose($in, $u, 1, 1); -network::network::proxy_configure($u); -$in->exit(0); diff --git a/perl-install/standalone/drakpxe b/perl-install/standalone/drakpxe deleted file mode 100755 index 636965f0c..000000000 --- a/perl-install/standalone/drakpxe +++ /dev/null @@ -1,516 +0,0 @@ -#!/usr/bin/perl -# -# François Pons <fpons@mandrakesoft.com> -# -# Copyright 2003 MandrakeSoft -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2, as -# published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# - -use strict; -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use common; -use interactive; -use network; -use log; -use c; -use network::netconnect; - -$::isInstall and die "Not supported during install.\n"; - -$::Wizard_pix_up = "wiz_drakgw.png"; #- to change ? keep existing one, nobody will see (too late) ;-) -$::direct = grep { /-direct/ } @ARGV; - - -# -#my $sysconf_network = "/etc/sysconfig/network"; -#my $sysconf_dhcpd = "/etc/sysconfig/dhcpd"; -#my $rc_firewall_generic = "/etc/rc.d/rc.firewall"; -#my $rc_firewall_drakgw = "/etc/rc.d/rc.firewall.inet_sharing"; -#my $rc_firewall_24 = "/etc/rc.d/rc.firewall.inet_sharing-2.4"; -#my $masq_file = "/etc/shorewall/masq"; -#my $cups_conf = "/etc/cups/cupsd.conf"; -# -#my $shorewall = network::shorewall::read(); -# -#- get network configuration. -my $netc = {}; -my $intf = {}; -network::read_all_conf('', $netc, $intf); - -my $in = 'interactive'->vnew('su'); -$::Wizard_title = N("PXE Server Configuration"); - -!$::isEmbedded && $in->isa('interactive::gtk') and $::isWizard = 1; - -#pur_gtk_mode() if $::isEmbedded && $in->isa('interactive::gtk'); - -sub sys { system(@_) == 0 or log::l("[drakpxe] Warning, sys failed for $_[0]") } - -sub outpend { - log::explanations("modified file $_[0]"); - my $f = shift; local *F; open F, ">>$f" or die "outpend in file $f failed: $!\n"; print F foreach @_; -} - -sub start_daemons () { - log::explanations("Starting daemons"); - - system("/etc/rc.d/init.d/dhcpd status >/dev/null") == 0 and sys("/etc/rc.d/init.d/dhcpd stop"); - - sys("/etc/rc.d/init.d/$_ start >/dev/null"), sys("/sbin/chkconfig --level 345 $_ on") foreach 'httpd', 'dhcpd'; -} - -sub stop_daemons () { - log::explanations("Stopping daemons"); - foreach (qw(dhcpd httpd)) { - system("/etc/rc.d/init.d/$_ status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/$_ stop"); - } - sys("/sbin/chkconfig --level 345 $_ off") foreach 'dhcpd', 'httpd'; -} - -my $wait_configuring; - -sub quit_global { - my ($in, $exitcode) = @_; - $in->exit($exitcode); - goto begin -} - -sub fatal_quit ($) { - log::l("[drakpxe] FATAL: $_[0]"); - undef $wait_configuring; - $in->ask_warn('', $_[0]); - quit_global($in, -1); -} - -#my ($kernel_version) = c::kernel_version() =~ /(...)/; -#log::l("[drakgw] kernel_version $kernel_version"); -# -#$kernel_version >= 2.4 or fatal_quit(N("Sorry, we support only 2.4 kernels.")); - -begin: - -#- ********************************** -#- * 0th step: verify if we have multiple network interface. - -$::Wizard_no_previous = 1; - -$::direct or $in->ask_okcancel(N("Installation Server Configuration"), -N("You are about to configure your computer to install a PXE server as a DHCP server -and a TFTP server to build an installation server. -With that feature, other computers on your local network will be installable using this computer as source. - -Make sure you have configured your Network/Internet access using drakconnect before going any further. - -Note: you need a dedicated Network Adapter to set up a Local Area Network (LAN)."), 1) or quit_global($in, 0); - -undef $::Wizard_no_previous; - - -#- ********************************** -#- * 1st step: verify if we have multiple network interface. - -step_check_intf: - -my @intf = grep { exists $_->{NETWORK} } map { - unless ($_->{NETWORK}) { - foreach my $s (split "\n", `route`) { - print STDERR "$s\n"; - $s =~ /^(\S+)\s+\S+\s+$_->{NETMASK}\s+.*$_->{DEVICE}/ and $_->{NETWORK} = $1; - } - } $_ } values %$intf; -if (@intf < 1) { - #- no interface already configured found, ask user to configure. - $in->ask_warn(N("No network adapter on your system!"), - N("No ethernet network adapter has been detected on your system. Please run the hardware configuration tool.")); - quit_global($in, 0); -} elsif (@intf > 1) { - #- there are more than one interface, we need to choose one of them. - @intf = ($in->ask_from_listf(N("Choose the network interface"), - N("Please choose which network interface will be used for the dhcp server."), - sub { N("Interface %s (on network %s)", $_[0]{DEVICE}, $_[0]{NETWORK}) }, - \@intf, - ) or goto begin); -} - - -#- ********************************** -#- * 3rd step: select installation directory to be used (if not present, next step -#- will be creation and copy from existing one). - -step_ip_range: - -#- read current configuration, or create a default suitable automatically. -my $dhcpd_conf = parse_dhcpd_conf("/etc/dhcpd.conf", {}, $netc, $intf[0]); - -#- get back default of ip. -my $pool; -foreach (@{$dhcpd_conf->{network}{pool}}) { - exists $_->{allow}{$dhcpd_conf->{class_PXE}} and $pool = $_, last; -} -my ($start_ip, $end_ip) = @{$pool || { start_ip => join('.', (split '\.', $intf[0]{NETWORK})[0..2], 16), - end_ip => join('.', (split '\.', $intf[0]{NETWORK})[0..2], 253) }}{qw(start_ip end_ip)}; - -#- it become too complicated to handle address range, so ask user directly. -$in->ask_from('DHCP Server Configuration', - N("The DHCP server will allow other computer to boot using PXE in the given range of address. - -The network address is %s using a netmask of %s. - -", @{$intf[0]}{qw(NETWORK NETMASK)}), [ { label => N("The DHCP start ip"), val => \$start_ip, type => 'entry' }, - { label => N("The DHCP end ip"), val => \$end_ip, type => 'entry' }, ]) - or goto begin; - - -#- ********************************** -#- * 3rd step: select installation directory to be used (if not present, next step -#- will be creation and copy from existing one). - -step_install_dir: - -my $dir = "/export"; #- TODO change according configuration? - -$in->ask_from('Choose the installation image directory', - N("Please indicate where the installation image will be available. - -If you do not have an existing directory, please copy the CD or DVD contents. - -"), - [ { label => N("Installation image directory"), val => \$dir, type => 'entry' }, ]) - or goto step_ip_range; - -unless (-d $dir && -e "$dir/VERSION" && -d "$dir/isolinux" && -d "$dir/Mandrake/base") { - $in->ask_warn(N("No image found"), - N("No CD or DVD image found, please copy the installation program and rpm files.")); - goto step_install_dir; -} - -#- ********************************** -#- * 4st step: ask user for auto installation file. - -step_auto_install: - -my $auto_inst_cfg = "Mandrake/base/auto_inst.cfg"; #- TODO change according configuration? --e "$dir/$auto_inst_cfg" or $auto_inst_cfg = ''; - -$in->ask_from('Choose auto installation', - N("Please indicate where the auto_install.cfg file is located. - -Leave it blank if you do not want to set up automatic installation mode. - -"), - [ { label => N("Location of auto_install.cfg file"), val => \$auto_inst_cfg, type => 'entry' }, ]) - or goto step_install_dir; - -#- now install packages... -my %rpm2file = ('dhcp-server' => '/usr/sbin/dhcpd', - 'pxe' => '/usr/sbin/pxe', - 'tftp-server' => '/usr/sbin/in.tftpd', - if_(! -x '/usr/sbin/httpd' && ! -x '/usr/sbin/httpd-perl', 'apache2' => '/usr/sbin/httpd2')); - -#- first: try to install all in one step -my @needed_to_install = grep { !-e $rpm2file{$_} } keys %rpm2file; -@needed_to_install and $in->do_pkgs->install(@needed_to_install); -#- second: try one by one if failure detected -if (grep { !-e $rpm2file{$_} } keys %rpm2file) { - foreach (keys %rpm2file) { - -e $rpm2file{$_} or $in->do_pkgs->install($_); - -e $rpm2file{$_} or fatal_quit(N("Problems installing package %s", $_)); - } -} - -#- check if a pool already exist allowing PXE, else create one wich will be correct. -if ($pool) { - @{$pool}{qw(start_ip end_ip)} = ($start_ip, $end_ip); -} else { - $pool = { start_ip => $start_ip, end_ip => $end_ip }; - foreach (keys %{$dhcpd_conf->{class}}) { - $pool->{$_ eq $dhcpd_conf->{class_PXE} || $_ eq 'Etherboot' ? 'allow' : 'deny'}{$_} = undef; - } - push @{$dhcpd_conf->{network}{pool}}, $pool; -} -build_dhcpd_conf($dhcpd_conf, "/etc/dhcpd.conf"); - -#- make kernel and initrd available for initrd. -mkdir "/var/lib/tftpboot/PXEClient/images"; -sys("cp", "-af", "$dir/isolinux/alt0", "/var/lib/tftpboot/PXEClient/images/"); - -my $pxelinux_cfg = parse_pxelinux_cfg("/var/lib/tftpboot/PXEClient/pxelinux.cfg/default"); -my $label; -foreach my $i (0..99) { - $label = undef; - foreach my $e (@{$pxelinux_cfg->{entry}}) { - $e->{label} eq "halt$i" and $label = "halt$i", last; - } - defined $label or $label = "halt$i", last; -} -my $server = $intf[0]{IPADDR} || $netc->{HOSTNAME}; -push @{$pxelinux_cfg->{entry}}, { label => $label, - kernel => "images/alt0/vmlinuz", - append => "initrd=images/alt0/all.rdz ramdisk=32000 vga=788 ".($auto_inst_cfg ? "kickstart=$auto_inst_cfg " : "")."automatic=method:http,network:dhcp,interface:eth0,dns:$netc->{dnsServer},server:$server,directory:$dir root=/dev/ram3" }; -build_pxelinux_cfg($pxelinux_cfg, "/var/lib/tftpboot/PXEClient/pxelinux.cfg/default"); - -#- make directory available for httpd. -log::explanations("Linking $dir in /var/www/html to make it available"); -system "mkdir", "-p", "/var/www/html/$dir"; -rmdir "/var/www/html/$dir"; -symlink $dir, "/var/www/html/$dir"; - -stop_daemons(); -start_daemons(); - -#- sub for reading/writing dhcpd.conf and pxelinux.cfg/default... -sub parse_dhcpd_conf { - my ($file, undef, $netc, $intf) = @_; - my (%dhcpd_conf, $pool); - local (*F, $_); - - #- fake reading configuration from dhcpd.conf file which is really too complex for this tools. - $dhcpd_conf{class_PXE} = 'PXE'; - $dhcpd_conf{class} = { PXE => undef, Etherboot => undef, known => undef }; - add2hash($dhcpd_conf{network} = { pool => [] }, $intf); - add2hash($dhcpd_conf{network}, $netc); - - if (open F, $file) { - while (<F>) { - if (/^\s*pool\s*{/ .. /}/) { - /^\s*range\s+(\S+)\s+(\S+)\s*;/ and ($pool->{start_ip}, $pool->{end_ip}) = ($1, $2); - /^\s*(allow|deny)\s+members\s+of\s+"([^"]*)"\s*;/ and $pool->{$1}{$2} = undef; - /}/ and do { push @{$dhcpd_conf{network}{pool}}, $pool; $pool = undef }; - } - } - close F; - } - - \%dhcpd_conf; -} - -sub build_dhcpd_conf { - my ($dhcpd_conf, $file) = @_; - local *F; - my $server = $dhcpd_conf->{network}{IPADDR} || $dhcpd_conf->{network}{HOSTNAME}; - open F, ">$file" or return; - log::explanations("Modified file $file"); - print F qq(# for explanation in french go to : http://www.delafond.org/traducmanfr/man/man5/dhcpd.conf.5.html -ddns-update-style none; -allow booting; -allow bootp; - -# Your dhcp server is not master on your network ! -#not authoritative; -# Your dhcpd server is master on your network ! -#authoritative; -not authoritative; - -#Interface where dhcpd is active -DHCPD_INTERFACE = "$dhcpd_conf->{network}{DEVICE}"; - -# Definition of PXE-specific options -# Code 1: Multicast IP address of bootfile -# Code 2: UDP port that client should monitor for MTFTP responses -# Code 3: UDP port that MTFTP servers are using to listen for MTFTP requests -# Code 4: Number of secondes a client must listen for activity before trying -# to start a new MTFTP transfer -# Code 5: Number of secondes a client must listen before trying to restart -# a MTFTP transfer - -# define Option for the PXE class -option space PXE; -option PXE.mtftp-ip code 1 = ip-address; -option PXE.mtftp-cport code 2 = unsigned integer 16; -option PXE.mtftp-sport code 3 = unsigned integer 16; -option PXE.mtftp-tmout code 4 = unsigned integer 8; -option PXE.mtftp-delay code 5 = unsigned integer 8; -option PXE.discovery-control code 6 = unsigned integer 8; -option PXE.discovery-mcast-addr code 7 = ip-address; - -#Define options for pxelinux -option space pxelinux; -option pxelinux.magic code 208 = string; -option pxelinux.configfile code 209 = text; -option pxelinux.pathprefix code 210 = text; -option pxelinux.reboottime code 211 = unsigned integer 32; -site-option-space "pxelinux"; -# These lines should be customized to your setup -#option pxelinux.configfile "configs/common"; -#option pxelinux.pathprefix "/pxelinux/files/"; -#filename "/pxelinux/pxelinux.bin"; - -option pxelinux.magic f1:00:74:7e; -option pxelinux.reboottime 30; -#if exists dhcp-parameter-request-list { - # Always send the PXELINUX options -# append dhcp-parameter-request-list 208, 209, 210, 211; -# append dhcp-parameter-request-list 208,211; -# } - -#Class that determine the options for Etherboot 5.x requests -class "Etherboot" { - -#if The vendor-class-identifier equal Etherboot-5.0 -match if substring (option vendor-class-identifier, 0, 13) = "Etherboot-5.0"; - -# filename define the file retrieve by the client, there nbgrub -# our tftp is chrooted so is just the path to the file -filename "/etherboot/nbgrub"; - -#Used by etherboot to detect a valid pxe dhcp server -option vendor-encapsulated-options 3c:09:45:74:68:65:72:62:6f:6f:74:ff; - -# Set the "vendor-class-identifier" field to "PXEClient" in dhcp answer -# if this field is not set the pxe client will ignore the answer ! -option vendor-class-identifier "Etherboot-5.0"; - -vendor-option-space PXE; -option PXE.mtftp-ip 0.0.0.0; - -# IP of you TFTP server -next-server $server; -} - - -# create the Class PXE -class "PXE" { -# if the "vendor-class-identifier" is set to "PXEClient" in the client dhcp request -match if substring(option vendor-class-identifier, 0, 9) = "PXEClient"; - -# filename define the file retrieve by the client, there pxelinux.0 -# our tftp is chrooted so is just the path to the file -# If you prefer use grub, use pxegrub compiled for your ethernet card. -#filename "/PXEClient/pxegrub"; -filename "/PXEClient/pxelinux.0"; - -# Set the "vendor-class-identifier" field to "PXEClient" in dhcp answer -# if this field is not set the pxe client will ignore the answer ! -option vendor-class-identifier "PXEClient"; - - -vendor-option-space PXE; -option PXE.mtftp-ip 0.0.0.0; - -# IP of you TFTP server -next-server $server; -} - -# the class know exist just for deny the response to other DHCP request -class "known" { - match hardware; - one-lease-per-client on; - ddns-updates on; - ddns-domainname = "$dhcpd_conf->{network}{DOMAINNAME}"; - option domain-name "$dhcpd_conf->{network}{DOMAINNAME}"; - option domain-name-servers $dhcpd_conf->{network}{dnsServer}; - ddns-hostname = pick-first-value(ddns-hostname, option host-name); - option fqdn.no-client-update on; - set vendor_class_identifier = option vendor-class-identifier; -} - -# Tags uses by setup_node_mac_to_dhcp -# TAG: NODE_LIST_BEGIN - -# TAG: NODE_LIST_END -shared-network "mynetwork" { - subnet $dhcpd_conf->{network}{NETWORK} netmask $dhcpd_conf->{network}{NETMASK} { - option subnet-mask $dhcpd_conf->{network}{NETMASK}; - option routers $dhcpd_conf->{network}{GATEWAY}; - default-lease-time 28800; - max-lease-time 86400; - option domain-name "$dhcpd_conf->{network}{DOMAINNAME}"; - option domain-name-servers $dhcpd_conf->{network}{dnsServer}; -# Used by clusterautosetup-client to find its server - next-server $server; - -); - foreach (@{$dhcpd_conf->{network}{pool}}) { - print F " pool { - range $_->{start_ip} $_->{end_ip}; -"; - print F " allow members of \"$_\";\n" foreach keys %{$_->{allow}}; - print F " deny members of \"$_\";\n" foreach keys %{$_->{deny}}; - print F " }\n"; - } -print F qq( - -# pool { -# range 192.168.200.200 192.168.200.254; -# give an address of the the pool for PXE client and deny the other -#allow members of "PXE"; -#deny members of "known"; -#allow members of "Etherboot"; -# } - } -} -); - close F; -} - -sub parse_pxelinux_cfg { - my ($file) = @_; - my (%pxelinux_cfg, $entry); - local (*F, $_); - - if (open F, $file) { - while (<F>) { - chomp; - s/#.*//; next if /^\s*$/; - if (/^\s*(PROMPT|DEFAULT|DISPLAY|TIMEOUT)\s+(.*)/i) { - $pxelinux_cfg{$1} = $2; - } elsif (/^\s*label\s+(.*)/i) { - $entry and push @{$pxelinux_cfg{entry}}, $entry; - $entry = { label => $1 }, - } elsif (/^\s*(LOCALBOOT|KERNEL|APPEND)\s+(.*)/i) { - $entry->{$1} = $2; - } else { - log::l("ignoring line in file $file due to parsing error"); - } - } - $entry and push @{$pxelinux_cfg{entry}}, $entry; - close F; - } - #- try to fix bad file (first version of drakpxe for example). - my %default_pxelinux_cfg = ( PROMPT => 1, - DEFAULT => "local", - DISPLAY => "messages", - TIMEOUT => 50, - entry => [ { label => "local", - LOCALBOOT => 0 } ], - ); - foreach (qw(PROMPT DEFAULT DISPLAY TIMEOUT entry)) { - length $pxelinux_cfg{$_} > 0 or $pxelinux_cfg{$_} = $default_pxelinux_cfg{$_}; - } - \%pxelinux_cfg; -} - -sub build_pxelinux_cfg { - my ($pxelinux_cfg, $file) = @_; - local *F; - open F, ">$file" or return; - log::explanations("Modified file $file"); - foreach (keys %$pxelinux_cfg) { - /^entry$/ and next; - print F "$_ $pxelinux_cfg->{$_}\n"; - } - foreach my $e (@{$pxelinux_cfg->{entry}}) { - print F "label $e->{label}\n"; - foreach (keys %$e) { - /^label$/ and next; - print F " $_ $e->{$_}\n"; - } - } - close F; -} - diff --git a/perl-install/standalone/draksec b/perl-install/standalone/draksec deleted file mode 100755 index 0e8f2b636..000000000 --- a/perl-install/standalone/draksec +++ /dev/null @@ -1,247 +0,0 @@ -#!/usr/bin/perl -#***************************************************************************** -# -# Copyright (c) 2002 Christian Belisle (cbelisle@mandrakesoft.com) -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License version 2, as -# published by the Free Software Foundation. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -#***************************************************************************** - -use strict; -use lib qw(/usr/lib/libDrakX); -use common; -use standalone; -use vars qw($MODE %options); -use ugtk2 qw(:helpers :wrappers :ask :create); -use run_program; -use security::level; -use security::msec; -use security::help; - -#$MODE = 'basic'; -#$0 =~ /draksec-firewall$/ and $MODE = 'firewall'; -#$0 =~ /draksec-perms$/ and $MODE = 'perms'; - -#/^-?-(\S+)$/ and $options{$1} = 1 foreach @ARGV; - - -my $w; - -# factorize this with rpmdrake and harddrake2 -sub wait_msg { - my $mainw = ugtk2->new('wait', (modal => 1, if_(!$::isEmbedded, transient => $w->{rwindow}))); - $mainw->{window}->add(new Gtk2::Label($_[0])); - $mainw->{rwindow}->show_all; - gtkset_mousecursor_wait($mainw->{rwindow}->window); - gtkflush(); - $mainw; -} - -sub remove_wait_msg { $_[0]->destroy } - -sub basic_seclevel_explanations() { - my $text = new Gtk2::TextView; - $text->set_editable(0); - gtktext_insert($text, - formatAlaTeX(N("Standard: This is the standard security recommended for a computer that will be used to connect - to the Internet as a client. - -High: There are already some restrictions, and more automatic checks are run every night. - -Higher: The security is now high enough to use the system as a server which can accept - connections from many clients. If your machine is only a client on the Internet, you - should choose a lower level. - -Paranoid: This is similar to the previous level, but the system is entirely closed and security - features are at their maximum - -Security Administrator: - If the 'Security Alerts' option is set, security alerts will be sent to this user (username or - email)"))); - - gtkpack_(gtkshow(new Gtk2::HBox(0, 0)), 1, $text); -} - -sub new_editable_combo { - my ($string_list, $o_default_value) = @_; - my $w = new Gtk2::Combo(); - $w->entry->set_editable(0); - $w->set_popdown_strings(@$string_list) unless is_empty_array_ref $string_list; - $w->entry->set_text($o_default_value) if $o_default_value; - $w; -} - -sub set_help_tip { - my ($entry, $default, $opt) = @_; - my $help = $security::help::help{$opt}; - gtkset_tip(new Gtk2::Tooltips, $entry, formatAlaTeX($help) . "\n" . N("(default value: %s)", $default)); -} - -my $msec = new security::msec; -$w = ugtk2->new('draksec'); -my $window = $w->{window}; - -############################ MAIN WINDOW ################################### -# Set different options to Gtk2::Window -unless ($::isEmbedded) { - $w->{rwindow}->set_position('center'); - $w->{rwindow}->set_title("DrakSec"); - $window->set_size_request(598, 520); -} - -# Connect the signals -$window->signal_connect('delete_event', sub { $window->destroy() }); -$window->signal_connect('destroy', sub { ugtk2->exit() }); - -$window->add(my $vbox = gtkshow(new Gtk2::VBox(0, 0))); - -# Create the notebook (for bookmarks at the top) -my $notebook = create_notebook(); - -my $common_opts = { col_spacings => 10, row_spacings => 5 }; - -######################## BASIC OPTIONS PAGE ################################ -my $seclevel_entry; - -$notebook->append_page(gtkshow(gtkpack(new Gtk2::VBox(0, 0), - basic_seclevel_explanations(), - create_packtable($common_opts, - [ - do { - my @sec_levels = security::level::get_common_list(); - my $current_level = security::level::get_string(); - - push(@sec_levels, $current_level) unless member($current_level, @sec_levels); - $seclevel_entry = new_editable_combo(\@sec_levels, $current_level); - - new Gtk2::Label(N("Security Level:")), $seclevel_entry; - } - ], - [ new Gtk2::Label(N("Security Alerts:")), - my $secadmin_check = new Gtk2::CheckButton ], - [ new Gtk2::Label(N("Security Administrator:")), - my $secadmin_entry = new Gtk2::Entry($msec->get_check_value("MAIL_USER")) ]))), - new Gtk2::Label(N("Basic"))); - -$secadmin_check->set_active(1) if $msec->get_check_value("MAIL_WARN") eq "yes"; - -######################### NETWORK & SYSTEM OPTIONS ######################### -my @yesno_choices = qw(yes no default ignore); -my @alllocal_choices = qw(ALL LOCAL NONE default); -my @all_choices = (@yesno_choices, @alllocal_choices); -my %options_values; -my $help_msg = N("The following options can be set to customize your\nsystem security. If you need an explanation, look at the help tooltip.\n"); - -foreach ([ 'network', N("Network Options") ], [ 'system', N("System Options") ]) { - my ($domain, $label) = @$_; - my %values; - $notebook->append_page(gtkshow(create_scrolled_window(gtkpack_(new Gtk2::VBox(0, 0), - 0, new Gtk2::Label($help_msg), - 1, create_packtable($common_opts, - map { - my $i = $_; - - my $entry; - my $default = $msec->get_function_default($i); - if (member($default, @all_choices)) { - $values{$i} = new_editable_combo(member($default, @yesno_choices) ? \@yesno_choices : if_(member($default, @alllocal_choices), \@alllocal_choices)); - $entry = $values{$i}->entry; - } else { - $values{$i} = new Gtk2::Entry(); - $entry = $values{$i}; - } - $entry->set_text($msec->get_function_value($i)); - set_help_tip($entry, $default, $i); - [ new Gtk2::Label($i), $values{$i} ]; - } sort $msec->list_functions($domain))))), - new Gtk2::Label($label)); - $options_values{$domain} = \%values; -} - -######################## PERIODIC CHECKS ################################### -my %security_checks_value; - -$notebook->append_page(gtkshow(create_scrolled_window(gtkpack_(new Gtk2::VBox(0, 0), - 0, new Gtk2::Label($help_msg), - 1, create_packtable($common_opts, - map { - my $i = $_; - $security_checks_value{$i} = new_editable_combo([ 'yes', 'no', 'default' ], $msec->get_check_value($i)); - my $entry = $security_checks_value{$i}->entry; - set_help_tip($entry, $msec->get_check_default($i), $i); - [ gtkshow(new Gtk2::Label(translate($i))), $security_checks_value{$i} ]; - } sort $msec->list_checks)))), - new Gtk2::Label(N("Periodic Checks"))); - - -####################### OK CANCEL BUTTONS ################################## -my $bok = gtksignal_connect(new Gtk2::Button(N("Ok")), - 'clicked' => sub { - my $seclevel_value = $seclevel_entry->entry->get_text(); - my $secadmin_check_value = $secadmin_check->get_active(); - my $secadmin_value = $secadmin_entry->get_text(); - my $w; - - log::explanations("Configuring msec"); - - if ($seclevel_value ne security::level::get_string()) { - $w = wait_msg(N("Please wait, setting security level...")); - log::explanations("Setting security level to $seclevel_value"); - security::level::set(security::level::from_string($seclevel_value)); - remove_wait_msg($w); - } - - $w = wait_msg(N("Please wait, setting security options...")); - log::explanations("Setting security administrator option"); - $msec->set_check('MAIL_WARN', $secadmin_check_value == 1 ? 'yes' : 'no'); - - if ($secadmin_value ne $msec->get_check_value('MAIL_USER') && $secadmin_check_value) { - log::explanations("Setting security administrator contact"); - $msec->set_check('MAIL_USER', $secadmin_value); - } - - log::explanations("Setting security periodic checks"); - foreach my $key (keys %security_checks_value) { - $msec->set_check($key, $security_checks_value{$key}->entry->get_text()); - } - $msec->apply_checks; - - foreach my $domain (keys %options_values) { - log::explanations("Setting msec functions related to $domain"); - foreach my $key (keys %{$options_values{$domain}}) { - my $opt = $options_values{$domain}{$key}; - $msec->set_function($key, $opt =~ /Combo/ ? $opt->entry->get_text() : $opt->get_text()); - } - } - $msec->apply_functions; - log::explanations("Applying msec changes"); - run_program::rooted($::prefix, "/usr/sbin/msec"); - - remove_wait_msg($w); - - ugtk2->exit(0); - }); - -my $bcancel = gtksignal_connect(new Gtk2::Button(N("Cancel")), - 'clicked' => sub { ugtk2->exit(0) }); -gtkpack_($vbox, - 1, gtkshow($notebook), - 0, gtkadd(gtkadd(gtkshow(new Gtk2::HBox(0, 0)), - $bok), - $bcancel)); -$bcancel->can_default(1); -$bcancel->grab_default(); - -$w->main; -ugtk2->exit(0); diff --git a/perl-install/standalone/draksound b/perl-install/standalone/draksound deleted file mode 100755 index 1e4f299f6..000000000 --- a/perl-install/standalone/draksound +++ /dev/null @@ -1,59 +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; -use detect_devices; - -my $in = 'interactive'->vnew('su'); - -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 = modules::get_alias($driver) if $driver =~ /sound-card/; # alsaconf ... - $_->{current_driver} = $driver if $driver; - $_->{sound_slot_index} = $::i; - harddrake::sound::config($in, $_, $::i); - } modules::probe_category('multimedia/sound'); -} else { - $in->ask_warn(N("No Sound Card detected!"), - formatAlaTeX(N("No Sound Card has been detected on your machine. Please verify that a Linux-supported Sound Card is correctly plugged in. - - -You can visit our hardware database at: - - -http://www.linux-mandrake.com/en/hardware.php3") . -N("\n\n\nNote: if you've an ISA PnP sound card, you'll have to use the sndconfig program. Just type \"sndconfig\" in a console."))); -} - -modules::write_conf; -$in->exit(0); diff --git a/perl-install/standalone/draksplash b/perl-install/standalone/draksplash deleted file mode 100755 index 405f3821d..000000000 --- a/perl-install/standalone/draksplash +++ /dev/null @@ -1,559 +0,0 @@ -#!/usr/bin/perl - -use strict; -use lib qw(/usr/lib/libDrakX); -use standalone; -use common; -use ugtk2 qw(:helpers :wrappers :create); -use interactive; - -#- convenience variables for true and false -my $true = 1; - - -my $in = 'interactive'->vnew('su'); - -my $window = ugtk2->new('DrakSplash'); -$window->{rwindow}->signal_connect(delete_event => \&CloseAppWindow); - -#- verification of package image magik -unless ($in->do_pkgs->is_installed('ImageMagick')) { - $in->ask_okcancel(N("Error"), N("package 'ImageMagick' is required to be able to complete configuration.\nClick \"Ok\" to install 'ImageMagick' or \"Cancel\" to quit")) - and $in->do_pkgs->install('ImageMagick') - or &CloseAppWindow; -} - -#- application vars -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 Gtk2::Frame(N("first step creation")), - 'widget' => { - 'label' => { - 'res' => N("final resolution"), - 'file' => N("choose image file"), - 'name' => N("Theme name") - }, - 'button' => { - #'boot_conf' => N("Make bootsplash step 2"), - #'lilo_conf' => N("Go to lilosplash configuration"), - 'file' => N("Browse"), - }, - 'combo' => { - 'res' => ['800x600', '1024x768', '1280x1024'], - 'name' => [ $theme{name} , &giv_exist_thm ] - } - }, - 'pos' => [ 'name', 'res', 'file', 'boot_conf', #'save', #'kill' - ], - ); -my %boot_conf_frame = ('frame' => new Gtk2::Frame(N("Configure bootsplash picture")), - 'widget' => { - 'label' => { - 'tx' => N("x coordinate of text box\nin number of characters"), - 'ty' => N("y coordinate of text box\nin number of characters"), - 'tw' => N("text width"), - 'th' => N("text box height"), - 'px' => N("the progress bar x coordinate\nof its upper left corner"), - 'py' => N("the progress bar y coordinate\nof its upper left corner"), - 'pw' => N("the width of the progress bar"), - 'ph' => N("the height of the progress bar"), - 'pc' => N("the color of the progress bar") - }, - #- must set scale values to true to get them created by mk_frame - 'scale' => { - 'tx' => 1, - 'ty' => 1, - 'tw' => 1, - 'th' => 1, - 'px' => 1, - 'py' => 1, - 'pw' => 1, - 'ph' => 1, - }, - 'button' => { - #'annul' => N("Go back"), - 'prev' => N("Preview"), - 'kill' => N("Quit"), - 'save' => N("Save theme"), - 'pc' => N("Choose color"), - }, - 'check' => { - 'logo' => N("Display logo on Console"), - 'quiet' => N("Make kernel message quiet by default"), - }, - }, - 'pos' => [ 'tx 1' , - 'ty 1' , - 'tw 1' , - 'th 1' , - 'px 1' , - 'py 1' , - 'pw 1' , - 'ph 1' , - 'pc' , - 'logo', - 'quiet', - 'annul', - 'prev', - 'save' , - 'kill', - ], - ); -#- var action is used to hide/show the correct frame -my @action_frame = (\%boot_conf_frame , \%first); -my $VB2 = new Gtk2::VBox(0,5); -my $first_vbox = new Gtk2::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 Gtk2::Frame(N("Configure bootsplash picture")); - &make_boot_frame; - $first_vbox->add($boot_conf_frame{frame}); - member($theme{name}, &giv_exist_thm) and &thm_in_this_res and &get_this_thm_res_conf or $in->ask_warn(N("Notice"), N("This theme does not yet have a bootsplash in %s !", $theme{res}{res})); - }); -#- go to bootsplash configuration step 2 -#$first{widgets}{button}{boot_conf}->signal_connect(clicked => sub{show_act(\%boot_conf_frame) } ); -#- image file selection for new theme -$first{widgets}{button}{file}->signal_connect(clicked => sub { - my $file_dialog = gtkset_modal(Gtk2::FileSelection->new(N("choose image")), 1); - $file_dialog->set_transient_for($window->{rwindow}); - - $file_dialog->set_filename($first{widgets}{label}{file}->get_text ne N("choose image file") ? $first{widgets}{label}{file}->get_text : '~/'); - $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_vbox->add($first{frame}); -$first_vbox->add($boot_conf_frame{frame}); -&make_boot_frame; - -# set window attributes and show it - -unless ($::isEmbedded) { - $window->{rwindow}->set_border_width(5); - $window->{window}->add($first_vbox); - $window->{rwindow}->set_position('center'); - $window->{rwindow}->show_all(); -#&show_act(\%first); -} - -# Gtk event loop -$window->main; - -# Should never get here -ugtk2->exit(0); - -### Callback function to close the window -sub CloseAppWindow { - ugtk2->exit(0); -} - -#- ====## used funtions ##===== - -#- Desc => write config file for boot theme and copy image in the right location -sub write_boot_thm { - my $_w = $in->wait_message('', N("saving Bootsplash theme...")); - &set_thm_values; - my $logo = $boot_conf_frame{widgets}{check}{logo}->get_active ? 'yes' : 'no'; - my $quiet = $boot_conf_frame{widgets}{check}{quiet}->get_active ? 'yes' : 'no'; - my $globalconf_file = $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 height 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') { - local *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; - } -} - -my %adj; -sub set_scale_values { - foreach (keys %{$theme{boot_conf}}) { - $adj{$_} and $adj{$_}->set_value($theme{boot_conf}{$_}); - } -} - -#- Desc => check if this theme is available in the current resolution else -#- change the current resolution or display a ask_warn box -#- Args => ø -#- return=> (bool) -sub thm_in_this_res { - my ($check_res) = @_; - (-f $thm_path.$theme{name}."/images/bootsplash-".$theme{res}{res}.".jpg") ? return 1 : $check_res == 1 ? return &which_res_exist : return 0; -} - -sub which_res_exist { - chdir($thm_path.$theme{name}."/images/"); - my $is_ok = 0; - foreach (@{$first{widget}{combo}{res}}) { - -f "bootsplash-$_.jpg" - and $is_ok = 1 - and $first{widgets}{combo}{res}->entry->set_text($_) - and last; - - } - $is_ok == 1 or $in->ask_warn(N("Notice"), N("This theme does not yet have a bootsplash in %s !", $theme{res}{res})) and return 0; - return 1; -} - -#- Desc => retrieve all installed theme -#- Args => ø -#- Return=> @arr of available theme -sub giv_exist_thm { - chdir($thm_path); - my @thms_dirs; - foreach (glob("*")) { - -d $_ && m/^[^.]/ - and push @thms_dirs, $_; - } - return @thms_dirs; -} - -#- Desc => show only the right frame -#- Args => action(str) -#- Return=> (bool) -sub show_act { -# my ($action) = @_; -# foreach (@action_frame){ -# if($_ == $action){ -# $_->{frame}->show_all ; -# }else{ -# $_->{frame}->hide; -# } -# } -} - -#- Desc => just add tooltips -#- Args => name of widget(str) and frame to work on it (\%hash) -sub tool_tip { - my ($name , $ref) = @_; - foreach (keys %{$ref->{widget}}) { - $_ eq 'tooltip' and next; - if ($ref->{widget}{$_}{$name}) { - ! $adj{$name.'_tip'} and $adj{$name.'_tip'} = new Gtk2::Tooltips(); - $adj{$name.'_tip'}->set_tip($ref->{widgets}{$_}{$name}, $ref->{widget}{tooltip}{$name}, ''); - } - } -} - -my %hboxes; - -#- 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 my $pos (@{$ref->{pos}}) { - $pos =~ m/^(\w+)(\s+)?(\w+)?$/; - my $key = $1.'hb'; - #- open a new hbox - $hboxes{$key} = new Gtk2::HBox($3 ? 1 : 0, 5); - #- look for label - $ref->{widget}{label}{$1} - and $ref->{widgets}{label}{$1} = new Gtk2::Label($ref->{widget}{label}{$1}) - and $hboxes{$key}->add($ref->{widgets}{label}{$1}); - #- look for scale - $ref->{widget}{scale}{$1} - and $ref->{widgets}{scale}{$1} = new Gtk2::HScale($adj{$1} = new Gtk2::Adjustment(0, 0, $scale_size{$1}, 1, 10, 0)) - and $hboxes{$key}->add($ref->{widgets}{scale}{$1}) - and $ref->{widgets}{scale}{$1}->set_digits(0); - $adj{$1} and $adj{$1}->set_value($theme{boot_conf}{$1}); - #- look for combo - my @popdown; - $ref->{widget}{combo}{$1} - and @popdown = @{$ref->{widget}{combo}{$1}} - and $ref->{widgets}{combo}{$1} = new Gtk2::Combo - and $hboxes{$key}->add($ref->{widgets}{combo}{$1}) - and $ref->{widgets}{combo}{$1}->set_popdown_strings(@popdown); - #- look for checkbox - $ref->{widget}{check}{$1} - and $ref->{widgets}{check}{$1} = new Gtk2::CheckButton($ref->{widget}{check}{$1}) - and $hboxes{$key}->add($ref->{widgets}{check}{$1}) - and $ref->{widgets}{check}{$1}->set_active(1); - #- look for button - $ref->{widget}{button}{$1} - and $ref->{widgets}{button}{$1} = new Gtk2::Button($ref->{widget}{button}{$1}) - and $hboxes{$key}->add($ref->{widgets}{button}{$1}); - #- look for tooltips - $ref->{widget}{tooltip}{$1} and &tool_tip($1, \%{$ref}); - $box->add($hboxes{$key}); - } - $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..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 { - my $VB = new Gtk2::VBox(0,5); - &mk_frame($VB, \%boot_conf_frame); - #- open a color choose box - $boot_conf_frame{widgets}{button}{pc}->signal_connect(clicked => sub { - my $color = gtkshow(Gtk2::ColorSelectionDialog->new(N("ProgressBar color selection"))); - $theme{boot_conf}{pc} =~ m/0x(.{2})(.{2})(.{2})/; - my @rgb = map { hex($_)/255 } ($1 ,$2, $3); - $color->colorsel->set_current_color(Gtk2::Gdk::Color->new(@rgb)); - $color->cancel_button->signal_connect(clicked => sub { $color->destroy }); - $color->ok_button->signal_connect(clicked => sub { - my $colour = $color->colorsel->get_current_color(); - @rgb = map { dec2hex($_*255) } ($colour->red, $colour->green, $colour->blue); - $theme{boot_conf}{pc} = "0x$rgb[0]$rgb[1]$rgb[2]"; - $color->destroy; - }); - }); - #- quit button - $boot_conf_frame{widgets}{button}{kill}->signal_connect(clicked => \&CloseAppWindow); - $boot_conf_frame{widgets}{button}{save}->signal_connect(clicked => sub { &write_boot_thm }); - #- return to first screen - #$boot_conf_frame{widgets}{button}{annul}->signal_connect(clicked => sub { show_act( \%first ) } ); - #- made a preview - $boot_conf_frame{widgets}{button}{prev}->signal_connect(clicked => sub { - unless (-f $first{widgets}{label}{file}->get) { - $in->ask_warn(N("Notice"), N("You must choose an image file first!")); - return 0; - } - #- calculation of the 2 angle of text box and progress bar - &set_thm_values; - my $_w = $in->wait_message('', N("Generating preview ...")); - my $txt_tl_x = $theme{boot_conf}{tx}*$font_size{w}; - my $txt_tl_y = $theme{boot_conf}{ty}*$font_size{h}; - my $txt_width = $theme{boot_conf}{tw}*$font_size{w}; - my $txt_height = $theme{boot_conf}{th}*$font_size{h}; - my $prog_tl_x = $theme{boot_conf}{px}; - my $prog_tl_y = $theme{boot_conf}{py}; - my $prog_width = $theme{boot_conf}{pw}; - my $prog_height = $theme{boot_conf}{ph}; - &show_prev($first{widgets}{label}{file}->get,$txt_tl_x,$txt_tl_y,$txt_width,$txt_height,$prog_tl_x,$prog_tl_y,$prog_width,$prog_height); - }); - $boot_conf_frame{frame}->show_all; -# - check scales values are possibly correct - #&set_scale_values; - - foreach my $k (keys %{$theme{boot_conf}}) { - $k =~ m/[tp][hwyx]/ - and $adj{$k}->signal_connect(value_changed => sub { &check_boot_scales($k) }); - } -} - -#- 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); - } -} - - -my ($prev_pic, $prev_pix, $prev_canvas); - -#- Desc => destroy properly all widget of preview window -sub kill_preview { - $prev_window->destroy; undef($prev_window); - $prev_canvas->destroy; undef($prev_canvas); - undef($prev_pic); - undef($prev_pix); -} -#- Desc => create a new window with a preview of splash screen -#- Args => $file (str) full path to preview file -sub show_prev { - my ($file,$txt_tl_x,$txt_tl_y,$txt_width,$txt_height,$prog_tl_x,$prog_tl_y,$prog_width, $prog_height) = @_; - $prev_window - or $prev_window = new Gtk2::Window('toplevel') and $prev_window->set_policy(0, 1, 1); -#-PO First %s is theme name, second %s (in parenthesis) is resolution - $prev_window->set_title(N("%s BootSplash (%s) preview", $theme{name}, $theme{res}{res})); - $prev_pic = gtkcreate_pixbuf($file); - $prev_pic->scale_simple($theme{res}{w}, $theme{res}{h},0); - $prev_pix = $prev_pic->render_pixmap_and_mask($prev_pic); - $prev_canvas and $prev_canvas->isa('Gtk2::Widget') - or $prev_canvas = new Gtk2::DrawingArea() and $prev_window->add($prev_canvas); - $prev_canvas->set_size_request($theme{res}{w}, $theme{res}{h}); - $prev_canvas->signal_connect(expose_event => sub { - $prev_canvas->window->draw_pixmap($prev_canvas->style->bg_gc('normal'),$prev_pix,0,0,0,0, $theme{res}{w}, $theme{res}{h}); - $prev_canvas->window->draw_rectangle($prev_canvas->style->black_gc, $true,$txt_tl_x, $txt_tl_y,$txt_width,$txt_height); - $prev_canvas->window->draw_rectangle($prev_canvas->style->black_gc, $true, $prog_tl_x,$prog_tl_y,$prog_width, $prog_height); - }); - $prev_window->signal_connect(delete_event => \&kill_preview); - $prev_window->show_all; - -} - -#- Desc => define the max size of boot's scales -sub set_scale_size { - %scale_size = ('tx' => ($theme{res}{w} / $font_size{w}), - 'ty' => ($theme{res}{h} / $font_size{h}), - 'tw' => ($theme{res}{w} / $font_size{w}), - 'th' => ($theme{res}{h} / $font_size{h}), - 'px' => $theme{res}{w}, - 'py' => $theme{res}{h}, - 'pw' => $theme{res}{w}, - 'ph' => $theme{res}{h}, - ); -} - -#- Desc => verify that boot's scales widgets are correctly set -#- Args => $obj (str) is the scale to check value - -sub check_boot_scales { - my ($obj) = @_; - my $tw = $adj{tw}->get_value; - my $tx = $adj{tx}->get_value; - my $th = $adj{th}->get_value; - my $ty = $adj{ty}->get_value; - my $pw = $adj{pw}->get_value; - my $ph = $adj{ph}->get_value; - my $px = $adj{px}->get_value; - my $py = $adj{py}->get_value; - my $max_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 $adj{tx}->set_value($max_x - $tw); - $obj eq 'tx' and $max_x < $tw + $tx and $adj{tw}->set_value($max_x - $tx); - $obj eq 'th' and $max_y < $th + $ty and $adj{ty}->set_value($max_y - $th); - $obj eq 'ty' and $max_y < $th + $ty and $adj{th}->set_value($max_y - $ty); - $obj eq 'pw' and $max_xres < $pw + $px and $adj{px}->set_value($max_xres - $pw); - $obj eq 'px' and $max_xres < $pw + $px and $adj{pw}->set_value($max_xres - $px); - $obj eq 'ph' and $max_yres < $ph + $py and $adj{py}->set_value($max_yres - $ph); - $obj eq 'py' and $max_yres < $ph + $py and $adj{ph}->set_value($max_yres - $py); - -} diff --git a/perl-install/standalone/drakupdate_fstab b/perl-install/standalone/drakupdate_fstab deleted file mode 100755 index aee783cd6..000000000 --- a/perl-install/standalone/drakupdate_fstab +++ /dev/null @@ -1,167 +0,0 @@ -#!/usr/bin/perl - -# drakupdate_fstab -# 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 detect_devices; -use security::level; -use common; -use fsedit; -use lang; -use any; -use fs; - -$::isStandalone = 1; #- not using standalone.pm which generates too many logs for drakupdate_fstab purpose - -$::testing = $ARGV[0] eq '--test' && shift @ARGV; -$::auto = $ARGV[0] eq '--auto' && shift @ARGV; -my $no_flag = $ARGV[0] eq '--no-flag' && shift @ARGV; -my ($raw_action, $device_name) = @ARGV; -my ($action) = $raw_action =~ /^--(add|del)/; - -@ARGV == 2 && $action or die "usage: drakupdate_fstab [--test] [--auto] [--no-flag] [--add | --del] <device>\n"; - -main($action, $device_name); - - -sub check_hard_drives { - my ($name) = @_; - - #- do not do anything if there are many partitions - #- otherwise we may add main extended partitions - if ($name =~ s|/part\d+$||) { - my @parts = grep { /part/ } all($name); - @parts <= 1; - } else { - 1; - } -} - -sub device_name_to_entry { - my ($name) = @_; - $name =~ s|/dev/||; - $name =~ /fd[01]/ && !$::auto and return { device => $name }; - my @l = detect_devices::get(); - - 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, $useSupermount) = @_; - - fs::set_default_options($part, - is_removable => 1, - useSupermount => $useSupermount, - security => security::level::get(), - lang::fs_options(lang::read())); - - my ($options, $unknown) = fs::mount_options_unpack($part); - $options->{kudzu} = 1 if !$no_flag; - fs::mount_options_pack($part, $options, $unknown); -} - -sub set_mount_point { - my ($part, $fstab) = @_; - - my $mntpoint = detect_devices::suggest_mount_point($part) or return; - $mntpoint = "/mnt/$mntpoint"; - - foreach ('', 2 .. 10) { - next if fsedit::mntpoint2part("$mntpoint$_", $fstab); - $part->{mntpoint} = "$mntpoint$_"; - return 1; - } - 0; -} - -sub main { - my ($action, $device_name) = @_; - - if ($::auto) { - check_hard_drives($device_name) or return; - } - - my $part = device_name_to_entry($device_name); - my $fstab_file = '/etc/fstab'; - if (!$part) { - print STDERR "Can't find device $device_name\n" if $::testing; - return; - } elsif ($::testing) { - cp_af('/etc/fstab', $fstab_file = '/tmp/fstab'); - } - - my $fstab = [ fs::read_fstab('', '/etc/fstab', 'keep_freq_passno', '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; - } - my $useSupermount = 0; #- force non-supermount, supermount is too buggy - set_options($part, $useSupermount); - set_mount_point($part, $fstab) or return; - - my ($line) = fs::prepare_write_fstab([$part]); - append_to_file($fstab_file, $line) if $line; - - if ($::auto) { - print $part->{mntpoint}, " ", $useSupermount ? 'supermount' : 'user', "\n"; - } - } else { - if (!@$existing_fstab_entries) { - print STDERR "Not found in fstab\n" if $::testing; - return; - } - foreach (@$existing_fstab_entries) { - if (!$no_flag && $_->{options} !~ /\bkudzu\b/) { - print STDERR "Not a 'kudzu'-flagged entry\n" if $::testing; - return; - } - } - - my ($s) = fs::prepare_write_fstab($fstab_, '', 'keep_smb_credentials'); - output($fstab_file, $s); - - if ($::auto) { - print "$_->{mntpoint}\n" foreach @$existing_fstab_entries; - } - } - - if ($::testing) { - print "fstab would have changed:\n"; - system("diff -u /etc/fstab $fstab_file"); - } -} diff --git a/perl-install/standalone/drakxservices b/perl-install/standalone/drakxservices deleted file mode 100755 index 5da4b4464..000000000 --- a/perl-install/standalone/drakxservices +++ /dev/null @@ -1,17 +0,0 @@ -#!/usr/bin/perl - -use strict; -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use common; -use interactive; -use services; -use log; - -my $in = 'interactive'->vnew('su'); -begin: -my $l = services::ask($in); -services::doit($in, $l) if $l; -$in->exit(0); diff --git a/perl-install/standalone/drakxtv b/perl-install/standalone/drakxtv deleted file mode 100755 index ce9908811..000000000 --- a/perl-install/standalone/drakxtv +++ /dev/null @@ -1,163 +0,0 @@ -#!/usr/bin/perl -# 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; - -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 N("consolehelper missing") }; - if (!$::testing && ! -x "/usr/bin/scantv") { - # log::explanations("package xawtv isn't installed"); - $in->ask_warn("XawTV isn't installed!", - formatAlaTeX(N("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); - # this table must be checked on each xawtv release: - my %freqtables = - ("us-bcast" => N("USA (broadcast)"), "us-cable" => N("USA (cable)"), "us-cable-hrc" => N("USA (cable-hrc)"), "canada-cable" => N("Canada (cable)"), - "japan-bcast" => N("Japan (broadcast)"), "japan-cable" => N("Japan (cable)"), "china-bcast" => N("China (broadcast)"), - "europe-west" => N("West Europe"), "europe-east" => N("East Europe"), "italy" => N("Italy"), "ireland" => N("Ireland"), "france" => N("France [SECAM]"), - "newzealand" => N("Newzealand"), "australia" => N("Australia"), - "southafrica" => N("South Africa"), - "argentina" => N("Argentina"), - "australia-optus" => N("Australian Optus cable TV"), - -1 => N("All") - ); - # Info: HRC means "Harmonically Related Carrier" - - my %countries = - ( - "AR" => [ "argentina" ], - "AU" => [ "australia" ], - "FR" => [ "france", "SECAM" ], - "CA" => [ "canada-cable" ], - "IE" => [ "ireland" ], - "IT" => [ "italy" ], - "JP" => [ "japan-bcast", "NTSC-JP" ], - "NZ" => [ "newzealand" ], - "AT|BE|CH|DE|ES|GB|SE" => [ "europe-west" ], - "US" => [ "us-bcast", "NTSC" ], - "ZA" => [ "southafrica" ], - "CN|TW" => [ "china-bcast" ] - ); - - my $tbl; - my $locale = lang::read('', $>); - $locale->{country} =~ /$_/ and $tbl = $countries{$_} foreach keys %countries; - if ($tbl) { - $ftable_id = $tbl->[0]; - $norm = $tbl->[1] if $tbl->[1]; - } - # default to pal since most people use that - $norm ||= "PAL"; - log::l("[drakxtv] guess country=>$locale->{country}, norm=>$norm, area=>$ftable_id"); - - if ($in->ask_from("TVdrake", N("Please,\ntype in your tv norm and country"), - [ - { label => N("TV norm:"), val => \$norm, list => [ "NTSC", "NTSC-JP", "PAL", "PAL-M", "PAL-N", "PAL-NC", "SECAM" ], type => 'combo' }, - { label => N("Area:"), val => \$ftable_id, list => [keys %freqtables], format => sub { $freqtables{$_[0]} }, sort => 1 }, - ] - )) { - my $_wait = $in->wait_message(N("Please wait"), - N("Scanning for TV channels in progress ...")); - # we provide scantv a bogus table (france) which will - # will be ignored since "All" is selected (because of -a) - $ftable_id = "france -a " if $ftable_id eq -1; - # Note that this'll be broken if/when we implement interactive::qt - my $use_X = $in->isa('interactive::gtk') && -x "/usr/X11R6/bin/xvt"; - my $home = $ENV{HOME}; - my $is_bttv_loaded = cat_("/proc/modules"); - # workaround non loaded bttv - run_program::run('/sbin/modprobe', 'bttv') if $< == 0 && $is_bttv_loaded !~ /bttv/; - my $i = system(($use_X ? "xvt -T '" . N("Scanning for TV channels") . " ...' -e " : "") . - "scantv -n $norm -f $ftable_id -o $home/.xawtv" . - ($use_X ? "" : " &>$home/tmp/scantv.log;")); - if ($i) { - $in->ask_warn(N("There was an error while scanning for TV channels"), - N("XawTV isn't installed!")) } - else { - log::explanations("created file $home/.xawtv"); - $in->ask_warn(N("Have a nice day!"), - N("Now, you can run xawtv (under X Window!) !\n")) unless $use_X; - } - } - } -} - -my @devices = grep { $_->{media_type} eq 'MULTIMEDIA_VIDEO' || $_->{driver} eq 'usbvision' } detect_devices::probeall(1); -push @devices, { driver => 'bttv', description => 'dummy' } if $::testingv && !@devices; -if (@devices) { - # TODO: That need some work for multiples TV cards - foreach (@devices) { - if ($< == 0 && (grep { detect_devices::isTVcard($_) } @devices)) { - require harddrake::v4l; - require modules; - no strict 'subs'; - modules::read_conf; - harddrake::v4l::config($in, $_->{driver}); - modules::write_conf; - } - scan4channels(); - } -} else { - $in->ask_warn(N("No TV Card detected!"), formatAlaTeX( - N("No TV Card has been detected on your machine. Please verify that a Linux-supported Video/TV Card is correctly plugged in. - - -You can visit our hardware database at: - - -http://www.linux-mandrake.com/en/hardware.php3"))); -} -$in->exit(0) if defined $in; - - -# TODO: -# - offer to sort channels after -# - use Video-Capture-V4l-0.221 ? -# - configure kwintv and zapping ? => they've already wizards :-( -# - install xawtv if needed through consolhelper diff --git a/perl-install/standalone/fileshareset b/perl-install/standalone/fileshareset deleted file mode 100755 index 18277d95f..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,sync)'; -$nfs_exports::conf_file = '/etc/exports'; -$smb_exports::conf_file = '/etc/samba/smb.conf'; -my $authorisation_file = '/etc/security/fileshare.conf'; -my $authorisation_group = 'fileshare'; - - -######################################## -# fileshare utility $Id$ -# Copyright (C) 2001-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, @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 627d355af..000000000 --- a/perl-install/standalone/harddrake2 +++ /dev/null @@ -1,378 +0,0 @@ -#!/usr/bin/perl - -use strict; -use diagnostics; -use lib qw(/usr/lib/libDrakX); -use standalone; -use common; - -use ugtk2 qw(:create :helpers :wrappers); -use interactive; -use harddrake::data; #- needs to stay after use-ugtk2 as long as this module defines globals containing some N() -use POSIX qw(:sys_wait_h); - - -# { field => [ short_translation, full_description] } -my %fields = - ( - "alternative_drivers" => [ N("Alternative drivers"), - N("the list of alternative drivers for this sound card") ], - "bus" => - [ N("Bus"), - N("this is the physical bus on which the device is plugged (eg: PCI, USB, ...)") ], - "channel" => [ N("Channel"), N("EIDE/SCSI channel") ], - "bogomips" => [ N("Bogomips"), N("the GNU/Linux kernel needs to run a calculation loop at boot time to initialize a timer counter. Its result is stored as bogomips as a way to \"benchmark\" the cpu.") ], - "bus_id" => - [ N("Bus identification"), - N("- PCI and USB devices: this lists the vendor, device, subvendor and subdevice PCI/USB ids") ], - "bus_location" => - [ N("Location on the bus"), - N("- pci devices: this gives the PCI slot, device and function of this card -- eide devices: the device is either a slave or a master device -- scsi devices: the scsi bus and the scsi device ids") ], - "cache size" => [ N("Cache size"), N("size of the (second level) cpu cache") ], - "capacity" => [ N("Drive capacity"), N("special capacities of the driver (burning ability and or DVD support)") ], -#-PO Translators, here "comas" is the medical coma, not the lexical coma!! - "coma_bug" => [ N("Coma bug"), N("whether this cpu has the Cyrix 6x86 Coma bug") ], - "cpu family" => [ N("Cpuid family"), N("family of the cpu (eg: 6 for i686 class)") ], - "cpuid level" => [ N("Cpuid level"), N("information level that can be obtained through the cpuid instruction") ], - "cpu MHz" => [ N("Frequency (MHz)"), N("the CPU frequency in MHz (Megahertz which in first approximation may be coarsely assimilated to number of instructions the cpu is able to execute per second)") ], - "description" => [ N("Description"), N("this field describes the device") ], - "device" => [ N("Old device file"), - N("old static device name used in dev package") ], - "devfs_device" => [ N("New devfs device"), - N("new dynamic device name generated by core kernel devfs") ], -#-PO Translators, here "module" is the "jargon term" for a kernel driver - "driver" => [ N("Module"), N("the module of the GNU/Linux kernel that handles the device") ], - "flags" => [ N("Flags"), N("CPU flags reported by the kernel") ], - "fdiv_bug" => [ N("Fdiv bug"), - N("Early Intel Pentium chips manufactured have a bug in their floating point processor which did not achieve the required precision when performing a Floating point DIVision (FDIV)") ], - "fpu" => [ N("Is FPU present"), N("yes means the processor has an arithmetic coprocessor") ], - "fpu_exception" => [ N("Whether the FPU has an irq vector"), N("yes means the arithmetic coprocessor has an exception vector attached") ], - "f00f_bug" => [N("F00f bug"), N("early pentiums were buggy and freezed when decoding the F00F bytecode")], - "hlt_bug" => [ N("Halt bug"), - N("Some of the early i486DX-100 chips cannot reliably return to operating mode after the \"halt\" instruction is used") ], - - "info" => [N("Floppy format"), N("format of floppies supported by the drive")], - "level" => [N("Level"), N("sub generation of the cpu")], - "media_type" => [ N("Media class"), N("class of hardware device") ], - "Model" => [N("Model"), N("hard disk model")], - "model" => [N("Model"), N("generation of the cpu (eg: 8 for PentiumIII, ...)")], - "model name" => [N("Model name"), N("official vendor name of the cpu")], - "nbuttons" => [ N("Number of buttons"), N("the number of buttons the mouse has") ], - "name" => [ N("Name"), N("the name of the CPU") ], - "port" => [N("Port"), N("network printer port")], - "processor" => [ N("Processor ID"), N("the number of the processor") ], - "stepping" => [ N("Model stepping"), N("stepping of the cpu (sub model (generation) number)") ], - "type" => [ N("Type"), N("the type of bus on which the mouse is connected") ], - "Vendor" => [ N("Vendor"), N("the vendor name of the device") ], - "vendor_id" => [ N("Vendor"), N("the vendor name of the processor") ], - "wp" => [ N("Write protection"), N("the WP flag in the CR0 register enforce write proctection at the memory page level, thus enabling the processor to prevent kernel accesses)") ], - ); - - -my ($in, %IDs, $pid, $w); - -my (%options, %check_boxes); -my $conffile = "/etc/sysconfig/harddrake2/ui.conf"; - -my ($modem_check_box, $printer_check_box, $current_device, $current_configurator); - - -#-PO Translators, please keep all "/" charaters !!! -my %menus = ( - 'options' => N("/_Options"), - 'help' => N("/_Help") - ); - -my %menu_options = ( - 'PRINTERS_DETECTION' => [ $menus{options}, N("/Autodetect _printers") ], - 'MODEMS_DETECTION' => [ $menus{options}, N("/Autodetect _modems") ], - 'JAZZ_DETECTION' => [ $menus{options}, N("/Autodetect _jazz drives") ], - ); - - -my @menu_items = - ( - [ N("/_File"), undef, undef, undef, '<Branch>' ], - [ N("/_File").N("/_Quit"), N("<control>Q"), \&quit_global, undef, '<CheckItem>' ], - [ join('', @{$menu_options{PRINTERS_DETECTION}}), undef, - sub { $options{PRINTERS_DETECTION} = $check_boxes{PRINTERS_DETECTION}->active }, undef, '<CheckItem>' ], - [ join('', @{$menu_options{MODEMS_DETECTION}}), undef, - sub { $options{MODEMS_DETECTION} = $check_boxes{MODEMS_DETECTION}->active }, undef, '<CheckItem>' ], - [ join('', @{$menu_options{JAZZ_DETECTION}}), undef, - sub { $options{JAZZ_DETECTION} = $check_boxes{JAZZ_DETECTION}->active }, undef, '<CheckItem>' ], - [ $menus{help}, undef, undef, undef, '<Branch>' ], - [ $menus{help}.N("/_Help"), undef, sub { unless (fork()) { exec("drakhelp Drakxtools-Guide.html/harddrake.html") } }, undef, '<CheckItem>' ], - [ $menus{help}.N("/_Fields description"), undef, sub { - if ($current_device) { - create_dialog(N("Harddrake help"), - N("Description of the fields:\n\n") - . join("\n\n", map { if_($fields{$_}[0], "$fields{$_}[0]: $fields{$_}[1]") } sort keys %$current_device)) - } else { - create_dialog(N("Select a device !"), N("Once you've selected a device, you'll be able to see the device information in fields displayed on the right frame (\"Information\")")) - } - }, - undef, '<CheckItem>' - ], - [ $menus{help}.N("/_Report Bug"), undef, sub { unless (fork()) { exec("drakbug --report harddrake2 &") } }, undef, '<CheckItem>' ], - [ $menus{help}.N("/_About..."), undef, sub { - create_dialog(N("About Harddrake"), - N("This is HardDrake, a Mandrake hardware configuration tool.\nVersion: %s -Author: Thierry Vignaud <tvignaud\@mandrakesoft.com>\n\n", $harddrake::data::version) . - formatAlaTeX($::license)); - }, undef, '<CheckItem>' - ] - ); - -$in = 'interactive'->vnew('su'); #require_root_capability(); - -my $wait = $in->wait_message(N("Please wait"), N("Detection in progress")); -gtkflush(); - -%options = getVarsFromSh($conffile); - -# Build the gui -add_icon_path('/usr/share/pixmaps/harddrake2/'); -$::noBorder = 1; -$w = ugtk2->new(N("Harddrake2 version %s", $harddrake::data::version)); -local $::main_window; # fake diagnostics pragma -my ($menubar, $factory, $opt_menu, $help_menu); -if ($::isEmbedded) { - ($menubar, $factory) = create_factory_popup_menu($::Plug, @menu_items); - $opt_menu = $factory->get_widget("<main>" . strip_first_underscore($menus{options})); - $help_menu = $factory->get_widget("<main>" . strip_first_underscore($menus{help})); -} else { - $::main_window = $w->{rwindow}; - ($menubar, $factory) = create_factory_menu($w->{rwindow}, @menu_items); - $w->{window}->set_size_request(805, 550); -} - -my $tree_model = Gtk2::TreeStore->new(Gtk2::GType->OBJECT, Gtk2::GType->STRING, Gtk2::GType->INT); -my ($statusbar, $sig_id); -$w->{window}->add(gtkpack_(0, Gtk2::VBox->new(0, 0), - if_(!$::isEmbedded, 0, $menubar), - 1, create_hpaned(gtkadd(Gtk2::Frame->new(N("Detected hardware")), - create_scrolled_window(gtkset_size_request(my $tree = Gtk2::TreeView->new_with_model($tree_model), 350, -1))), - gtkpack_(0, Gtk2::VBox->new(0, 0), - 1, gtkadd(my $frame = Gtk2::Frame->new(N("Information")), - create_scrolled_window(my $text = Gtk2::TextView->new)), - 0, my $module_cfg_button = gtksignal_connect(Gtk2::Button->new(N("Configure module")), - clicked => sub { - require modules::interactive; - modules::interactive::config_window($in, $current_device); - gtkset_mousecursor_normal(); - }), - 0, my $config_button = gtksignal_connect(Gtk2::Button->new(N("Run config tool")), - # we've a configurator, let's add a button for it and show it - clicked => sub { - return 1 if defined $pid; - if ($pid = fork()) { - $sig_id = $statusbar->push($statusbar->get_context_id("id"), - N("Running \"%s\" ...", $current_configurator)); - } else { - exec($current_configurator) or die "$current_configurator missing\n"; - } - }) - ), - ( 'resize1' => 0, shrink1 => 1, resize2 => 0, shrink2 => 1) - ), - 0, $statusbar = Gtk2::Statusbar->new, - if_($::isEmbedded, 0, gtkpack(create_hbox(), - gtksignal_connect(Gtk2::Button->new($menus{options}), 'event' => popup_menu($opt_menu), $menubar), - gtksignal_connect(Gtk2::Button->new($menus{help}), 'event' => popup_menu($help_menu), $menubar), - gtksignal_connect(Gtk2::Button->new(N("Quit")), - 'clicked' => \&quit_global), - ), - ) - ) - ); - -$frame->set_size_request(300, 450) unless $::isEmbedded; -# $tree->set_column_auto_resize(0, 1); -my (@data, @configurators); -$tree->append_column(my $pixcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererPixbuf->new, 'pixbuf' => 0)); -$tree->append_column(my $textcolumn = Gtk2::TreeViewColumn->new_with_attributes(undef, Gtk2::CellRendererText->new, 'text' => 1)); -$tree->set_headers_visible(0); -$tree->get_selection()->signal_connect('changed' => sub { - my ($select) = @_; - my ($model, $iter) = $select->get_selected(); - if ($model) { - my $idx = $model->get($iter, 2); - $iter->free; - $current_device = $data[$idx]; - - if ($idx ne -1) { - gtktext_insert($text, [ map { - - # The U+200E character is to force LTR display, as what what follows the colon is always in LTR (device names, paths, etc), - # this ensures proper displaying of names like /dev/fd0 (otherwise it gets 'dev/fd0/'). - # it must come *after* the space, as the space must follow the colon following the direction of writting. - if_($_ && $fields{$_}[0], [ $fields{$_}[0] . ": \x{200e}", { 'foreground' => 'royalblue3', 'weight' => Gtk2::Pango->WEIGHT_BOLD } ], - [ ($current_device->{$_} =~ /^(unknown)/ ? N("unknown") : - $current_device->{$_} =~ /^(Unknown)/ ? N("Unknown") : - $current_device->{$_} eq 'yes' ? N("Yes") : - $current_device->{$_} eq 'no' ? N("No") : - $current_device->{$_}) . "\n\n", { 'foreground' => ($_ eq 'driver' && $current_device->{$_} =~ /^unknown|^Bad:/ ? 'indian red' : 'black') } ]) - } sort keys %$current_device ]); - - foreach (keys %$current_device) { - print "Warning: skip \"$_\" field => \"$current_device->{$_}\"\n\n" unless $fields{$_}[0]; - }; - - # if we've valid driver, let's offer to configure it, else hide buttons - show_hide(defined($current_device->{driver}) && $current_device->{driver} !~ /^unknown|^Bad|^Card|^Hsf|^Removable:|\|/, $module_cfg_button); - - $current_configurator = $configurators[$idx]; - show_hide(-x first(split /\s+/, $current_configurator), $config_button); # strip arguments for -x test - return 1; - } - } - $text->get_buffer->set_text(N("Click on a device in the left tree in order to display its information here."), -1); - $config_button->hide; - $module_cfg_button->hide; -}); - -my $index = 0; - -# Fill the graphic devices tree with a "tree branch" widget per device category -foreach (@harddrake::data::tree) { - my ($Ident, $title, $icon, $configurator, $detector) = @$_; - next if ref($detector) ne "CODE"; #skip class witouth detector - next if $Ident =~ /(MODEM|PRINTER)/ && $::testing; - next if $Ident =~ /JAZZ/ && !$options{JAZZ_DETECTION}; - next if $Ident =~ /MODEM/ && !$options{MODEMS_DETECTION}; - next if $Ident =~ /PRINTER/ && !$options{PRINTERS_DETECTION}; - - my @devices = &$detector; - next unless @devices; # Skip empty class (no devices) - - my $parent_iter = $tree_model->append_set(undef, [ 0 => gtkcreate_pixbuf($icon), 1 => $title, 2 => -1 ]); - - # Fill the graphic tree with a "tree leaf" widget per device - foreach (@devices) { - # we really should test for $title there: - if ($_->{bus} && $_->{bus} eq "PCI") { - my $i = $_; - $_->{bus_id} = join ':', map { if_($i->{$_} ne "65535", sprintf("%lx", $i->{$_})) } qw(vendor id subvendor subid); - $_->{bus_location} = join ':', map { sprintf("%lx", $i->{$_}) } qw(pci_bus pci_device pci_function); - } - # split description into manufacturer/description - ($_->{Vendor}, $_->{description}) = split(/\|/, $_->{description}) if $_->{description}; - - if ($_->{val}) { # Scanner ? - my $val = $_->{val}; - ($_->{Vendor}, $_->{description}) = split(/\|/, $val->{DESCRIPTION}); - } - # EIDE detection incoherency: - if ($_->{bus} && $_->{bus} eq 'ide') { - $_->{channel} = $_->{channel} ? N("secondary") : N("primary"); - delete $_->{info}; - } elsif ($_->{bus} && $_->{bus} !~ /USB|PCI/) { - # SCSI detection incoherency: - my $i = $_; - $_->{bus_location} = join ':', map { sprintf("%lx", $i->{$_}) } qw(channel id lun); - } - if (defined $_->{capacity}) { - my ($burner, $dvd) = (N("burner"), N("DVD")); - $_->{capacity} =~ s/burner/$burner/; - $_->{capacity} =~ s/DVD/$dvd/; - } - $configurator .= harddrake::data::set_removable_configurator($Ident, $_); - if ($Ident eq "AUDIO") { - require harddrake::sound; - my $alter = harddrake::sound::get_alternative($_->{driver}); - my $alternative_drivers = join(':', @$alter) if $alter->[0] ne 'unknown'; - $_->{alternative_drivers} = $alternative_drivers if $alternative_drivers; - } - rename_field($_, 'usb_description', 'description'); - rename_field($_, 'vendor_name', 'Vendor'); - rename_field($_, 'usb_driver', 'driver'); - rename_field($_, 'usb_media_type', 'media_type'); - foreach my $i (qw(MOUSETYPE XMOUSETYPE auxmouse devfs_prefix id pci_bus pci_device pci_function subid subvendor unsafe usb_bus usb_pci_bus usb_pci_device usb_vendor val vendor wacom)) { delete $_->{$i} }; - - my $custom_id = harddrake::data::custom_id($_, $title); - foreach my $field (qw(devfs_device device)) { - $_->{$field} = '/dev/'.$_->{$field} if $_->{$field}; - } - $tree_model->append_set($parent_iter, [ 1 => $custom_id, 2 => $index++ ])->free; - push @data, $_; - push @configurators, $configurator; - } - $tree->expand_row($tree_model->get_path($parent_iter), 1) unless $title eq N("Unknown/Others"); - $parent_iter->free; -} - -$SIG{CHLD} = sub { - undef $pid; - $statusbar->pop($sig_id); - # reap zombies - my $child_pid; - do { $child_pid = waitpid(-1, POSIX::WNOHANG) } until $child_pid > 0; -}; - -$w->{rwindow}->signal_connect(delete_event => \&quit_global); -$w->{rwindow}->set_position('center') unless $::isEmbedded; - -foreach (keys %menu_options) { - my $title = strip_first_underscore(@{$menu_options{$_}}); - $options{$_} = 0 unless defined($options{$_}); # force detection by default - $check_boxes{$_} = $factory->get_widget("<main>" . $title); - $check_boxes{$_}->set_active($options{$_}); # restore saved values -} - -$textcolumn->set_min_width(350); -#$textcolumn->set_minmax_width(400); -$textcolumn->set_sizing('GTK_TREE_VIEW_COLUMN_AUTOSIZE');#GROW_ONLY -#$tree->columns_autosize(); -my $path = Gtk2::TreePath->new_first; -$path->down unless $::isEmbedded; -$tree->get_selection->select_path($path); -$path->free; -$w->{rwindow}->show_all; -undef $wait; -gtkset_mousecursor_normal(); -$_->hide foreach $module_cfg_button, $config_button; # hide buttons while no device -$w->main; - - -sub quit_global() { - kill(15, $pid) if $pid; - setVarsInSh($conffile, \%options); - ugtk2->exit(0); -} - -sub show_hide { - my ($bool, $button) = @_; - if ($bool) { $button->show } else { $button->hide } -} - - -sub strip_first_underscore { - join '', map { s/([^_]*)_(.*)/$1$2/; $_ } @_; -} - -sub rename_field { - my ($dev, $field, $new_field) = @_; - if ($dev->{$field}) { - if ($dev->{$new_field}) { - $dev->{$new_field} .= " ($dev->{$field})"; - } else { - $dev->{$new_field} = $dev->{$field}; - } - delete $dev->{$field}; - } -} - -sub popup_menu { - my ($menu) = @_; - sub { my (undef, $event) = @_; - if ($event->type eq 'button-press') { - $menu->popup(undef, undef, undef, undef, $event->button, $event->time); - # Tell calling code that we have handled this event; the buck stops here. - return 1; - } - # Tell calling code that we have not handled this event; pass it on. - return 0; - } -} diff --git a/perl-install/standalone/icons/categ.png b/perl-install/standalone/icons/categ.png Binary files differdeleted file mode 100644 index b466e0f43..000000000 --- a/perl-install/standalone/icons/categ.png +++ /dev/null diff --git a/perl-install/standalone/icons/drakTS.620x57.png b/perl-install/standalone/icons/drakTS.620x57.png Binary files differdeleted file mode 100644 index d4735df1d..000000000 --- a/perl-install/standalone/icons/drakTS.620x57.png +++ /dev/null diff --git a/perl-install/standalone/icons/drakbackup.540x57.png b/perl-install/standalone/icons/drakbackup.540x57.png Binary files differdeleted file mode 100644 index 18d207e5d..000000000 --- a/perl-install/standalone/icons/drakbackup.540x57.png +++ /dev/null diff --git a/perl-install/standalone/icons/drakconnect_step.png b/perl-install/standalone/icons/drakconnect_step.png Binary files differdeleted file mode 100644 index e2ddf46d7..000000000 --- a/perl-install/standalone/icons/drakconnect_step.png +++ /dev/null diff --git a/perl-install/standalone/icons/drakfont.620x57.png b/perl-install/standalone/icons/drakfont.620x57.png Binary files differdeleted file mode 100644 index da4527a7a..000000000 --- a/perl-install/standalone/icons/drakfont.620x57.png +++ /dev/null diff --git a/perl-install/standalone/icons/eth_card_mini2.png b/perl-install/standalone/icons/eth_card_mini2.png Binary files differdeleted file mode 100644 index 6efbe637c..000000000 --- a/perl-install/standalone/icons/eth_card_mini2.png +++ /dev/null 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 Binary files differdeleted file mode 100644 index 182adca81..000000000 --- a/perl-install/standalone/icons/gmon.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/cd.png b/perl-install/standalone/icons/harddrake2/cd.png Binary files differdeleted file mode 100644 index bafe8df2c..000000000 --- a/perl-install/standalone/icons/harddrake2/cd.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/cpu.png b/perl-install/standalone/icons/harddrake2/cpu.png Binary files differdeleted file mode 100644 index 404fd1bd6..000000000 --- a/perl-install/standalone/icons/harddrake2/cpu.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/floppy.png b/perl-install/standalone/icons/harddrake2/floppy.png Binary files differdeleted file mode 100644 index 65fc529d5..000000000 --- a/perl-install/standalone/icons/harddrake2/floppy.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/harddisk.png b/perl-install/standalone/icons/harddrake2/harddisk.png Binary files differdeleted file mode 100644 index a5505988b..000000000 --- a/perl-install/standalone/icons/harddrake2/harddisk.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/harddrake.png b/perl-install/standalone/icons/harddrake2/harddrake.png Binary files differdeleted file mode 100644 index 285a5db02..000000000 --- a/perl-install/standalone/icons/harddrake2/harddrake.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/hw_mouse.png b/perl-install/standalone/icons/harddrake2/hw_mouse.png Binary files differdeleted file mode 100644 index eff10b81b..000000000 --- a/perl-install/standalone/icons/harddrake2/hw_mouse.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/hw_network.png b/perl-install/standalone/icons/harddrake2/hw_network.png Binary files differdeleted file mode 100644 index d10e42acd..000000000 --- a/perl-install/standalone/icons/harddrake2/hw_network.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/hw_printer.png b/perl-install/standalone/icons/harddrake2/hw_printer.png Binary files differdeleted file mode 100644 index 3223db418..000000000 --- a/perl-install/standalone/icons/harddrake2/hw_printer.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/ide_hd.png b/perl-install/standalone/icons/harddrake2/ide_hd.png Binary files differdeleted file mode 100644 index 872a449a2..000000000 --- a/perl-install/standalone/icons/harddrake2/ide_hd.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/isdn.png b/perl-install/standalone/icons/harddrake2/isdn.png Binary files differdeleted file mode 100644 index f4da131d2..000000000 --- a/perl-install/standalone/icons/harddrake2/isdn.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/joystick.png b/perl-install/standalone/icons/harddrake2/joystick.png Binary files differdeleted file mode 100644 index 3f56d8126..000000000 --- a/perl-install/standalone/icons/harddrake2/joystick.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/keyboard.png b/perl-install/standalone/icons/harddrake2/keyboard.png Binary files differdeleted file mode 100644 index 04e6bd0e7..000000000 --- a/perl-install/standalone/icons/harddrake2/keyboard.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/memory.png b/perl-install/standalone/icons/harddrake2/memory.png Binary files differdeleted file mode 100644 index 1f6f57bed..000000000 --- a/perl-install/standalone/icons/harddrake2/memory.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu16.png b/perl-install/standalone/icons/harddrake2/menu/harddrake-menu16.png Binary files differdeleted file mode 100644 index 285a5db02..000000000 --- a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu16.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu32.png b/perl-install/standalone/icons/harddrake2/menu/harddrake-menu32.png Binary files differdeleted file mode 100644 index ceb1c7dca..000000000 --- a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu32.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu48.png b/perl-install/standalone/icons/harddrake2/menu/harddrake-menu48.png Binary files differdeleted file mode 100644 index e21b44956..000000000 --- a/perl-install/standalone/icons/harddrake2/menu/harddrake-menu48.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/modem.png b/perl-install/standalone/icons/harddrake2/modem.png Binary files differdeleted file mode 100644 index f070e6004..000000000 --- a/perl-install/standalone/icons/harddrake2/modem.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/multimedia.png b/perl-install/standalone/icons/harddrake2/multimedia.png Binary files differdeleted file mode 100644 index 86607e2d0..000000000 --- a/perl-install/standalone/icons/harddrake2/multimedia.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/scanner.png b/perl-install/standalone/icons/harddrake2/scanner.png Binary files differdeleted file mode 100644 index a8263f630..000000000 --- a/perl-install/standalone/icons/harddrake2/scanner.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/scsi.png b/perl-install/standalone/icons/harddrake2/scsi.png Binary files differdeleted file mode 100644 index 16bcfee25..000000000 --- a/perl-install/standalone/icons/harddrake2/scsi.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/scsi_hd.png b/perl-install/standalone/icons/harddrake2/scsi_hd.png Binary files differdeleted file mode 100644 index 16bcfee25..000000000 --- a/perl-install/standalone/icons/harddrake2/scsi_hd.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/sound.png b/perl-install/standalone/icons/harddrake2/sound.png Binary files differdeleted file mode 100644 index f4af73412..000000000 --- a/perl-install/standalone/icons/harddrake2/sound.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/tape.png b/perl-install/standalone/icons/harddrake2/tape.png Binary files differdeleted file mode 100644 index a298a64f4..000000000 --- a/perl-install/standalone/icons/harddrake2/tape.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/tv.png b/perl-install/standalone/icons/harddrake2/tv.png Binary files differdeleted file mode 100644 index aa71bb756..000000000 --- a/perl-install/standalone/icons/harddrake2/tv.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/unknown.png b/perl-install/standalone/icons/harddrake2/unknown.png Binary files differdeleted file mode 100644 index d6f6bbf2e..000000000 --- a/perl-install/standalone/icons/harddrake2/unknown.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/usb.png b/perl-install/standalone/icons/harddrake2/usb.png Binary files differdeleted file mode 100644 index b13505124..000000000 --- a/perl-install/standalone/icons/harddrake2/usb.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/video.png b/perl-install/standalone/icons/harddrake2/video.png Binary files differdeleted file mode 100644 index 69c9cfaa2..000000000 --- a/perl-install/standalone/icons/harddrake2/video.png +++ /dev/null diff --git a/perl-install/standalone/icons/harddrake2/webcam.png b/perl-install/standalone/icons/harddrake2/webcam.png Binary files differdeleted file mode 100644 index 3ca2ce2a6..000000000 --- a/perl-install/standalone/icons/harddrake2/webcam.png +++ /dev/null diff --git a/perl-install/standalone/icons/hori.png b/perl-install/standalone/icons/hori.png Binary files differdeleted file mode 100644 index 595805edf..000000000 --- a/perl-install/standalone/icons/hori.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic-drakfont-48.png b/perl-install/standalone/icons/ic-drakfont-48.png Binary files differdeleted file mode 100644 index c4473e6b5..000000000 --- a/perl-install/standalone/icons/ic-drakfont-48.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-CD-40.png b/perl-install/standalone/icons/ic82-CD-40.png Binary files differdeleted file mode 100644 index 5193e7335..000000000 --- a/perl-install/standalone/icons/ic82-CD-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-back-up-16.png b/perl-install/standalone/icons/ic82-back-up-16.png Binary files differdeleted file mode 100644 index 20188e863..000000000 --- a/perl-install/standalone/icons/ic82-back-up-16.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-back-up-32.png b/perl-install/standalone/icons/ic82-back-up-32.png Binary files differdeleted file mode 100644 index 8295f3725..000000000 --- a/perl-install/standalone/icons/ic82-back-up-32.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-back-up-48.png b/perl-install/standalone/icons/ic82-back-up-48.png Binary files differdeleted file mode 100644 index a974f8716..000000000 --- a/perl-install/standalone/icons/ic82-back-up-48.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-discdurwhat-40.png b/perl-install/standalone/icons/ic82-discdurwhat-40.png Binary files differdeleted file mode 100644 index 73bef43ac..000000000 --- a/perl-install/standalone/icons/ic82-discdurwhat-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-dossier-32.png b/perl-install/standalone/icons/ic82-dossier-32.png Binary files differdeleted file mode 100644 index 4502dad27..000000000 --- a/perl-install/standalone/icons/ic82-dossier-32.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-moreoption-40.png b/perl-install/standalone/icons/ic82-moreoption-40.png Binary files differdeleted file mode 100644 index d15130bea..000000000 --- a/perl-install/standalone/icons/ic82-moreoption-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-network-40.png b/perl-install/standalone/icons/ic82-network-40.png Binary files differdeleted file mode 100644 index 1d688ca48..000000000 --- a/perl-install/standalone/icons/ic82-network-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-others-40.png b/perl-install/standalone/icons/ic82-others-40.png Binary files differdeleted file mode 100644 index 6447a7eca..000000000 --- a/perl-install/standalone/icons/ic82-others-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-system-40.png b/perl-install/standalone/icons/ic82-system-40.png Binary files differdeleted file mode 100644 index 6b35675e8..000000000 --- a/perl-install/standalone/icons/ic82-system-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-users-40.png b/perl-install/standalone/icons/ic82-users-40.png Binary files differdeleted file mode 100644 index d9ae81534..000000000 --- a/perl-install/standalone/icons/ic82-users-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-when-40.png b/perl-install/standalone/icons/ic82-when-40.png Binary files differdeleted file mode 100644 index 2846435c8..000000000 --- a/perl-install/standalone/icons/ic82-when-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/ic82-where-40.png b/perl-install/standalone/icons/ic82-where-40.png Binary files differdeleted file mode 100644 index fdd6beb62..000000000 --- a/perl-install/standalone/icons/ic82-where-40.png +++ /dev/null diff --git a/perl-install/standalone/icons/mdk_logo.png b/perl-install/standalone/icons/mdk_logo.png Binary files differdeleted file mode 100644 index fe7bc4b4f..000000000 --- a/perl-install/standalone/icons/mdk_logo.png +++ /dev/null diff --git a/perl-install/standalone/icons/net_c.png b/perl-install/standalone/icons/net_c.png Binary files differdeleted file mode 100644 index 5688f4be1..000000000 --- a/perl-install/standalone/icons/net_c.png +++ /dev/null diff --git a/perl-install/standalone/icons/net_d.png b/perl-install/standalone/icons/net_d.png Binary files differdeleted file mode 100644 index 1bfdd3ef2..000000000 --- a/perl-install/standalone/icons/net_d.png +++ /dev/null diff --git a/perl-install/standalone/icons/net_u.png b/perl-install/standalone/icons/net_u.png Binary files differdeleted file mode 100644 index 5c4a16079..000000000 --- a/perl-install/standalone/icons/net_u.png +++ /dev/null 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 Binary files differdeleted file mode 100644 index 769f171c5..000000000 --- a/perl-install/standalone/icons/smbnfs_default.png +++ /dev/null diff --git a/perl-install/standalone/icons/smbnfs_has_mntpoint.png b/perl-install/standalone/icons/smbnfs_has_mntpoint.png Binary files differdeleted file mode 100644 index 213ec9eac..000000000 --- a/perl-install/standalone/icons/smbnfs_has_mntpoint.png +++ /dev/null diff --git a/perl-install/standalone/icons/smbnfs_mounted.png b/perl-install/standalone/icons/smbnfs_mounted.png Binary files differdeleted file mode 100644 index f799b33d1..000000000 --- a/perl-install/standalone/icons/smbnfs_mounted.png +++ /dev/null diff --git a/perl-install/standalone/icons/smbnfs_server.png b/perl-install/standalone/icons/smbnfs_server.png Binary files differdeleted file mode 100644 index 92af7a316..000000000 --- a/perl-install/standalone/icons/smbnfs_server.png +++ /dev/null diff --git a/perl-install/standalone/icons/tradi.png b/perl-install/standalone/icons/tradi.png Binary files differdeleted file mode 100644 index a9b19f468..000000000 --- a/perl-install/standalone/icons/tradi.png +++ /dev/null diff --git a/perl-install/standalone/icons/verti.png b/perl-install/standalone/icons/verti.png Binary files differdeleted file mode 100644 index 6bc84225b..000000000 --- a/perl-install/standalone/icons/verti.png +++ /dev/null diff --git a/perl-install/standalone/icons/wiz_default_left.png b/perl-install/standalone/icons/wiz_default_left.png Binary files differdeleted file mode 100644 index 2300ab36e..000000000 --- a/perl-install/standalone/icons/wiz_default_left.png +++ /dev/null diff --git a/perl-install/standalone/icons/wiz_default_up.png b/perl-install/standalone/icons/wiz_default_up.png Binary files differdeleted file mode 100644 index c7c7f586f..000000000 --- a/perl-install/standalone/icons/wiz_default_up.png +++ /dev/null diff --git a/perl-install/standalone/icons/wiz_drakconnect.png b/perl-install/standalone/icons/wiz_drakconnect.png Binary files differdeleted file mode 100644 index d2e4574b4..000000000 --- a/perl-install/standalone/icons/wiz_drakconnect.png +++ /dev/null diff --git a/perl-install/standalone/icons/wiz_drakgw.png b/perl-install/standalone/icons/wiz_drakgw.png Binary files differdeleted file mode 100644 index b8b60fe7b..000000000 --- a/perl-install/standalone/icons/wiz_drakgw.png +++ /dev/null diff --git a/perl-install/standalone/icons/wiz_firewall.png b/perl-install/standalone/icons/wiz_firewall.png Binary files differdeleted file mode 100644 index c7c7f586f..000000000 --- a/perl-install/standalone/icons/wiz_firewall.png +++ /dev/null diff --git a/perl-install/standalone/icons/wiz_logdrake.png b/perl-install/standalone/icons/wiz_logdrake.png Binary files differdeleted file mode 100644 index 05d3b63b2..000000000 --- a/perl-install/standalone/icons/wiz_logdrake.png +++ /dev/null diff --git a/perl-install/standalone/icons/wiz_printerdrake.png b/perl-install/standalone/icons/wiz_printerdrake.png Binary files differdeleted file mode 100644 index 77d58df2c..000000000 --- a/perl-install/standalone/icons/wiz_printerdrake.png +++ /dev/null diff --git a/perl-install/standalone/icons/wiz_scannerdrake.png b/perl-install/standalone/icons/wiz_scannerdrake.png Binary files differdeleted file mode 100644 index c7c7f586f..000000000 --- a/perl-install/standalone/icons/wiz_scannerdrake.png +++ /dev/null diff --git a/perl-install/standalone/interactive_http/Makefile b/perl-install/standalone/interactive_http/Makefile deleted file mode 100644 index 5607112c9..000000000 --- a/perl-install/standalone/interactive_http/Makefile +++ /dev/null @@ -1,21 +0,0 @@ -NAME=libDrakX -FNAME=$(NAME)/drakxtools_http -PREFIX= -DATADIR=$(PREFIX)/usr/share - -all: index.html - -index.html: index.html.pl - perl $^ > $@ - -install: - install -D miniserv.init $(PREFIX)/etc/init.d/drakxtools_http - install -D -m 644 authorised_progs $(PREFIX)/etc/drakxtools_http/authorised_progs - install -D -m 644 miniserv.conf $(PREFIX)/etc/drakxtools_http/conf - install -D -m 644 miniserv.pam $(PREFIX)/etc/pam.d/miniserv - install -D -m 644 miniserv.logrotate $(PREFIX)/etc/logrotate.d/drakxtools-http - - install -d $(DATADIR)/$(FNAME)/www - install -m 644 miniserv.pl miniserv.pem miniserv.users $(DATADIR)/$(FNAME) - install -m 644 index.html $(DATADIR)/$(FNAME)/www - install interactive_http.cgi $(DATADIR)/$(FNAME)/www diff --git a/perl-install/standalone/interactive_http/authorised_progs b/perl-install/standalone/interactive_http/authorised_progs deleted file mode 100644 index fe95e2768..000000000 --- a/perl-install/standalone/interactive_http/authorised_progs +++ /dev/null @@ -1,12 +0,0 @@ -/usr/sbin/XFdrake -/usr/sbin/adduserdrake -/usr/sbin/diskdrake -/usr/sbin/drakautoinst -/usr/sbin/drakboot -/usr/sbin/drakgw -/usr/sbin/drakconnect -/usr/sbin/drakxservices -/usr/sbin/keyboarddrake -/usr/sbin/mousedrake -/usr/sbin/printerdrake -/usr/sbin/tinyfirewall diff --git a/perl-install/standalone/interactive_http/index.html.pl b/perl-install/standalone/interactive_http/index.html.pl deleted file mode 100644 index afd91459b..000000000 --- a/perl-install/standalone/interactive_http/index.html.pl +++ /dev/null @@ -1,14 +0,0 @@ -use MDK::Common; - -print '<html> -'; -foreach (map { chomp_($_) } cat_('authorised_progs')) { - my $name = basename($_); - print -qq(<a href="/interactive_http.cgi?state=new&prog=$_">$name</a> -<br> -); -} -print ' -</html> -'; diff --git a/perl-install/standalone/interactive_http/interactive_http.cgi b/perl-install/standalone/interactive_http/interactive_http.cgi deleted file mode 100755 index 935a4a765..000000000 --- a/perl-install/standalone/interactive_http/interactive_http.cgi +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); -use CGI; -use common; -use c; - -my $q = CGI->new; -$| = 1; - -my $script_name = $q->url(-relative => 1); - -# name inversed (must be in sync with interactive_http.html) -my $pipe_r = "/tmp/interactive_http_w"; -my $pipe_w = "/tmp/interactive_http_r"; - -if ($q->param('state') eq 'new') { - force_exit_dead_prog(); - mkfifo($pipe_r); mkfifo($pipe_w); - - spawn_server($q->param('prog')); - first_step(); - -} elsif ($q->param('state') eq 'next_step') { - next_step(); -} else { - error("booh..."); -} - -sub read_ { - local *F; - open F, "<$pipe_r" or error("Failed to connect to the prog"); - my $t; - print $t while sysread F, $t, 1; -} -sub write_ { - local *F; - open F, ">$pipe_w" or die; - my $q = CGI->new; - $q->save(\*F); -} - -sub first_step { read_() } -sub next_step { write_(); read_() } - - -sub force_exit_dead_prog { - -p $pipe_w or return; - { - local *F; - sysopen F, $pipe_w, 1 | c::O_NONBLOCK() or return; - syswrite F, "force_exit_dead_prog=1\n"; - } - - my $cnt = 10; - while (-p $pipe_w) { - sleep 1; - $cnt-- or error("Dead prog failed to exit"); - } -} - -sub spawn_server { - my ($prog) = @_; - - my @authorised_progs = map { chomp_($_) } cat_('/etc/drakxtools_http/authorised_progs'); - member($prog, @authorised_progs) or error("You tried to call a non-authorised program"); - - fork and return; - - $ENV{INTERACTIVE_HTTP} = $script_name; - - open STDIN, "</dev/zero"; - open STDOUT, ">/dev/null"; #tmp/log"; - open STDERR, ">&STDOUT"; - - c::setsid(); - exec $prog or die "prog $prog not found\n"; -} - -sub error { - my $msg = join '', @_; - - print $q->header(), $q->start_html(); - print $q->h1(_("Error")), @_; - print $q->end_html(), "\n"; - exit 0; -} - -sub mkfifo { - my ($f) = @_; - -p $f and return; - unlink $f; - syscall_('mknod', $f, c::S_IFIFO() | 0600, 0) or die "mkfifo failed"; - chmod 0666, $f; -} diff --git a/perl-install/standalone/interactive_http/miniserv.conf b/perl-install/standalone/interactive_http/miniserv.conf deleted file mode 100644 index 99f6a5172..000000000 --- a/perl-install/standalone/interactive_http/miniserv.conf +++ /dev/null @@ -1,13 +0,0 @@ -ssl=1 -log=1 -port=10001 -listen=10001 -forkcgis=1 -realm=Drakxtools Server - -addtype_cgi=internal/cgi -logfile=/var/log/drakxtools_http.log -pidfile=/var/run/drakxtools_http.pid -root=/usr/share/libDrakX/drakxtools_http/www -keyfile=/usr/share/libDrakX/drakxtools_http/miniserv.pem -userfile=/usr/share/libDrakX/drakxtools_http/miniserv.users diff --git a/perl-install/standalone/interactive_http/miniserv.init b/perl-install/standalone/interactive_http/miniserv.init deleted file mode 100644 index c9aaf9aeb..000000000 --- a/perl-install/standalone/interactive_http/miniserv.init +++ /dev/null @@ -1,60 +0,0 @@ -#!/bin/sh -# chkconfig: 235 99 00 -# description: Start or stop the miniserv administration server - -# Source function library. -. /etc/rc.d/init.d/functions - -subsys=/var/lock/subsys/drakxtools_http -name=drakxtools_http -server=/usr/share/libDrakX/$name/miniserv.pl - -start () -{ - action "Starting $name: " perl $server /etc/$name/conf - touch $subsys - echo $name -} - -stop () -{ - action "Shutting down $name: " kill `cat /var/run/$name.pid` - rm -f $subsys - echo $name -} - -restart () -{ - stop - start -} - -case "$1" in -'start') - start;; -'stop') - stop;; -'status') - if [ -s /var/run/$name.pid ]; then - pid=`cat /var/run/$name.pid` - kill -0 $pid >/dev/null 2>&1 - if [ "$?" = "0" ]; then - echo "$name (pid $pid) is running" - else - echo "$name is stopped" - fi - else - echo "$name is stopped" - fi - ;; -'restart') - restart;; -'reload') - restart;; -'condrestart') - [[ -f $subsys ]] && restart;; -*) - echo "Usage: $0 {start|stop|restart|status|reload|condrestart}" - ;; -esac -exit 0 diff --git a/perl-install/standalone/interactive_http/miniserv.logrotate b/perl-install/standalone/interactive_http/miniserv.logrotate deleted file mode 100644 index b1e833f9b..000000000 --- a/perl-install/standalone/interactive_http/miniserv.logrotate +++ /dev/null @@ -1,7 +0,0 @@ -# Logrotate file for drakxtools-http RPM - -/var/log/drakxtools_http.log { - weekly - notifempty - missingok -} diff --git a/perl-install/standalone/interactive_http/miniserv.pam b/perl-install/standalone/interactive_http/miniserv.pam deleted file mode 100644 index 37eae44e0..000000000 --- a/perl-install/standalone/interactive_http/miniserv.pam +++ /dev/null @@ -1,5 +0,0 @@ -#%PAM-1.0 -auth required /lib/security/pam_stack.so service=system-auth -account required /lib/security/pam_stack.so service=system-auth -password required /lib/security/pam_stack.so service=system-auth -session required /lib/security/pam_stack.so service=system-auth diff --git a/perl-install/standalone/interactive_http/miniserv.pem b/perl-install/standalone/interactive_http/miniserv.pem deleted file mode 100644 index e11919e37..000000000 --- a/perl-install/standalone/interactive_http/miniserv.pem +++ /dev/null @@ -1,18 +0,0 @@ ------BEGIN RSA PRIVATE KEY----- -MIIBOgIBAAJBANaRBV7X6DWUbTm8KBjjHx4CAHVSQCmei8QIwruVPngwOkEhsgzf -IT1IY6jyY3QM6a4ASl7xokoy5U4QZ8E/q40CAwEAAQJBAIwMLA0zr4UJVCGTBjj4 -RZ84f0QUY3zG10Mk1LXLO/MFlRol+640x/PB76fPKP+Gx+88s8F6lcx7uV+jB0bM -F6ECIQD3aYxjgxLinAmTjZf5gJDm/5LeEogML7nJ+aXJs8oAFwIhAN4DnKUfjiim -pOowhaRqy8b9fjXG8L+SG/+KcZDsWzP7AiBO2gXTRVgEfwSSUUNJUo9b/8I4IqHX -eHJ3C6ip8zIC+wIgdhsVygHvblC4ip0le0IVBdb0vUcH6+GeY2MS5zXVjuECIEP0 -GLnMXcQ02f8rQz0eeBYVHTNXKRMesgo3ZNcpDB2k ------END RSA PRIVATE KEY----- ------BEGIN CERTIFICATE----- -MIIBNTCB4AIBADANBgkqhkiG9w0BAQQFADAmMRgwFgYDVQQKEw9XZWJtaW4gU29m -dHdhcmUxCjAIBgNVBAMUASowHhcNOTgwMTAzMTAzNDUwWhcNMDcxMDAzMTAzNDUw -WjAmMRgwFgYDVQQKEw9XZWJtaW4gU29mdHdhcmUxCjAIBgNVBAMUASowXDANBgkq -hkiG9w0BAQEFAANLADBIAkEA1pEFXtfoNZRtObwoGOMfHgIAdVJAKZ6LxAjCu5U+ -eDA6QSGyDN8hPUhjqPJjdAzprgBKXvGiSjLlThBnwT+rjQIDAQABMA0GCSqGSIb3 -DQEBBAUAA0EAFCoYeLlWcClpv2sSc7zIchsMR3DKeH/O1ZtfEezzkaonre78HeYV -wSQvuoVleb7A497TFcSB6+FON6azoVqPyQ== ------END CERTIFICATE----- diff --git a/perl-install/standalone/interactive_http/miniserv.pl b/perl-install/standalone/interactive_http/miniserv.pl deleted file mode 100644 index b11ce26e2..000000000 --- a/perl-install/standalone/interactive_http/miniserv.pl +++ /dev/null @@ -1,1817 +0,0 @@ -#!/usr/bin/perl -# A very simple perl web server used by Webmin - -# Require basic libraries -package miniserv; -use Socket; -use POSIX; -use Sys::Hostname; - -# Find and read config file -if (@ARGV != 1) { - die "Usage: miniserv.pl <config file>"; - } -if ($ARGV[0] =~ /^\//) { - $conf = $ARGV[0]; - } -else { - chop($pwd = `pwd`); - $conf = "$pwd/$ARGV[0]"; - } -open(CONF, $conf) || die "Failed to open config file $conf : $!"; -while(<CONF>) { - s/\r|\n//g; - if (/^#/ || !/\S/) { next; } - /^([^=]+)=(.*)$/; - $name = $1; $val = $2; - $name =~ s/^\s+//g; $name =~ s/\s+$//g; - $val =~ s/^\s+//g; $val =~ s/\s+$//g; - $config{$name} = $val; - } -close(CONF); - -# Check is SSL is enabled and available -if ($config{'ssl'}) { - eval "use Net::SSLeay"; - if (!$@) { - $use_ssl = 1; - # These functions only exist for SSLeay 1.0 - eval "Net::SSLeay::SSLeay_add_ssl_algorithms()"; - eval "Net::SSLeay::load_error_strings()"; - if (defined(&Net::SSLeay::X509_STORE_CTX_get_current_cert) && - defined(&Net::SSLeay::CTX_load_verify_locations) && - defined(&Net::SSLeay::CTX_set_verify)) { - $client_certs = 1; - } - } - } - -# Check if the syslog module is available to log hacking attempts -if ($config{'syslog'}) { - eval "use Sys::Syslog qw(:DEFAULT setlogsock)"; - if (!$@) { - $use_syslog = 1; - } - } - -# check if the PAM module is available to authenticate -eval "use Authen::PAM"; -if (!$@) { - # check if the PAM authentication can be used by opening a handle - if (! ref($pamh = new Authen::PAM("miniserv", "root", \&pam_conv_func))) { - print STDERR "PAM module available, but error during init !\n"; - print STDERR "Disabling PAM functions.\n"; - } - else { - $use_pam = 1; - } - } - -# check if the TCP-wrappers module is available -if ($config{'libwrap'}) { - eval "use Authen::Libwrap qw(hosts_ctl STRING_UNKNOWN)"; - if (!$@) { - $use_libwrap = 1; - } - } - -# Get miniserv's perl path and location -$miniserv_path = $0; -open(SOURCE, $miniserv_path); -<SOURCE> =~ /^#!(\S+)/; $perl_path = $1; -close(SOURCE); -@miniserv_argv = @ARGV; - -# Check vital config options -%vital = ("port", 80, - "root", "./", - "server", "MiniServ/0.01", - "index_docs", "index.html index.htm index.cgi", - "addtype_html", "text/html", - "addtype_txt", "text/plain", - "addtype_gif", "image/gif", - "addtype_jpg", "image/jpeg", - "addtype_jpeg", "image/jpeg", - "realm", "MiniServ", - "session_login", "/session_login.cgi" - ); -foreach $v (keys %vital) { - if (!$config{$v}) { - if ($vital{$v} eq "") { - die "Missing config option $v"; - } - $config{$v} = $vital{$v}; - } - } -if (!$config{'sessiondb'}) { - $config{'pidfile'} =~ /^(.*)\/[^\/]+$/; - $config{'sessiondb'} = "$1/sessiondb"; - } -die "Session authentication cannot be used in inetd mode" - if ($config{'inetd'} && $config{'session'}); - -# init days and months for http_date -@weekday = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" ); -@month = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ); - -# Change dir to the server root -chdir($config{'root'}); -$user_homedir = (getpwuid($<))[7]; - -# Read users file -if ($config{'userfile'}) { - open(USERS, $config{'userfile'}); - while(<USERS>) { - s/\r|\n//g; - local @user = split(/:/, $_); - $users{$user[0]} = $user[1]; - $certs{$user[0]} = $user[3] if ($user[3]); - if ($user[4] =~ /^allow\s+(.*)/) { - $allow{$user[0]} = [ &to_ipaddress(split(/\s+/, $1)) ]; - } - elsif ($user[4] =~ /^deny\s+(.*)/) { - $deny{$user[0]} = [ &to_ipaddress(split(/\s+/, $1)) ]; - } - } - close(USERS); - } - -# Setup SSL if possible and if requested -if ($use_ssl) { - $ssl_ctx = Net::SSLeay::CTX_new() || - die "Failed to create SSL context : $!"; - $client_certs = 0 if (!$config{'ca'} || !%certs); - if ($client_certs) { - Net::SSLeay::CTX_load_verify_locations( - $ssl_ctx, $config{'ca'}, ""); - Net::SSLeay::CTX_set_verify( - $ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client); - } - - Net::SSLeay::CTX_use_RSAPrivateKey_file( - $ssl_ctx, $config{'keyfile'}, - &Net::SSLeay::FILETYPE_PEM) || die "Failed to open SSL key"; - Net::SSLeay::CTX_use_certificate_file( - $ssl_ctx, $config{'keyfile'}, - &Net::SSLeay::FILETYPE_PEM); - } - -# Setup syslog support if possible and if requested -if ($use_syslog) { - eval { openlog("miniserv", "cons,pid,ndelay", "daemon") }; - $use_syslog = 0 if ($@); - } - -# Read MIME types file and add extra types -if ($config{"mimetypes"} ne "") { - open(MIME, $config{"mimetypes"}); - while(<MIME>) { - chop; s/#.*$//; - if (/^(\S+)\s+(.*)$/) { - $type = $1; @exts = split(/\s+/, $2); - foreach $ext (@exts) { - $mime{$ext} = $type; - } - } - } - close(MIME); - } -foreach $k (keys %config) { - if ($k !~ /^addtype_(.*)$/) { next; } - $mime{$1} = $config{$k}; - } - -# get the time zone -if ($config{'log'}) { - local(@gmt, @lct, $days, $hours, $mins); - @make_date_marr = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); - @gmt = gmtime(time()); - @lct = localtime(time()); - $days = $lct[3] - $gmt[3]; - $hours = ($days < -1 ? 24 : 1 < $days ? -24 : $days * 24) + - $lct[2] - $gmt[2]; - $mins = $hours * 60 + $lct[1] - $gmt[1]; - $timezone = ($mins < 0 ? "-" : "+"); $mins = abs($mins); - $timezone .= sprintf "%2.2d%2.2d", $mins/60, $mins%60; - } - -if ($config{'inetd'}) { - # We are being run from inetd - go direct to handling the request - $SIG{'HUP'} = 'IGNORE'; - $SIG{'TERM'} = 'DEFAULT'; - $SIG{'PIPE'} = 'DEFAULT'; - open(SOCK, "+>&STDIN"); - - # Check if it is time for the logfile to be cleared - if ($config{'logclear'}) { - local $write_logtime = 0; - local @st = stat("$config{'logfile'}.time"); - if (@st) { - if ($st[9]+$config{'logtime'}*60*60 < time()){ - # need to clear log - $write_logtime = 1; - unlink($config{'logfile'}); - } - } - else { $write_logtime = 1; } - if ($write_logtime) { - open(LOGTIME, ">$config{'logfile'}.time"); - print LOGTIME time(),"\n"; - close(LOGTIME); - } - } - - # Initialize SSL for this connection - if ($use_ssl) { - $ssl_con = Net::SSLeay::new($ssl_ctx); - Net::SSLeay::set_fd($ssl_con, fileno(SOCK)); - #Net::SSLeay::use_RSAPrivateKey_file( - # $ssl_con, $config{'keyfile'}, - # &Net::SSLeay::FILETYPE_PEM); - #Net::SSLeay::use_certificate_file( - # $ssl_con, $config{'keyfile'}, - # &Net::SSLeay::FILETYPE_PEM); - Net::SSLeay::accept($ssl_con) || exit; - } - - # Work out the hostname for this web server - if (!$config{'host'}) { - ($myport, $myaddr) = - unpack_sockaddr_in(getsockname(SOCK)); - $myname = gethostbyaddr($myaddr, AF_INET); - if ($myname eq "") { - $myname = inet_ntoa($myaddr); - } - $host = $myname; - } - else { $host = $config{'host'}; } - $port = $config{'port'}; - - while(&handle_request(getpeername(SOCK), getsockname(SOCK))) { } - close(SOCK); - exit; - } - -# Open main socket -$proto = getprotobyname('tcp'); -socket(MAIN, PF_INET, SOCK_STREAM, $proto) || - die "Failed to open main socket : $!"; -setsockopt(MAIN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)); -$baddr = $config{"bind"} ? inet_aton($config{"bind"}) : INADDR_ANY; -for($i=0; $i<5; $i++) { - last if (bind(MAIN, sockaddr_in($config{port}, $baddr))); - sleep(1); - } -die "Failed to bind port $config{port} : $!" if ($i == 5); -listen(MAIN, SOMAXCONN); - -if ($config{'listen'}) { - # Open the socket that allows other miniserv servers to find this one - $proto = getprotobyname('udp'); - if (socket(LISTEN, PF_INET, SOCK_DGRAM, $proto)) { - setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)); - bind(LISTEN, sockaddr_in($config{'listen'}, INADDR_ANY)); - listen(LISTEN, SOMAXCONN); - } - else { - print STDERR "Failed to open listening socket : $!\n"; - $config{'listen'} = 0; - } - } - - -# Split from the controlling terminal -if (fork()) { exit; } -setsid(); - -# write out the PID file -open(PIDFILE, "> $config{'pidfile'}"); -printf PIDFILE "%d\n", getpid(); -close(PIDFILE); - -# Start the log-clearing process, if needed. This checks every minute -# to see if the log has passed its reset time, and if so clears it -if ($config{'logclear'}) { - if (!($logclearer = fork())) { - while(1) { - local $write_logtime = 0; - local @st = stat("$config{'logfile'}.time"); - if (@st) { - if ($st[9]+$config{'logtime'}*60*60 < time()){ - # need to clear log - $write_logtime = 1; - unlink($config{'logfile'}); - } - } - else { $write_logtime = 1; } - if ($write_logtime) { - open(LOGTIME, ">$config{'logfile'}.time"); - print LOGTIME time(),"\n"; - close(LOGTIME); - } - sleep(5*60); - } - exit; - } - push(@childpids, $logclearer); - } - -# Setup the logout time dbm if needed -if ($config{'session'}) { - eval "use SDBM_File"; - dbmopen(%sessiondb, $config{'sessiondb'}, 0700); - eval { $sessiondb{'1111111111'} = 'foo bar' }; - if ($@) { - dbmclose(%sessiondb); - eval "use NDBM_File"; - dbmopen(%sessiondb, $config{'sessiondb'}, 0700); - } - } - -# Run the main loop -$SIG{'HUP'} = 'miniserv::trigger_restart'; -$SIG{'TERM'} = 'miniserv::term_handler'; -$SIG{'PIPE'} = 'IGNORE'; -@deny = &to_ipaddress(split(/\s+/, $config{"deny"})); -@allow = &to_ipaddress(split(/\s+/, $config{"allow"})); -$p = 0; -while(1) { - # wait for a new connection, or a message from a child process - undef($rmask); - vec($rmask, fileno(MAIN), 1) = 1; - if ($config{'passdelay'} || $config{'session'}) { - for($i=0; $i<@passin; $i++) { - vec($rmask, fileno($passin[$i]), 1) = 1; - } - } - vec($rmask, fileno(LISTEN), 1) = 1 if ($config{'listen'}); - - local $sel = select($rmask, undef, undef, 10); - if ($need_restart) { &restart_miniserv(); } - local $time_now = time(); - - # Clean up finished processes - local($pid); - do { $pid = waitpid(-1, WNOHANG); - @childpids = grep { $_ != $pid } @childpids; - } while($pid > 0); - - # run the unblocking procedure to check if enough time has passed to - # unblock hosts that heve been blocked because of password failures - if ($config{'blockhost_failures'}) { - $i = 0; - while ($i <= $#deny) { - if ($blockhosttime{$deny[$i]} && $config{'blockhost_time'} != 0 && - ($time_now - $blockhosttime{$deny[$i]}) >= $config{'blockhost_time'}) { - # the host can be unblocked now - $hostfail{$deny[$i]} = 0; - splice(@deny, $i, 1); - } - $i++; - } - } - - if ($config{'session'}) { - # Remove sessions with more than 7 days of inactivity - foreach $s (keys %sessiondb) { - local ($user, $ltime) = split(/\s+/, $sessiondb{$s}); - if ($time_now - $ltime > 7*24*60*60) { - delete($sessiondb{$s}); - } - } - } - next if ($sel <= 0); - if (vec($rmask, fileno(MAIN), 1)) { - # got new connection - $acptaddr = accept(SOCK, MAIN); - if (!$acptaddr) { next; } - - # create pipes - if ($config{'passdelay'} || $config{'session'}) { - $PASSINr = "PASSINr$p"; $PASSINw = "PASSINw$p"; - $PASSOUTr = "PASSOUTr$p"; $PASSOUTw = "PASSOUTw$p"; - $p++; - pipe($PASSINr, $PASSINw); - pipe($PASSOUTr, $PASSOUTw); - select($PASSINw); $| = 1; select($PASSINr); $| = 1; - select($PASSOUTw); $| = 1; select($PASSOUTw); $| = 1; - } - select(STDOUT); - - # Check username of connecting user - local ($peerp, $peera) = unpack_sockaddr_in($acptaddr); - $localauth_user = undef; - if ($config{'localauth'} && inet_ntoa($peera) eq "127.0.0.1") { - if (open(TCP, "/proc/net/tcp")) { - # Get the info direct from the kernel - while(<TCP>) { - s/^\s+//; - local @t = split(/[\s:]+/, $_); - if ($t[1] eq '0100007F' && - $t[2] eq sprintf("%4.4X", $peerp)) { - $localauth_user = getpwuid($t[11]); - last; - } - } - close(TCP); - } - else { - # Call lsof for the info - local $lsofpid = open(LSOF, - "$config{'localauth'} -i TCP\@127.0.0.1:$peerp |"); - while(<LSOF>) { - if (/^(\S+)\s+(\d+)\s+(\S+)/ && - $2 != $$ && $2 != $lsofpid) { - $localauth_user = $3; - } - } - close(LSOF); - } - } - - # fork the subprocess - if (!($handpid = fork())) { - # setup signal handlers - $SIG{'TERM'} = 'DEFAULT'; - $SIG{'PIPE'} = 'DEFAULT'; - #$SIG{'CHLD'} = 'IGNORE'; - $SIG{'HUP'} = 'IGNORE'; - - # Initialize SSL for this connection - if ($use_ssl) { - $ssl_con = Net::SSLeay::new($ssl_ctx); - Net::SSLeay::set_fd($ssl_con, fileno(SOCK)); - #Net::SSLeay::use_RSAPrivateKey_file( - # $ssl_con, $config{'keyfile'}, - # &Net::SSLeay::FILETYPE_PEM); - #Net::SSLeay::use_certificate_file( - # $ssl_con, $config{'keyfile'}, - # &Net::SSLeay::FILETYPE_PEM); - Net::SSLeay::accept($ssl_con) || exit; - } - - # close useless pipes - if ($config{'passdelay'} || $config{'session'}) { - foreach $p (@passin) { close($p); } - foreach $p (@passout) { close($p); } - close($PASSINr); close($PASSOUTw); - } - close(MAIN); - - # Work out the hostname for this web server - if (!$config{'host'}) { - ($myport, $myaddr) = - unpack_sockaddr_in(getsockname(SOCK)); - $myname = gethostbyaddr($myaddr, AF_INET); - if ($myname eq "") { - $myname = inet_ntoa($myaddr); - } - $host = $myname; - } - else { $host = $config{'host'}; } - $port = $config{'port'}; - - local $switched = 0; - if ($config{'remoteuser'} && $localauth_user && !$<) { - # Switch to the UID of the remote user - local @u = getpwnam($localauth_user); - if (@u) { - $( = $u[3]; $) = "$u[3] $u[3]"; - $< = $> = $u[2]; - $switched = 1; - } - } - if ($config{'switchuser'} && !$< && !$switched) { - # Switch to the UID of server user - local @u = getpwnam($config{'switchuser'}); - if (@u) { - $( = $u[3]; $) = "$u[3] $u[3]"; - $< = $> = $u[2]; - } - } - - while(&handle_request($acptaddr, getsockname(SOCK))) { } - shutdown(SOCK, 1); - close(SOCK); - close($PASSINw); close($PASSOUTw); - exit; - } - push(@childpids, $handpid); - if ($config{'passdelay'} || $config{'session'}) { - close($PASSINw); close($PASSOUTr); - push(@passin, $PASSINr); push(@passout, $PASSOUTw); - } - close(SOCK); - } - - if ($config{'listen'} && vec($rmask, fileno(LISTEN), 1)) { - # Got UDP packet from another miniserv server - local $rcvbuf; - local $from = recv(LISTEN, $rcvbuf, 1024, 0); - next if (!$from); - local $fromip = inet_ntoa((unpack_sockaddr_in($from))[1]); - local $toip = inet_ntoa((unpack_sockaddr_in( - getsockname(LISTEN)))[1]); - if ((!@deny || !&ip_match($fromip, $toip, @deny)) && - (!@allow || &ip_match($fromip, $toip, @allow))) { - send(LISTEN, "$config{'host'}:$config{'port'}:". - "$use_ssl", 0, $from); - } - } - - # check for password-timeout messages from subprocesses - for($i=0; $i<@passin; $i++) { - if (vec($rmask, fileno($passin[$i]), 1)) { - # this sub-process is asking about a password - $infd = $passin[$i]; $outfd = $passout[$i]; - $inline = <$infd>; - if ($inline =~ /^delay\s+(\S+)\s+(\S+)\s+(\d+)/) { - # Got a delay request from a subprocess.. for - # valid logins, there is no delay (to prevent - # denial of service attacks), but for invalid - # logins the delay increases with each failed - # attempt. - if ($3) { - # login OK.. no delay - print $outfd "0 0\n"; - $hostfail{$2} = 0; - } - else { - # login failed.. - $hostfail{$2}++; - # add the host to the block list if necessary - if ($config{'blockhost_failures'} && - $hostfail{$2} >= $config{'blockhost_failures'}) { - push(@deny, $2); - $blockhosttime{$2} = $time_now; - $blocked = 1; - if ($use_syslog) { - local $logtext = "Security alert: Host $2 ". - "blocked after $config{'blockhost_failures'} ". - "failed logins for user $1"; - syslog("crit", $logtext); - } - } - else { - $blocked = 0; - } - $dl = $userdlay{$1} - - int(($time_now - $userlast{$1})/50); - $dl = $dl < 0 ? 0 : $dl+1; - print $outfd "$dl $blocked\n"; - $userdlay{$1} = $dl; - } - $userlast{$1} = $time_now; - } - elsif ($inline =~ /^verify\s+(\S+)/) { - # Verifying a session ID - local $session_id = $1; - if (!defined($sessiondb{$session_id})) { - print $outfd "0 0\n"; - } - else { - local ($user, $ltime) = split(/\s+/, $sessiondb{$session_id}); - if ($config{'logouttime'} && - $time_now - $ltime > $config{'logouttime'}*60) { - print $outfd "1 ",$time_now - $ltime,"\n"; - delete($sessiondb{$session_id}); - } - else { - print $outfd "2 $user\n"; - $sessiondb{$session_id} = "$user $time_now"; - } - } - } - elsif ($inline =~ /^new\s+(\S+)\s+(\S+)/) { - # Creating a new session - $sessiondb{$1} = "$2 $time_now"; - } - elsif ($inline =~ /^delete\s+(\S+)/) { - # Logging out a session - print $outfd $sessiondb{$1} ? 1 : 0,"\n"; - delete($sessiondb{$1}); - } - else { - # close pipe - close($infd); close($outfd); - $passin[$i] = $passout[$i] = undef; - } - } - } - @passin = grep { defined($_) } @passin; - @passout = grep { defined($_) } @passout; - } - -# handle_request(remoteaddress, localaddress) -# Where the real work is done -sub handle_request -{ -$acptip = inet_ntoa((unpack_sockaddr_in($_[0]))[1]); -$localip = $_[1] ? inet_ntoa((unpack_sockaddr_in($_[1]))[1]) : undef; -if ($config{'loghost'}) { - $acpthost = gethostbyaddr(inet_aton($acptip), AF_INET); - $acpthost = $acptip if (!$acpthost); - } -else { - $acpthost = $acptip; - } -$datestr = &http_date(time()); -$ok_code = 200; -$ok_message = "Document follows"; - -# Wait at most 60 secs for start of headers (but only for the first time) -if (!$checked_timeout) { - local $rmask; - vec($rmask, fileno(SOCK), 1) = 1; - local $sel = select($rmask, undef, undef, 60); - $sel || &http_error(400, "Timeout"); - $checked_timeout++; - } - -# Read the HTTP request and headers -($reqline = &read_line()) =~ s/\r|\n//g; -if (!($reqline =~ /^(GET|POST|HEAD)\s+(.*)\s+HTTP\/1\..$/)) { - &http_error(400, "Bad Request"); - } -$method = $1; $request_uri = $page = $2; -%header = (); -local $lastheader; -while(1) { - ($headline = &read_line()) =~ s/\r|\n//g; - last if ($headline eq ""); - if ($headline =~ /^(\S+):\s+(.*)$/) { - $header{$lastheader = lc($1)} = $2; - } - elsif ($headline =~ /^\s+(.*)$/) { - $header{$lastheader} .= $headline; - } - else { - &http_error(400, "Bad Header $headline"); - } - } -if (defined($header{'host'})) { - if ($header{'host'} =~ /^([^:]+):([0-9]+)$/) { $host = $1; $port = $2; } - else { $host = $header{'host'}; } - } -undef(%in); -if ($page =~ /^([^\?]+)\?(.*)$/) { - # There is some query string information - $page = $1; - $querystring = $2; - if ($querystring !~ /=/) { - $queryargs = $querystring; - $queryargs =~ s/\+/ /g; - $queryargs =~ s/%(..)/pack("c",hex($1))/ge; - $querystring = ""; - } - else { - # Parse query-string parameters - local @in = split(/\&/, $querystring); - foreach $i (@in) { - local ($k, $v) = split(/=/, $i, 2); - $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge; - $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge; - $in{$k} = $v; - } - } - } -$posted_data = undef; -if ($method eq 'POST' && - $header{'content-type'} eq 'application/x-www-form-urlencoded') { - # Read in posted query string information - $clen = $header{"content-length"}; - while(length($posted_data) < $clen) { - $buf = &read_data($clen - length($posted_data)); - if (!length($buf)) { - &http_error(500, "Failed to read POST request"); - } - $posted_data .= $buf; - } - local @in = split(/\&/, $posted_data); - foreach $i (@in) { - local ($k, $v) = split(/=/, $i, 2); - $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge; - $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge; - $in{$k} = $v; - } - } - -# replace %XX sequences in page -$page =~ s/%(..)/pack("c",hex($1))/ge; - -# check address against access list -if (@deny && &ip_match($acptip, $localip, @deny) || - @allow && !&ip_match($acptip, $localip, @allow)) { - &http_error(403, "Access denied for $acptip"); - return 0; - } - -if ($use_libwrap) { - # Check address with TCP-wrappers - if (!hosts_ctl("miniserv", STRING_UNKNOWN, $acptip, STRING_UNKNOWN)) { - &http_error(403, "Access denied for $acptip"); - return 0; - } - } - -# check for the logout flag file, and if existant deny authentication -if ($config{'logout'} && -r $config{'logout'}.$in{'miniserv_logout_id'}) { - $deny_authentication++; - open(LOGOUT, $config{'logout'}.$in{'miniserv_logout_id'}); - chop($count = <LOGOUT>); - close(LOGOUT); - $count--; - if ($count > 0) { - open(LOGOUT, ">$config{'logout'}$in{'miniserv_logout_id'}"); - print LOGOUT "$count\n"; - close(LOGOUT); - } - else { - unlink($config{'logout'}.$in{'miniserv_logout_id'}); - } - } - -# Check for password if needed -if (%users) { - $validated = 0; - $blocked = 0; - - # Session authentication is never used for connections by - # another miniserv server - if ($header{'user-agent'} =~ /miniserv/i) { - $config{'session'} = 0; - } - - # check for SSL authentication - if ($use_ssl && $verified_client) { - $peername = Net::SSLeay::X509_NAME_oneline( - Net::SSLeay::X509_get_subject_name( - Net::SSLeay::get_peer_certificate( - $ssl_con))); - foreach $u (keys %certs) { - if ($certs{$u} eq $peername) { - $authuser = $u; - $validated = 2; - last; - } - } - } - - # Check for normal HTTP authentication - if (!$validated && !$deny_authentication && !$config{'session'} && - $header{authorization} =~ /^basic\s+(\S+)$/i) { - # authorization given.. - ($authuser, $authpass) = split(/:/, &b64decode($1)); - $validated = &validate_user($authuser, $authpass); - - if ($config{'passdelay'} && !$config{'inetd'}) { - # check with main process for delay - print $PASSINw "delay $authuser $acptip $validated\n"; - <$PASSOUTr> =~ /(\d+) (\d+)/; - $blocked = $2; - sleep($1); - } - } - - # Check for new session validation - if ($config{'session'} && !$deny_authentication && $page eq $config{'session_login'}) { - local $ok = &validate_user($in{'user'}, $in{'pass'}); - - # check if the test cookie is set - if ($header{'cookie'} !~ /testing=1/ && $in{'user'}) { - &http_error(500, "No cookies", - "Your browser does not support cookies, ". - "which are required for Webmin to work in ". - "session authentication mode"); - } - - # check with main process for delay - if ($config{'passdelay'} && $in{'user'}) { - print $PASSINw "delay $in{'user'} $acptip $ok\n"; - <$PASSOUTr> =~ /(\d+) (\d+)/; - $blocked = $2; - sleep($1); - } - - if ($ok) { - # Logged in OK! Tell the main process about the new SID - local $sid = time(); - local $mul = 1; - foreach $c (split(//, crypt($in{'pass'}, substr($$, -2)))) { - $sid += ord($c) * $mul; - $mul *= 3; - } - print $PASSINw "new $sid $in{'user'}\n"; - - # Set cookie and redirect - &write_data("HTTP/1.0 302 Moved Temporarily\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{'server'}\r\n"); - $portstr = $port == 80 && !$use_ssl ? "" : - $port == 443 && $use_ssl ? "" : ":$port"; - $prot = $use_ssl ? "https" : "http"; - if ($in{'save'}) { - &write_data("Set-Cookie: sid=$sid; path=/; expires=\"Fri, 1-Jan-2038 00:00:01\"\r\n"); - } - else { - &write_data("Set-Cookie: sid=$sid; path=/\r\n"); - } - &write_data("Location: $prot://$host$portstr$in{'page'}\r\n"); - &write_keep_alive(0); - &write_data("\r\n"); - &log_request($acpthost, $authuser, $reqline, 302, 0); - return 0; - } - elsif ($in{'logout'} && $header{'cookie'} =~ /sid=(\d+)/) { - # Logout clicked .. remove the session - print $PASSINw "delete $1\n"; - local $dummy = <$PASSINr>; - $logout = 1; - $already_session_id = undef; - } - else { - # Login failed .. display the form again - $failed_user = $in{'user'}; - $request_uri = $in{'page'}; - $already_session_id = undef; - } - } - - # Check for an existing session - if ($config{'session'} && !$validated) { - if ($already_session_id) { - $session_id = $already_session_id; - $authuser = $already_authuser; - $validated = 1; - } - elsif (!$deny_authentication && $header{'cookie'} =~ /sid=(\d+)/) { - $session_id = $1; - print $PASSINw "verify $session_id\n"; - <$PASSOUTr> =~ /(\d+)\s+(\S+)/; - if ($1 == 2) { - # Valid session continuation - $validated = 1; - $authuser = $2; - $already_session_id = $session_id; - $already_authuser = $authuser; - } - elsif ($1 == 1) { - # Session timed out - $timed_out = $2; - } - else { - # Invalid session ID .. don't set verified - } - } - } - - # Check for local authentication - if ($localauth_user) { - if (defined($users{$localauth_user})) { - $validated = 1; - $authuser = $localauth_user; - } - else { - $localauth_user = undef; - } - } - - if (!$validated) { - if ($blocked == 0) { - # No password given.. ask - if ($config{'session'}) { - # Force CGI for session login - $validated = 1; - if ($logout) { - $querystring .= "&logout=1&page=/"; - } - else { - $querystring = "page=".&urlize($request_uri); - } - $querystring .= "&failed=$failed_user" if ($failed_user); - $querystring .= "&timed_out=$timed_out" if ($timed_out); - $queryargs = ""; - $page = $config{'session_login'}; - } - else { - # Ask for login with HTTP authentication - &write_data("HTTP/1.0 401 Unauthorized\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{'server'}\r\n"); - &write_data("WWW-authenticate: Basic ". - "realm=\"$config{'realm'}\"\r\n"); - &write_keep_alive(0); - &write_data("Content-type: text/html\r\n"); - &write_data("\r\n"); - &reset_byte_count(); - &write_data("<html>\n"); - &write_data("<head><title>Unauthorized</title></head>\n"); - &write_data("<body><h1>Unauthorized</h1>\n"); - &write_data("A password is required to access this\n"); - &write_data("web server. Please try again. <p>\n"); - &write_data("</body></html>\n"); - &log_request($acpthost, undef, $reqline, 401, &byte_count()); - return 0; - } - } - else { - # when the host has been blocked, give it an error message - &http_error(403, "Access denied for $acptip. The host has been blocked " - ."because of too many authentication failures."); - } - } - - # Check per-user IP access control - if ($deny{$authuser} && &ip_match($acptip, $localip, @{$deny{$authuser}}) || - $allow{$authuser} && !&ip_match($acptip, $localip, @{$allow{$authuser}})) { - &http_error(403, "Access denied for $acptip"); - return 0; - } - } - -# Figure out what kind of page was requested -rerun: -$simple = &simplify_path($page, $bogus); -$simple =~ s/[\000-\037]//g; -if ($bogus) { - &http_error(400, "Invalid path"); - } -undef($full); -if ($config{'preroot'}) { - # Look in the template root directory first - $is_directory = 1; - $sofar = ""; - $full = $config{"preroot"} . $sofar; - $scriptname = $simple; - foreach $b (split(/\//, $simple)) { - if ($b ne "") { $sofar .= "/$b"; } - $full = $config{"preroot"} . $sofar; - @st = stat($full); - if (!@st) { undef($full); last; } - - # Check if this is a directory - if (-d $full) { - # It is.. go on parsing - $is_directory = 1; - next; - } - else { $is_directory = 0; } - - # Check if this is a CGI program - if (&get_type($full) eq "internal/cgi") { - $pathinfo = substr($simple, length($sofar)); - $pathinfo .= "/" if ($page =~ /\/$/); - $scriptname = $sofar; - last; - } - } - if ($full) { - if ($sofar eq '') { - $cgi_pwd = $config{'root'}; - } - else { - "$config{'root'}$sofar" =~ /^(.*\/)[^\/]+$/; - $cgi_pwd = $1; - } - if ($is_directory) { - # Check for index files in the directory - foreach $idx (split(/\s+/, $config{"index_docs"})) { - $idxfull = "$full/$idx"; - if (-r $idxfull && !(-d $idxfull)) { - $full = $idxfull; - $is_directory = 0; - $scriptname .= "/" - if ($scriptname ne "/"); - last; - } - } - } - } - } -if (!$full || $is_directory) { - $sofar = ""; - $full = $config{"root"} . $sofar; - $scriptname = $simple; - foreach $b (split(/\//, $simple)) { - if ($b ne "") { $sofar .= "/$b"; } - $full = $config{"root"} . $sofar; - @st = stat($full); - if (!@st) { &http_error(404, "File not found"); } - - # Check if this is a directory - if (-d $full) { - # It is.. go on parsing - next; - } - - # Check if this is a CGI program - if (&get_type($full) eq "internal/cgi") { - $pathinfo = substr($simple, length($sofar)); - $pathinfo .= "/" if ($page =~ /\/$/); - $scriptname = $sofar; - last; - } - } - $full =~ /^(.*\/)[^\/]+$/; $cgi_pwd = $1; - } - -# check filename against denyfile regexp -local $denyfile = $config{'denyfile'}; -if ($denyfile && $full =~ /$denyfile/) { - &http_error(403, "Access denied to $page"); - return 0; - } - -# Reached the end of the path OK.. see what we've got -if (-d $full) { - # See if the URL ends with a / as it should - if ($page !~ /\/$/) { - # It doesn't.. redirect - &write_data("HTTP/1.0 302 Moved Temporarily\r\n"); - $portstr = $port == 80 && !$use_ssl ? "" : - $port == 443 && $use_ssl ? "" : ":$port"; - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - $prot = $use_ssl ? "https" : "http"; - &write_data("Location: $prot://$host$portstr$page/\r\n"); - &write_keep_alive(0); - &write_data("\r\n"); - &log_request($acpthost, $authuser, $reqline, 302, 0); - return 0; - } - # A directory.. check for index files - foreach $idx (split(/\s+/, $config{"index_docs"})) { - $idxfull = "$full/$idx"; - if (-r $idxfull && !(-d $idxfull)) { - $cgi_pwd = $full; - $full = $idxfull; - $scriptname .= "/" if ($scriptname ne "/"); - last; - } - } - } -if (-d $full) { - # This is definately a directory.. list it - &write_data("HTTP/1.0 $ok_code $ok_message\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_data("Content-type: text/html\r\n"); - &write_keep_alive(0); - &write_data("\r\n"); - &reset_byte_count(); - &write_data("<h1>Index of $simple</h1>\n"); - &write_data("<pre>\n"); - &write_data(sprintf "%-35.35s %-20.20s %-10.10s\n", - "Name", "Last Modified", "Size"); - &write_data("<hr>\n"); - opendir(DIR, $full); - while($df = readdir(DIR)) { - if ($df =~ /^\./) { next; } - (@stbuf = stat("$full/$df")) || next; - if (-d "$full/$df") { $df .= "/"; } - @tm = localtime($stbuf[9]); - $fdate = sprintf "%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d", - $tm[3],$tm[4]+1,$tm[5]+1900, - $tm[0],$tm[1],$tm[2]; - $len = length($df); $rest = " "x(35-$len); - &write_data(sprintf - "<a href=\"%s\">%-${len}.${len}s</a>$rest %-20.20s %-10.10s\n", - $df, $df, $fdate, $stbuf[7]); - } - closedir(DIR); - &log_request($acpthost, $authuser, $reqline, $ok_code, &byte_count()); - return 0; - } - -# CGI or normal file -local $rv; -if (&get_type($full) eq "internal/cgi") { - # A CGI program to execute - $envtz = $ENV{"TZ"}; - $envuser = $ENV{"USER"}; - $envpath = $ENV{"PATH"}; - foreach (keys %ENV) { delete($ENV{$_}); } - $ENV{"PATH"} = $envpath if ($envpath); - $ENV{"TZ"} = $envtz if ($envtz); - $ENV{"USER"} = $envuser if ($envuser); - $ENV{"HOME"} = $user_homedir; - $ENV{"SERVER_SOFTWARE"} = $config{"server"}; - $ENV{"SERVER_NAME"} = $host; - $ENV{"SERVER_ADMIN"} = $config{"email"}; - $ENV{"SERVER_ROOT"} = $config{"root"}; - $ENV{"SERVER_PORT"} = $port; - $ENV{"REMOTE_HOST"} = $acpthost; - $ENV{"REMOTE_ADDR"} = $acptip; - $ENV{"REMOTE_USER"} = $authuser if (defined($authuser)); - $ENV{"SSL_USER"} = $peername if ($validated == 2); - $ENV{"DOCUMENT_ROOT"} = $config{"root"}; - $ENV{"GATEWAY_INTERFACE"} = "CGI/1.1"; - $ENV{"SERVER_PROTOCOL"} = "HTTP/1.0"; - $ENV{"REQUEST_METHOD"} = $method; - $ENV{"SCRIPT_NAME"} = $scriptname; - $ENV{"REQUEST_URI"} = $request_uri; - $ENV{"PATH_INFO"} = $pathinfo; - $ENV{"PATH_TRANSLATED"} = "$config{root}/$pathinfo"; - $ENV{"QUERY_STRING"} = $querystring; - $ENV{"MINISERV_CONFIG"} = $conf; - $ENV{"HTTPS"} = "ON" if ($use_ssl); - $ENV{"SESSION_ID"} = $session_id if ($session_id); - $ENV{"LOCAL_USER"} = $localauth_user if ($localauth_user); - if (defined($header{"content-length"})) { - $ENV{"CONTENT_LENGTH"} = $header{"content-length"}; - } - if (defined($header{"content-type"})) { - $ENV{"CONTENT_TYPE"} = $header{"content-type"}; - } - foreach $h (keys %header) { - ($hname = $h) =~ tr/a-z/A-Z/; - $hname =~ s/\-/_/g; - $ENV{"HTTP_$hname"} = $header{$h}; - } - $ENV{"PWD"} = $cgi_pwd; - foreach $k (keys %config) { - if ($k =~ /^env_(\S+)$/) { - $ENV{$1} = $config{$k}; - } - } - delete($ENV{'HTTP_AUTHORIZATION'}); - $ENV{'HTTP_COOKIE'} =~ s/;?\s*sid=(\d+)//; - - # Check if the CGI can be handled internally - open(CGI, $full); - local $first = <CGI>; - close(CGI); - $first =~ s/[#!\r\n]//g; - $nph_script = ($full =~ /\/nph-([^\/]+)$/); - if (!$config{'forkcgis'} && $first eq $perl_path && $] >= 5.004) { - # setup environment for eval - chdir($ENV{"PWD"}); - @ARGV = split(/\s+/, $queryargs); - $0 = $full; - if ($posted_data) { - # Already read the post input - $postinput = $posted_data; - } - elsif ($method eq "POST") { - $clen = $header{"content-length"}; - while(length($postinput) < $clen) { - $buf = &read_data($clen - length($postinput)); - if (!length($buf)) { - &http_error(500, "Failed to read ". - "POST request"); - } - $postinput .= $buf; - } - } - $SIG{'CHLD'} = 'DEFAULT'; - eval { - # Have SOCK closed if the perl exec's something - use Fcntl; - fcntl(SOCK, F_SETFD, FD_CLOEXEC); - }; - shutdown(SOCK, 0); - - if ($config{'log'}) { - open(MINISERVLOG, ">>$config{'logfile'}"); - chmod(0600, $config{'logfile'}); - } - $doing_eval = 1; - eval { - package main; - tie(*STDOUT, 'miniserv'); - tie(*STDIN, 'miniserv'); - do $miniserv::full; - die $@ if ($@); - }; - $doing_eval = 0; - if ($@) { - # Error in perl! - &http_error(500, "Perl execution failed", $@); - } - elsif (!$doneheaders && !$nph_script) { - &http_error(500, "Missing Headers"); - } - #close(SOCK); - $rv = 0; - } - else { - # fork the process that actually executes the CGI - pipe(CGIINr, CGIINw); - pipe(CGIOUTr, CGIOUTw); - pipe(CGIERRr, CGIERRw); - if (!($cgipid = fork())) { - chdir($ENV{"PWD"}); - close(SOCK); - open(STDIN, "<&CGIINr"); - open(STDOUT, ">&CGIOUTw"); - open(STDERR, ">&CGIERRw"); - close(CGIINw); close(CGIOUTr); close(CGIERRr); - exec($full, split(/\s+/, $queryargs)); - print STDERR "Failed to exec $full : $!\n"; - exit; - } - close(CGIINr); close(CGIOUTw); close(CGIERRw); - - # send post data - if ($posted_data) { - # already read the posted data - print CGIINw $posted_data; - } - elsif ($method eq "POST") { - $got = 0; $clen = $header{"content-length"}; - while($got < $clen) { - $buf = &read_data($clen-$got); - if (!length($buf)) { - kill('TERM', $cgipid); - &http_error(500, "Failed to read ". - "POST request"); - } - $got += length($buf); - print CGIINw $buf; - } - } - close(CGIINw); - shutdown(SOCK, 0); - - if (!$nph_script) { - # read back cgi headers - select(CGIOUTr); $|=1; select(STDOUT); - $got_blank = 0; - while(1) { - $line = <CGIOUTr>; - $line =~ s/\r|\n//g; - if ($line eq "") { - if ($got_blank || %cgiheader) { last; } - $got_blank++; - next; - } - ($line =~ /^(\S+):\s+(.*)$/) || - &http_error(500, "Bad Header", - &read_errors(CGIERRr)); - $cgiheader{lc($1)} = $2; - } - if ($cgiheader{"location"}) { - &write_data("HTTP/1.0 302 Moved Temporarily\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{'server'}\r\n"); - &write_keep_alive(0); - # ignore the rest of the output. This is a hack, but - # is necessary for IE in some cases :( - close(CGIOUTr); close(CGIERRr); - } - elsif ($cgiheader{"content-type"} eq "") { - &http_error(500, "Missing Content-Type Header", - &read_errors(CGIERRr)); - } - else { - &write_data("HTTP/1.0 $ok_code $ok_message\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{'server'}\r\n"); - &write_keep_alive(0); - } - foreach $h (keys %cgiheader) { - &write_data("$h: $cgiheader{$h}\r\n"); - } - &write_data("\r\n"); - } - &reset_byte_count(); - while($line = <CGIOUTr>) { - &write_data($line); - } - close(CGIOUTr); close(CGIERRr); - $rv = 0; - } - } -else { - # A file to output - local @st = stat($full); - open(FILE, $full) || &http_error(404, "Failed to open file"); - &write_data("HTTP/1.0 $ok_code $ok_message\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_data("Content-type: ".&get_type($full)."\r\n"); - &write_data("Content-length: $st[7]\r\n"); - &write_data("Last-Modified: ".&http_date($st[9])."\r\n"); - &write_keep_alive(); - &write_data("\r\n"); - &reset_byte_count(); - while(read(FILE, $buf, 1024) > 0) { - &write_data($buf); - } - close(FILE); - $rv = &check_keep_alive(); - } - -# log the request -&log_request($acpthost, $authuser, $reqline, - $cgiheader{"location"} ? "302" : $ok_code, &byte_count()); -return $rv; -} - -# http_error(code, message, body, [dontexit]) -sub http_error -{ -close(CGIOUT); -local $eh = $error_handler_recurse ? undef : - $config{"error_handler_$_[0]"} ? $config{"error_handler_$_[0]"} : - $config{'error_handler'} ? $config{'error_handler'} : undef; -if ($eh) { - # Call a CGI program for the error - $page = "/$eh"; - $querystring = "code=$_[0]&message=".&urlize($_[1]). - "&body=".&urlize($_[2]); - $error_handler_recurse++; - $ok_code = $_[0]; - $ok_message = $_[1]; - goto rerun; - } -else { - # Use the standard error message display - &write_data("HTTP/1.0 $_[0] $_[1]\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Content-type: text/html\r\n"); - &write_keep_alive(0); - &write_data("\r\n"); - &reset_byte_count(); - &write_data("<h1>Error - $_[1]</h1>\n"); - if ($_[2]) { - &write_data("<pre>$_[2]</pre>\n"); - } - } -&log_request($acpthost, $authuser, $reqline, $_[0], &byte_count()) - if ($reqline); -shutdown(SOCK, 1); -exit if (!$_[3]); -} - -sub get_type -{ -if ($_[0] =~ /\.([A-z0-9]+)$/) { - $t = $mime{$1}; - if ($t ne "") { - return $t; - } - } -return "text/plain"; -} - -# simplify_path(path, bogus) -# Given a path, maybe containing stuff like ".." and "." convert it to a -# clean, absolute form. -sub simplify_path -{ -local($dir, @bits, @fixedbits, $b); -$dir = $_[0]; -$dir =~ s/^\/+//g; -$dir =~ s/\/+$//g; -@bits = split(/\/+/, $dir); -@fixedbits = (); -$_[1] = 0; -foreach $b (@bits) { - if ($b eq ".") { - # Do nothing.. - } - elsif ($b eq "..") { - # Remove last dir - if (scalar(@fixedbits) == 0) { - $_[1] = 1; - return "/"; - } - pop(@fixedbits); - } - else { - # Add dir to list - push(@fixedbits, $b); - } - } -return "/" . join('/', @fixedbits); -} - -# b64decode(string) -# Converts a string from base64 format to normal -sub b64decode -{ - local($str) = $_[0]; - local($res); - $str =~ tr|A-Za-z0-9+=/||cd; - $str =~ s/=+$//; - $str =~ tr|A-Za-z0-9+/| -_|; - while ($str =~ /(.{1,60})/gs) { - my $len = chr(32 + length($1)*3/4); - $res .= unpack("u", $len . $1 ); - } - return $res; -} - -# ip_match(remoteip, localip, [match]+) -# Checks an IP address against a list of IPs, networks and networks/masks -sub ip_match -{ -local(@io, @mo, @ms, $i, $j); -@io = split(/\./, $_[0]); -local $hn; -if (!defined($hn = $ip_match_cache{$_[0]})) { - $hn = gethostbyaddr(inet_aton($_[0]), AF_INET); - $hn = "" if ((&to_ipaddress($hn))[0] ne $_[0]); - $ip_match_cache{$_[0]} = $hn; - } -for($i=2; $i<@_; $i++) { - local $mismatch = 0; - if ($_[$i] =~ /^(\S+)\/(\S+)$/) { - # Compare with network/mask - @mo = split(/\./, $1); @ms = split(/\./, $2); - for($j=0; $j<4; $j++) { - if ((int($io[$j]) & int($ms[$j])) != int($mo[$j])) { - $mismatch = 1; - } - } - } - elsif ($_[$i] =~ /^\*(\S+)$/) { - # Compare with hostname regexp - $mismatch = 1 if ($hn !~ /$1$/); - } - elsif ($_[$i] eq 'LOCAL') { - # Compare with local network - local @lo = split(/\./, $_[1]); - if ($lo[0] < 128) { - $mismatch = 1 if ($lo[0] != $io[0]); - } - elsif ($lo[0] < 192) { - $mismatch = 1 if ($lo[0] != $io[0] || - $lo[1] != $io[1]); - } - else { - $mismatch = 1 if ($lo[0] != $io[0] || - $lo[1] != $io[1] || - $lo[2] != $io[2]); - } - } - else { - # Compare with IP or network - @mo = split(/\./, $_[$i]); - while(@mo && !$mo[$#mo]) { pop(@mo); } - for($j=0; $j<@mo; $j++) { - if ($mo[$j] != $io[$j]) { - $mismatch = 1; - } - } - } - return 1 if (!$mismatch); - } -return 0; -} - -# restart_miniserv() -# Called when a SIGHUP is received to restart the web server. This is done -# by exec()ing perl with the same command line as was originally used -sub restart_miniserv -{ -close(SOCK); close(MAIN); -foreach $p (@passin) { close($p); } -foreach $p (@passout) { close($p); } -if ($logclearer) { kill('TERM', $logclearer); } -exec($perl_path, $miniserv_path, @miniserv_argv); -die "Failed to restart miniserv with $perl_path $miniserv_path"; -} - -sub trigger_restart -{ -$need_restart = 1; -} - -sub to_ipaddress -{ -local (@rv, $i); -foreach $i (@_) { - if ($i =~ /(\S+)\/(\S+)/ || $i =~ /^\*\S+$/ || - $i eq 'LOCAL') { push(@rv, $i); } - else { push(@rv, join('.', unpack("CCCC", inet_aton($i)))); } - } -return @rv; -} - -# read_line() -# Reads one line from SOCK or SSL -sub read_line -{ -local($idx, $more, $rv); -if ($use_ssl) { - while(($idx = index($read_buffer, "\n")) < 0) { - # need to read more.. - if (!($more = Net::SSLeay::read($ssl_con))) { - # end of the data - $rv = $read_buffer; - undef($read_buffer); - return $rv; - } - $read_buffer .= $more; - } - $rv = substr($read_buffer, 0, $idx+1); - $read_buffer = substr($read_buffer, $idx+1); - return $rv; - } -else { return <SOCK>; } -} - -# read_data(length) -# Reads up to some amount of data from SOCK or the SSL connection -sub read_data -{ -if ($use_ssl) { - local($rv); - if (length($read_buffer)) { - $rv = $read_buffer; - undef($read_buffer); - return $rv; - } - else { - return Net::SSLeay::read($ssl_con, $_[0]); - } - } -else { - local $buf; - read(SOCK, $buf, $_[0]) || return undef; - return $buf; - } -} - -# write_data(data) -# Writes a string to SOCK or the SSL connection -sub write_data -{ -if ($use_ssl) { - Net::SSLeay::write($ssl_con, $_[0]); - } -else { - syswrite(SOCK, $_[0], length($_[0])); - } -$write_data_count += length($_[0]); -} - -# reset_byte_count() -sub reset_byte_count { $write_data_count = 0; } - -# byte_count() -sub byte_count { return $write_data_count; } - -# log_request(hostname, user, request, code, bytes) -sub log_request -{ -if ($config{'log'}) { - local(@tm, $dstr, $user, $ident, $headers); - if ($config{'logident'}) { - # add support for rfc1413 identity checking here - } - else { $ident = "-"; } - @tm = localtime(time()); - $dstr = sprintf "%2.2d/%s/%4.4d:%2.2d:%2.2d:%2.2d %s", - $tm[3], $make_date_marr[$tm[4]], $tm[5]+1900, - $tm[2], $tm[1], $tm[0], $timezone; - $user = $_[1] ? $_[1] : "-"; - if (fileno(MINISERVLOG)) { - seek(MINISERVLOG, 0, 2); - } - else { - open(MINISERVLOG, ">>$config{'logfile'}"); - chmod(0600, $config{'logfile'}); - } - foreach $h (split(/\s+/, $config{'logheaders'})) { - $headers .= " $h=\"$header{$h}\""; - } - print MINISERVLOG "$_[0] $ident $user [$dstr] \"$_[2]\" ", - "$_[3] $_[4]$headers\n"; - close(MINISERVLOG); - } -} - -# read_errors(handle) -# Read and return all input from some filehandle -sub read_errors -{ -local($fh, $_, $rv); -$fh = $_[0]; -while(<$fh>) { $rv .= $_; } -return $rv; -} - -sub write_keep_alive -{ -local $mode; -if (@_) { $mode = $_[0]; } -else { $mode = &check_keep_alive(); } -&write_data("Connection: ".($mode ? "Keep-Alive" : "close")."\r\n"); -} - -sub check_keep_alive -{ -return $header{'connection'} =~ /keep-alive/i; -} - -sub term_handler -{ -if (@childpids) { - kill('TERM', @childpids); - } -exit(1); -} - -sub http_date -{ -local @tm = gmtime($_[0]); -return sprintf "%s, %d %s %d %2.2d:%2.2d:%2.2d GMT", - $weekday[$tm[6]], $tm[3], $month[$tm[4]], $tm[5]+1900, - $tm[2], $tm[1], $tm[0]; -} - -sub TIEHANDLE -{ -my $i; bless \$i, shift; -} - -sub WRITE -{ -$r = shift; -my($buf,$len,$offset) = @_; -&write_to_sock(substr($buf, $offset, $len)); -} - -sub PRINT -{ -$r = shift; -$$r++; -&write_to_sock(@_); -} - -sub PRINTF -{ -shift; -my $fmt = shift; -&write_to_sock(sprintf $fmt, @_); -} - -sub READ -{ -$r = shift; -substr($_[0], $_[2], $_[1]) = substr($postinput, $postpos, $_[1]); -$postpos += $_[1]; -} - -sub OPEN -{ -print STDERR "open() called - should never happen!\n"; -} - -sub READLINE -{ -if ($postpos >= length($postinput)) { - return undef; - } -local $idx = index($postinput, "\n", $postpos); -if ($idx < 0) { - local $rv = substr($postinput, $postpos); - $postpos = length($postinput); - return $rv; - } -else { - local $rv = substr($postinput, $postpos, $idx-$postpos+1); - $postpos = $idx+1; - return $rv; - } -} - -sub GETC -{ -return $postpos >= length($postinput) ? undef - : substr($postinput, $postpos++, 1); -} - -sub CLOSE { } - -sub DESTROY { } - -# write_to_sock(data, ...) -sub write_to_sock -{ -foreach $d (@_) { - if ($doneheaders || $miniserv::nph_script) { - &write_data($d); - } - else { - $headers .= $d; - while(!$doneheaders && $headers =~ s/^(.*)(\r)?\n//) { - if ($1 =~ /^(\S+):\s+(.*)$/) { - $cgiheader{lc($1)} = $2; - } - elsif ($1 !~ /\S/) { - $doneheaders++; - } - else { - &http_error(500, "Bad Header"); - } - } - if ($doneheaders) { - if ($cgiheader{"location"}) { - &write_data( - "HTTP/1.0 302 Moved Temporarily\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_keep_alive(0); - } - elsif ($cgiheader{"content-type"} eq "") { - &http_error(500, "Missing Content-Type Header"); - } - else { - &write_data("HTTP/1.0 $ok_code $ok_message\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_keep_alive(0); - } - foreach $h (keys %cgiheader) { - &write_data("$h: $cgiheader{$h}\r\n"); - } - &write_data("\r\n"); - &reset_byte_count(); - &write_data($headers); - } - } - } -} - -sub verify_client -{ -local $cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($_[1]); -if ($cert) { - local $errnum = Net::SSLeay::X509_STORE_CTX_get_error($_[1]); - $verified_client = 1 if (!$errnum); - } -return 1; -} - -sub END -{ -if ($doing_eval) { - # A CGI program called exit! This is a horrible hack to - # finish up before really exiting - close(SOCK); - &log_request($acpthost, $authuser, $reqline, - $cgiheader{"location"} ? "302" : $ok_code, &byte_count()); - } -} - -# urlize -# Convert a string to a form ok for putting in a URL -sub urlize { - local($tmp, $tmp2, $c); - $tmp = $_[0]; - $tmp2 = ""; - while(($c = chop($tmp)) ne "") { - if ($c !~ /[A-z0-9]/) { - $c = sprintf("%%%2.2X", ord($c)); - } - $tmp2 = $c . $tmp2; - } - return $tmp2; -} - -# validate_user(username, password) -sub validate_user -{ -return 0 if (!$_[0] || !$users{$_[0]}); -if ($users{$_[0]} eq 'x' && $use_pam) { - $pam_username = $_[0]; - $pam_password = $_[1]; - local $pamh = new Authen::PAM("miniserv", $pam_username, \&pam_conv_func); - if (!ref($pamh)) { - print STDERR "PAM init failed : $pamh\n"; - return 0; - } - local $pam_ret = $pamh->pam_authenticate(); - return $pam_ret == PAM_SUCCESS ? 1 : 0; - } -else { - return $users{$_[0]} eq crypt($_[1], $users{$_[0]}) ? 1 : 0; - } -} - -# the PAM conversation function for interactive logins -sub pam_conv_func -{ -my @res; -while ( @_ ) { - my $code = shift; - my $msg = shift; - my $ans = ""; - - $ans = $pam_username if ($code == PAM_PROMPT_ECHO_ON() ); - $ans = $pam_password if ($code == PAM_PROMPT_ECHO_OFF() ); - - push @res, PAM_SUCCESS(); - push @res, $ans; - } -push @res, PAM_SUCCESS(); -return @res; -} - diff --git a/perl-install/standalone/interactive_http/miniserv.users b/perl-install/standalone/interactive_http/miniserv.users deleted file mode 100644 index f7338497a..000000000 --- a/perl-install/standalone/interactive_http/miniserv.users +++ /dev/null @@ -1 +0,0 @@ -root:x:0 diff --git a/perl-install/standalone/keyboarddrake b/perl-install/standalone/keyboarddrake deleted file mode 100755 index ac49132a5..000000000 --- a/perl-install/standalone/keyboarddrake +++ /dev/null @@ -1,50 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use interactive; -use keyboard; -use Xconfig::xfree; -use common; -use any; -use c; - -my $in; -my $keyboard = keyboard::read(); -if (my ($kb) = grep { !/^-/ } @ARGV) { - keyboard::KEYBOARD2text($kb) or die "bad keyboard $kb\n"; - $keyboard->{KEYBOARD} = $kb; -} else { - $in = 'interactive'->vnew('su'); - - choose: - $keyboard->{KEYBOARD} = $in->ask_from_listf(N("Keyboard"), - N("Please, choose your keyboard layout."), - sub { translate(keyboard::KEYBOARD2text($_[0])) }, - [ keyboard::KEYBOARDs() ], - $keyboard->{KEYBOARD}) or goto end; - - keyboard::group_toggle_choose($in, $keyboard) or goto choose; -} - -if ($::expert) { - my $isNotDelete = !$in->ask_yesorno("BackSpace", N("Do you want the BackSpace to return Delete in console?"), 1); - $keyboard->{BACKSPACE} = $isNotDelete ? "BackSpace" : "Delete"; -} - -my $xkb = keyboard::keyboard2full_xkb($keyboard); -system('setxkbmap', '-option', '') if $xkb->{XkbOptions}; #- need re-initialised other toggles are cumulated -system('setxkbmap', $xkb->{XkbLayout}, '-model' => $xkb->{XkbModel}, '-option' => $xkb->{XkbOptions} || '', '-compat' => $xkb->{XkbCompat} || ''); -eval { - my $xfree_conf = Xconfig::xfree->read; - $xfree_conf->set_keyboard($xkb); - $xfree_conf->write; -}; - -keyboard::write($keyboard); -system('/etc/init.d/keytable', 'restart'); - -end: - $in->exit(0) if $in; diff --git a/perl-install/standalone/livedrake b/perl-install/standalone/livedrake deleted file mode 100755 index 3d34d08d7..000000000 --- a/perl-install/standalone/livedrake +++ /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 common; -use interactive; -use run_program; -use c; - -my $in = 'interactive'->vnew('su'); - -my $cd_mntpoint = "/mnt/cdrom"; - -while (! -x "$cd_mntpoint/Mandrake/mdkinst/usr/bin/perl-install/live_install") { - ejectCdrom(); - $in->ask_okcancel(N("Change Cd-Rom"), -N("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('', N("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 4f5a433e3..000000000 --- a/perl-install/standalone/localedrake +++ /dev/null @@ -1,69 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -use interactive; -use common; -use lang; -use any; - -my ($klang, $kcountry, $apply); - -foreach (@ARGV) { - $apply = /--apply/; - $klang = $1 if /--kde_lang=(.*)/; - $kcountry = uc($1) if /--kde_country=(.*)/; -} - -if (defined $klang) { - $klang or exit(-1); - my $lang = member($klang, lang::list_langs()) ? $klang : 'en_US'; - my $country = member($kcountry, lang::list_countries()) ? $kcountry : 'US'; - my $locale = lang::read('', $>); - $klang and $locale->{lang} = $lang; - $kcountry and $locale->{country} = $country; - lang::write('', $locale, $>, 'dont_touch_kde_files') if $apply; - - #- help KDE defaulting to the right charset - print lang::charset2kde_charset(lang::l2charset($lang)), "\n"; - exit(0); -} - -my $locale = lang::read('', $>); -my $in = 'interactive'->vnew; -my $one_lang_only; - -sub select_language { - $locale->{lang} = any::selectLanguage($in, $locale->{lang}); -} -sub select_country { - any::selectCountry($in, $locale); -} - -eval { - language: - select_language() or goto the_end; - select_country() or goto language; -}; -if ($@) { - if ($@ =~ /^one lang only/) { - select_country() or goto the_end; - } else { - die; - } -} - -lang::write('', $locale, $>); -if ($>) { - if (my $wm = any::running_window_manager()) { - $in->ask_okcancel('', N("The change is done, but to be effective you must logout"), 1) - and any::ask_window_manager_to_logout($wm); - } -} - -the_end: -$in->exit(0); - - diff --git a/perl-install/standalone/logdrake b/perl-install/standalone/logdrake deleted file mode 100755 index e7382effa..000000000 --- a/perl-install/standalone/logdrake +++ /dev/null @@ -1,486 +0,0 @@ -#! /usr/bin/perl -# $Id$ - -# Copyright (C) 2001-2002 MandrakeSoft -# Yves Duret <yduret at mandrakesoft.com> -# some code is Copyright: (C) 1999, Michael T. Babcock <mikebabcock@pobox.com> -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -# TODO: consider switching from TreeView to gtkhtml - -use strict; -use lib qw(/usr/lib/libDrakX); -use standalone; #- warning, standalone must be loaded very first, for 'explanations' -use common; -use interactive; -use ugtk2 qw(:wrappers :helpers :create); - -$::isInstall and die "Not supported during install.\n"; - -my $in = 'interactive'->vnew('su'); -my $cron_hourly = "/etc/cron.hourly/logdrake_service"; - -#- parse arguments list. -foreach (@ARGV) { - /^--explain=(.*)$/ and do { $::isExplain = ($::Explain) = $1; $::isFile = 1; $::File = "/var/log/explanations"; next }; - /^--file=(.*)$/ and do { $::isFile = ($::File) = $1; next }; - /^--word=(.*)$/ and do { $::isWord = ($::Word) = $1; next }; - /^--alert$/ and do { alert_config(); quit() }; -} - -$::isTail = 1 if $::isFile; -$| = 1 if $::isTail; -my $h = chomp_(`hostname -s`); - -my $my_win = ugtk2->new('logdrake'); -unless ($::isEmbedded) { - $my_win->{rwindow}->set_title(N("logdrake")); - $my_win->{window}->set_border_width(5); - #$my_win->{rwindow}->set_policy(1, 1, 1); - #$my_win->{window}->set_default_size(540,460); -} -$my_win->{window}->signal_connect(delete_event => \&quit); - -my $cal = gtkset_sensitive(new Gtk2::Calendar(), 0); -my $mday = (localtime(time()))[3]; -$cal->select_day($mday); -my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); -my $cal_mode = 0; -my $cal_butt = gtksignal_connect(new Gtk2::CheckButton(N("Show only for the selected day")), clicked => sub { $cal_mode = !$cal_mode; gtkset_sensitive($cal,$cal_mode) }); - -### menus definition -# the menus are not shown -# but they provides shiny shortcut like C-q -my @menu_items = ( - { path => N("/_File"), type => '<Branch>' }, - { path => N("/File/_New"), accelerator => N("<control>N") }, - { path => N("/File/_Open"), accelerator => N("<control>O") }, - { path => N("/File/_Save"), accelerator => N("<control>S"), callback => \&save }, - { path => N("/File/Save _As") }, - { path => N("/File/-"),type => '<Separator>' }, - { path => N("/File/_Quit"), accelerator => N("<control>Q"), callback => \&quit }, - { path => N("/_Options"), type => '<Branch>' }, - { path => N("/Options/Test") }, - { path => N("/_Help"),type => '<LastBranch>' }, - { path => N("/Help/_About...") } - ); -my $menubar = create_factory_menu($my_win->{rwindow}, @menu_items) unless $::isEmbedded; -######### menus end - - -########## font and colors -my %n = ('font' => ''); # Gtk2::Pango::FontDescription->from_string('Serif 12');#Gtk2::Gdk::Font->fontset_load(N("-misc-fixed-medium-r-*-*-*-100-*-*-*-*-*-*,*")); -my %b = ('font' => 'Bold'); #Gtk2::Pango::FontDescription->from_string('Serif Bold 12');#Gtk2::Gdk::Font->fontset_load(N("-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 = gtkcolor(50400, 655, 20000); -my $black = gtkcolor(0, 0, 0); -my $red = gtkcolor(0xFFFF, 655, 655); -my $green = gtkcolor(0x0, 0x9898,0x0); -my $yellow = gtkcolor(0xFFFF, 0xD7D7, 0); -my $blue = gtkcolor(655, 655, 0xFFFF); -my $magenta = gtkcolor(0xFFFF, 655, 0xFFFF); -my $purple = gtkcolor(0xA0A0, 0x2020, 0xF0F0); -my $cyan = gtkcolor(0x0, 0x9898, 0x9898); -my $darkgray = 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 = 'green4'; -my $col_warn = 'yellow4'; -my $col_bad = 'red'; -my $col_note = 'purple'; -my $col = 'darkcyan'; - -######### font and colors end - -my %files = ( - "auth" => { file => "/var/log/auth.log", desc => N("Authentication") }, - "user" => { file => "/var/log/user.log", desc => N("User") }, - "messages" => { file => "/var/log/messages", desc => N("Messages") }, - "syslog" => { file => "/var/log/syslog", desc => N("Syslog") }, - "explanations" => { file => "/var/log/explanations", desc => N("Mandrake Tools Explanation") } -); - -my $yy = gtkset_sensitive(gtksignal_connect(new Gtk2::Button(N("search")) , clicked => \&search),0); -my $log_text = gtktext_insert(Gtk2::TextView->new, [ [ '' ] ]); - -my $log_buf = $log_text->get_buffer(); -my $refcount_search; -#### far from window - -my %toggle; - -gtkadd($my_win->{window}, - gtkpack_(new Gtk2::VBox(0,0), - if_(!$::isExplain && !$::isEmbedded, 0, N("A tool to monitor your logs")), - if_(!$::isFile, 0, gtkadd(new Gtk2::Frame(N("Settings")), - gtkpack__(new Gtk2::VBox(0,2), - gtkpack__(new Gtk2::VBox(0,2), - # N("Show lines"), - gtkpack__(new Gtk2::HBox(0,0), - " " . N("matching") . " ", my $e_yes = new Gtk2::Entry(), - " " . N("but not matching") . " ", my $e_no = new Gtk2::Entry() - ) - ), - gtkpack_(new Gtk2::HBox(0,0), - 1, gtkadd(gtkset_border_width(new Gtk2::Frame(N("Choose file")),2), - gtkpack(gtkset_border_width(Gtk2::VBox->new(0,0),0), - map { $toggle{$_} = gtksignal_connect(new Gtk2::CheckButton($files{$_}{desc}), - clicked => sub { - $refcount_search++; - gtkset_sensitive($yy,$refcount_search); - }) } keys %files, - ) - ), - 0, gtkadd(gtkset_border_width(new Gtk2::Frame(N("Calendar")),2), - gtkpack__(gtkset_border_width(new Gtk2::VBox(0,0),5), - $cal_butt, $cal - ) - ) - ), - $yy, - ) - ) - ), - !$::isExplain ? (1, gtkadd(new Gtk2::Frame(N("Content of the file")), - create_scrolled_window($log_text) - )) : (1, create_scrolled_window($log_text)), - if_(!$::isExplain, 0, gtkadd(gtkset_border_width(gtkset_layout(Gtk2::HButtonBox->new, 'end'), 5), - if_(!$::isFile, gtksignal_connect(new Gtk2::Button(N("Mail alert")), - clicked => sub { - eval { alert_config() }; - if ($@ =~ /wizcancel/) { - $::Wizard_no_previous = 1; - $::Wizard_no_cancel = 1; - $::WizardWindow->destroy if defined $::WizardWindow; - undef $::WizardWindow; - } else { print "CRITICAL: \"$@\"\n" } - - })), - gtksignal_connect(new Gtk2::Button(N("Save")), clicked => \&save), - gtksignal_connect(new Gtk2::Button($::isEmbedded ? N("Cancel") : N("Quit")), clicked => \&quit) - ) - ) - ) - ); - -$::isFile && !$::isEmbedded and gtkset_size_request($log_text, 400, 500); - -$my_win->{window}->show_all(); -search() if $::isFile; -$my_win->main; - -sub quit { ugtk2->exit(0) } - -#------------------------------------------------------------- -# search functions -#------------------------------------------------------------- -sub search { - $log_text->window->freeze_updates(); - $log_buf->set_text('', -1); - if ($::isFile) { - parse_file($::File); - } else { - foreach (keys %files) { - parse_file($files{$_}{file}, $files{$_}{desc}) if $toggle{$_}->active; - } - } - $log_text->window->thaw_updates(); - $log_text->show(); - gtkflush(); -} - -local *F; -my $timer; - -sub parse_file { - local *F = *F; - my ($file, $descr) = @_; - - $file =~ s/\.gz$//; - my ($pbar, $win_pb); - unless ($::isEmbedded && $::isExplain) { - gtkadd($win_pb = gtkset_modal(new Gtk2::Window('toplevel'), 1), - gtkpack(new Gtk2::VBox(2,0), - new Gtk2::Label(" " . N("please wait, parsing file: %s", $descr) . " "), - $pbar = new Gtk2::ProgressBar() - ) - ); - $win_pb->set_transient_for($my_win->{rwindow}) unless $::isEmbedded; - $win_pb->set_position('center'); - $win_pb->realize(); - $win_pb->show_all(); - gtkflush(); - } - my $ey = $e_yes->get_chars(0, -1); - my $en = $e_no->get_chars(0, -1); - $ey =~ s/ OR /\|/; - $ey =~ s/^\*$//; - $en =~ s/^\*$/.*/; - $ey = $ey . $::Word if $::isWord; - - if ($cal_mode) { - my (undef, $month, $day) = $cal->get_date(); - $ey = $months[$month]."\\s{1,2}$day\\s.*$ey.*\n"; - } - - my @all = catMaybeCompressed($file); - - if ($::isExplain) { - my (@t, $t); - while (@all) { - $t = pop @all; - next if $t =~ /logdrake/; - last if $t !~ /$::Explain/; - push @t, $t; - } - @all = reverse @t; - } - - my $taille = @all; - my $i = 0; - foreach (@all) { - $i++; - if ($pbar && $i % 10) { - $pbar->set_fraction($i/$taille); - $win_pb->window->process_updates(1); # no gtkflush() because we do not want to refresh the TextView - } - - 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 !$::isEmbedded || !$::isExplain; - - if ($::isTail) { - close F; - open F, $file or die "E: $!"; - local $_; - while (<F>) {}; #to prevent to output the file twice.. -# $log_text->set_point($log_text->get_length()); - $timer ||= Gtk2->timeout_add(1000, sub { - logcolorize($_) while <F>; - seek F, 0, 1; - }); - } -} - - -########################################################################################## - -sub logcolorize { - local $_ = shift; #my ($data) = @_; - - # we get date & time if it is date & time (dmesg) - s/(\D{3} .. (\d\d:\d\d:\d\d ))//; - my $timestamp = $::isExplain ? $2 : $1; - my @rec = split; - - log_output($timestamp, { %b, 'foreground' => 'darkcyan' }); # date & time if any... - # BUG: $col hasn't yet be reseted - $::isExplain or log_output("$rec[0] ", { %b, 'foreground' => $rec[0] eq $h ? 'blue' : $col }); # hostname - - if ($rec[1] eq "last") { - log_output(" last message repeated ", { %n, 'foreground' => 'green' }); - log_output($rec[4], { %b, 'foreground' => 'green' }); - log_output(" times\n", { %n, 'foreground' => 'green' }); - return; - } - # Extract PID if present - if ($rec[1] =~ /\[(\d+)\]\:/) { - my ($pid) = $1; - $rec[1] =~ s/\[$1\]\://; - log_output($rec[1] . "[", { %n, 'foreground' => 'green' }); - log_output($pid, { %b, 'foreground' => 'black' }); - log_output("]: ", { %n, 'foreground' => 'green' }); - } - else { - log_output($rec[1] . " ", { %n, 'foreground' => 'green' }); - } - - foreach my $therest (2 .. $#rec) { - $col = 'darkcyan'; - - # Check for keywords to highlight - foreach (@word_good) { $col = $col_good if $_ eq $rec[$therest] } - foreach (@word_warn) { $col = $col_warn if $_ eq $rec[$therest] } - foreach (@word_bad) { $col = $col_bad if $_ eq $rec[$therest] } - foreach (@word_note) { $col = $col_note if $_ eq $rec[$therest] } - - # Watch for words that indicate entire lines should be highlighted - #foreach (@line_good) { $col = $col_good if $_ eq $rec[$therest] } - #foreach (@line_warn) { $col = $col_warn if $_ eq $rec[$therest] } - #foreach (@line_bad) { $col = $col_bad if $_ eq $rec[$therest] } - - log_output("$rec[$therest] ", { %n, 'foreground' => $col }); - } - log_output("\n", { %n, 'foreground' => 'black' }); -} - - -# log_output (Gtk2::TextView, [ [ ... ] ]) -sub log_output { - gtktext_append($log_text, [ \@_ ]); - $log_text->scroll_to_iter(my $iter = $log_buf->get_end_iter, 0, 1, 0.5, 0.5); - $iter->free; -} - - -#------------------------------------------------------------- -# mail/sms alert -#------------------------------------------------------------- - -sub alert_config { - - $::isWizard = 1; - $::Wizard_pix_up = "wiz_logdrake.png"; # FIXME - $::Wizard_title = N("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, $email); - $load = 3; - - begin: - $::Wizard_finished = 0; - $::Wizard_no_previous = 1; - $in->ask_okcancel(N("Mail alert configuration"), - N("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 => N("Apache World Wide Web Server"), - bind => N("Domain Name Resolver"), - ftp => N("Ftp Server"), - postfix => N("Postfix Mail Server"), - samba => N("Samba Server"), - sshd => N("SSH Server"), - webmin => N("Webmin Service"), - xinetd => N("Xinetd Service") - }; - my @installed_d; - foreach my $serv (keys %$service) { - -e "$initdir/$serv" && push @installed_d, $serv; - } - my %services_to_check; - $in->ask_from(N("service setting"), - N("You will receive an alert if one of the selected services is no longer running"), - [ map { { label => $_, val => \$services_to_check{$_}, type => "bool", text => $service->{$_} } } @installed_d - ]) or goto begin; - - $cron .= "#- check services\n"; - foreach (keys %services_to_check) { - next unless $services_to_check{$_}; - $cron .= "\$r .= \"Service $_ ($service->{$_} is not running)\\n\" unless -e \"/var/lock/subsys/$_\";\n"; - } - - step_load: - undef $::Wizard_finished; - $in->ask_from(N("load setting"), - N("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 .= sprintf(<<'EOF', $load); -#- load -my ($load) = split ' ', first(cat_("/proc/loadavg")); -$r .= "Load is huge: $load\n" if $load > %s; - -EOF - - step_output: -# $::Wizard_no_previous = 1; - $::Wizard_finished = 1; - $in->ask_from(N("alert configuration"), - N("Please enter your email address below "), - [ - { label => "" }, - { label => "Email", val => \$email }, - ]) or goto step_load; - - $cron .= q(#- report it - -my $email = ) . "'$email';\n\n"; - - $cron .= q(local *F; -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; - - undef $::isWizard; - if (defined $::WizardWindow) { - $::WizardWindow->destroy; - undef $::WizardWindow; - } -} - - -#------------------------------------------------------------- -# menu callback functions -#------------------------------------------------------------- - - -sub save { - $::isWizard = 0; - $yy = $in->ask_file(N("Save as.."), "/root") or return; - my $buf = $log_text->get_buffer; - output($yy, $buf->get_text(($buf->get_bounds), 0)); -} diff --git a/perl-install/standalone/lsnetdrake b/perl-install/standalone/lsnetdrake deleted file mode 100755 index d6233209d..000000000 --- a/perl-install/standalone/lsnetdrake +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); -use standalone; -use network::nfs; -use network::smb; -use MDK::Common::Func qw(if_); - -"@ARGV" =~ /-h/ and die "usage: lsnetdrake [-h] [--nfs] [--smb]\n"; - -my $nfs = !@ARGV || "@ARGV" =~ /-(nfs)/; -my $smb = !@ARGV || "@ARGV" =~ /-(smb)/; - -$| = 1; -$ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}"; - -foreach my $class (if_($nfs, network::nfs->new), if_($smb, network::smb->new)) { - foreach my $server (sort_names($class->find_servers)) { - foreach (sort_names(eval { $class->find_exports($server) })) { - print $class->to_fullstring($_), "\n"; - } - } -} - -sub sort_names { - sort { $a->{name} cmp $b->{name} } @_; -} diff --git a/perl-install/standalone/mousedrake b/perl-install/standalone/mousedrake deleted file mode 100755 index e6048a173..000000000 --- a/perl-install/standalone/mousedrake +++ /dev/null @@ -1,69 +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; - - -my $in = 'interactive'->vnew('su'); - -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}; -} - -if (!$mouse || !$::auto) { - $mouse ||= mouse::fullname2mouse("serial|Generic 2 Button Mouse"); - my $test_hbox; - if ($::isEmbedded && $in->isa('interactive::gtk')) { - #- HACK: waiting for the ask_from_treelistf to attach itself - #- and adding the nice test mouse to it - Gtk2->timeout_add(100, sub { - defined $::Plug && defined $::Plug->child or return 1; - $test_hbox = Gtk2::HBox->new(0, 0); - $::WizardTable->attach($test_hbox, 2, 3, 1, 2, ['fill', 'expand'], ['fill', 'expand'], 0, 0); - $test_hbox->show_all; - mouse::test_mouse_standalone($mouse, $test_hbox); - 0; - }); - } - my $name = $in->ask_from_treelistf('mousedrake', N("Please choose your mouse type."), '|', - sub { join '|', map { translate($_) } split '\|', $_[0] }, - [ mouse::fullnames ], - $mouse->{type} . '|' . $mouse->{name}); - $name or $in->exit(0); - my $mouse_chosen = mouse::fullname2mouse($name); - $mouse = $mouse_chosen if !($mouse->{type} eq $mouse_chosen->{type} && $mouse->{name} eq $mouse_chosen->{name}); - - if ($mouse->{device} eq "usbmouse") { - modules::load_category('bus/usb') or die 'no usb bus found\n'; - modules::load(qw(hid mousedev usbmouse)); - } - - $mouse->{XEMU3} = 'yes' if $mouse->{nbuttons} < 3 && (!$::noauto || $in->ask_yesorno('', N("Emulate third button?"), 1)); - - $mouse->{device} = $in->ask_from_listf(N("Mouse Port"), - N("Please choose which serial port your mouse is connected to."), - \&mouse::serial_port2text, - [ mouse::serial_ports ], - $mouse->{device}, - ) || goto begin if $mouse->{type} eq 'serial'; - $test_hbox and $test_hbox->destroy; -} - -mouse::write_conf($in, $mouse, 1); -system('service', 'gpm', 'restart') if -e '/var/lock/subsys/gpm'; - -$in->exit(0); -goto begin; diff --git a/perl-install/standalone/net_monitor b/perl-install/standalone/net_monitor deleted file mode 100755 index 2df918780..000000000 --- a/perl-install/standalone/net_monitor +++ /dev/null @@ -1,571 +0,0 @@ -#!/usr/bin/perl - -# Monitor - -# 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 strict; -use standalone; #- warning, standalone must be loaded very first, for 'explanations' - -#- languages that can't be displayed with gtk1, so we unset translations -#- for them until this tool is ported to gtk2 -if ($ENV{LANGUAGE} =~ /\b(ar|he|hi|ta)/) { $ENV{LANGUAGE} = "C" }; - -use my_gtk qw(:helpers :wrappers); -use common; -use network::netconnect; -use network::tools; -use MDK::Common::Globals "network", qw($in $prefix $connect_file $disconnect_file $connect_prog); - -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; - -require_root_capability(); - -my $window1 = my_gtk->new('net_monitor'); -$window1->{rwindow}->signal_connect(delete_event => sub { my_gtk->exit(0) }); -unless ($::isEmbedded) { - $window1->{rwindow}->set_position(1) ; - $window1->{rwindow}->set_title(N("Network Monitoring")); - $window1->{rwindow}->set_policy(1, 1, 1); - $window1->{rwindow}->set_border_width(5); -} -#$::isEmbedded or $window1->{rwindow}->set_usize(580, 320); - -my $colorr = gtkcolor(50400, 655, 20000); -my $colort = gtkcolor(55400, 55400, 655); -my $colora = gtkcolor(655, 50400, 655); -my $isconnected = -1; -my @interfaces; -my $monitor = {}; -my $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} || "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->{window}, - gtkpack_(new Gtk::VBox(0,5), - 0, N("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(N("Settings")), 'etched_out'), - gtkpack__(gtkset_border_width(new Gtk::VBox(0,5),5), - gtkpack__(new Gtk::HBox(0,0), - N("Connection type: "), my $label_cnx_type = new Gtk::Label("")), - gtkpack__(new Gtk::HBox(0,0), - N("Profile "), $combo1) - ) - ), - 1, gtkadd(gtkset_shadow_type(new Gtk::Frame(N("Statistics")), 'etched_out'), - gtkpack__(new Gtk::VBox(0,0), - create_packtable({ col_spacings => 1, row_spacings => 1 }, - [ "", "instantaneous" , "average"], - [ N("Sending Speed:"), my $label_st = new Gtk::Label(""), my $label_sta = new Gtk::Label("na")], - [ N("Receiving Speed:"),my $label_sr = new Gtk::Label(""), my $label_sra = new Gtk::Label("na")], - ), - gtkpack__(new Gtk::HBox(0,0), " " . N("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(N("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(N("Close")), clicked => sub { my_gtk->exit(0) }), - ) - ) - ) - ), - 0, my $statusbar = new Gtk::Statusbar - ) - ); -$window1->{rwindow}->show_all; -$window1->{rwindow}->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->{rwindow}->window); -$gct->set_foreground($colort); -my $gcr = new Gtk::Gdk::GC($window1->{rwindow}->window); -$gcr->set_foreground($colorr); -my $gca = new Gtk::Gdk::GC($window1->{rwindow}->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(N("Wait please")) - )); -$statusbar->push(1, N("Wait please, testing your connection...")); -$window1->{rwindow}->show_all(); -#$window1->{rwindow}->set_policy (1, 1, 1); - -my $time_tag = Gtk->timeout_add(1000, \&rescan); -my $time_tag2 = Gtk->timeout_add(1000, \&update); - -update(); -rescan(); - -while ($isconnected == -2 || $isconnected == -1) { - ugtk::gtkflush() -} - -Gtk->timeout_remove($time_tag2); -$time_tag2 = Gtk->timeout_add(20000, \&update); - -connection() if $connect && !$isconnected || $disconnect && $isconnected; -$window1->main; -my_gtk->exit(0); - -my $during_connection; -my $first; - -sub connection { - $during_connection = 1; - my $wasconnected = $isconnected; - - $button_connect->set_sensitive(0); - $button_close->set_sensitive(0); - $statusbar->pop(1); - $statusbar->push(1, $wasconnected ? N("Disconnecting from the Internet ") : N("Connecting to the Internet ")); - if ($wasconnected == 1) { - $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; - $first = 1; - - my $tag = Gtk->timeout_add(1000, sub { - $statusbar->pop(1); - $statusbar->push(1, ($wasconnected == 1 ? N("Disconnecting from the Internet ") : N("Connecting to the Internet ")) - . join('', map { "." } (1..$nb_point))); - $nb_point++; - if ($nb_point < 4) { return 1 } - my $ret = 1; - - my $isconnect = test_connected(0); - - if ($nb_point < 20) { - if ($first == 1) { # first time - if ($isconnect == -2) { # wait for last test to finish - test_connected(2); # not yet terminated, try to cancel it - return 1; - } - test_connected(1); # initiates new connection test - $first = 0; - return 1; - } - if ($isconnect == -2) { return 1 } # no result yet, wait. - if ($isconnect == $wasconnected) { - # we got a test result; but the connection state did not change; retry. - test_connected(1); - return 1; - } - } - # either we got a result, or we timed out. - if ($isconnect != -2 or $nb_point > 20) { - $isconnected = $isconnect; - $ret = 0; - $statusbar->pop(1); - $statusbar->push(1, $wasconnected ? ($isconnected ? - N("Disconnection from the Internet failed.") : - N("Disconnection from the Internet complete.")) : - ($isconnected ? - N("Connection complete.") : - N("Connection failed.\nVerify your configuration in the Mandrake Control Center.")) - ); - my $delay = 1000; - # keep the message displayed longer if there is a problem. - if ($isconnected == $wasconnected) { $delay = 5000 } - my $tag3 = Gtk->timeout_add($delay, sub { - - $button_connect->set_sensitive(1); - $button_close->set_sensitive(1); - undef $during_connection; - update(); - return 0; - }); - } # END IF - return $ret }); - - my $netc = {}; - Gtk->main_iteration while Gtk->events_pending; - - if ($wasconnected == 1) { - system("/etc/sysconfig/network-scripts/net_cnx_down &"); - } else { - system("/etc/sysconfig/network-scripts/net_cnx_up &"); - } -} - -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(N("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(N("OK")), clicked => sub { $doit = 1; Gtk->main_quit() }), - gtksignal_connect(new Gtk::Button(N("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 { - if (!$during_connection) { - my $isconnect = test_connected(0); - if ($isconnect != -2) { - $isconnected = $isconnect; # save current state - $isconnect = test_connected(1); # start new test - } - }; - - my @intfs = get_val(); # get values from /proc file system - if ($combo1->entry->get_text ne ($netcnx->{PROFILE} || "default")) { - $combo1->entry->set_text($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); - }), - N("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); - }), - N("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); - }), - N("average")) - ), - 0, gtkpack__(gtkset_border_width(new Gtk::VBox(0,0), 5), - gtkadd(gtkset_shadow_type(new Gtk::Frame(N("Local measure")), 'etched_out'), - gtkpack__(gtkset_border_width(new Gtk::VBox(0,0), 5), - gtkpack__(new Gtk::HBox(0,0), - N("sent: "), - my $measure_t = new Gtk::Label("0") - ), - gtkpack__(new Gtk::HBox(0,0), - N("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 = N("transmitted"); - (150 - $y) * $scale / 150 < $received and $type = N("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 = $_; - $notebook->remove_page($monitor->{$intf}{page}) unless member($intf,@intfs); - } - @interfaces = @intfs; - my $netc = {}; - if ($isconnected != -2 && $isconnected != -1 && !$during_connection) { - if ($isconnected == 1 && !in_ifconfig($netcnx->{NET_INTERFACE})) { - $isconnected = 0; - $statusbar->pop(1); - $statusbar->push(1, N("Warning, another internet connection has been detected, maybe using your network")); - } else { - #- translators : $netcnx->{type} is the type of network connection (modem, adsl...) - $statusbar->pop(1); - $statusbar->push(1, $isconnected == 1 ? N("Connected") : N("Not connected")); - } - $label_c->set($isconnected == 1 ? N("Disconnect %s", $netcnx->{type}) : N("Connect %s", $netcnx->{type})); - $isconnected == 1 ? $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 7d4576656..000000000 --- a/perl-install/standalone/printerdrake +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/perl - -# printerdrake -# Copyright (C) 1999-2002 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 common; -use interactive; -use printer::printerdrake; -use printer::main; -use modules; -use c; - -local $_ = join '', @ARGV; - -printer::main::get_usermode (); - -my $printer; - -my $in = 'interactive'->vnew('su', if_(!$::isEmbedded, 'printer-mdk')); - -my $commandline = $_; - -exit 0 unless printer::printerdrake::first_time_dialog($printer, $in, 1); - -{ -# Check whether Foomatic is installed and install it if necessary -printer::printerdrake::install_foomatic($in); - -my $w = $in->wait_message(N("Printerdrake"), - N("Reading data of installed printers...")); -# Get what was installed before -eval { $printer = printer::main::getinfo('') }; -# Choose the spooler by command line options -$commandline =~ /-cups/ and - $printer->{SPOOLER} = 'cups' and printer::main::read_configured_queues($printer); -$commandline =~ /-lpr/ and - $printer->{SPOOLER} = 'lpd' and printer::main::read_configured_queues($printer); -$commandline =~ /-lpd/ and - $printer->{SPOOLER} = 'lpd' and printer::main::read_configured_queues($printer); -$commandline =~ /-lprng/ and - $printer->{SPOOLER} ='lprng' and printer::main::read_configured_queues($printer); -$commandline =~ /-pdq/ and - $printer->{SPOOLER} = 'pdq' and printer::main::read_configured_queues($printer); --r '/etc/modules.conf' and modules::mergein_conf('/etc/modules.conf'); -} - -printer::printerdrake::main($printer, $in, 1); diff --git a/perl-install/standalone/scannerdrake b/perl-install/standalone/scannerdrake deleted file mode 100755 index c1e334e91..000000000 --- a/perl-install/standalone/scannerdrake +++ /dev/null @@ -1,787 +0,0 @@ -#!/usr/bin/perl - -# scannerdrake $Id$ -# Yves Duret <yduret at mandrakesoft.com> -# Copyright (C) 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 as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use lib qw(/usr/lib/libDrakX); -use strict; -use standalone; #- warning, standalone must be loaded very first, for 'explanations' -use common; - -use interactive; -use scanner; -use handle_configs; -use services; - -foreach (@ARGV) { - /^--update-usbtable$/ and do { scanner::updateScannerDBfromUsbtable(); exit() }; - /^--update-sane=(.*)$/ and do { scanner::updateScannerDBfromSane($1); exit() }; - /^--manual$/ and $::Manual=1; - /^--dynamic=(.*)$/ and do { dynamic($1); exit() }; -} - -my $in = 'interactive'->vnew('su'); -if (!files_exist('/usr/bin/scanimage', - '/usr/bin/xsane', - if_(files_exist("/usr/bin/gimp"), - "/usr/lib/gimp/*/plug-ins/xsane"))) { - $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(N("Scannerdrake"), - N("Searching for configured scanners ...")); -my @c = scanner::configured(); -$wait = undef; -$wait = $in->wait_message(N("Scannerdrake"), - N("Searching for new scanners ...")); -my @f = scanner::detect(@c); -$wait = undef; -my $changed = 0; -@f and $changed = auto(); -if ($changed) { - my $wait = - $in->wait_message(N("Scannerdrake"), - N("Re-generating list of configured scanners ...")); - @c = scanner::configured(); -} -mainwindow(@c); -quit(); - -sub removeverticalbar { - my ($s) = @_; - $s =~ s/\|/ /g; - $s =~ /^\s*(\S+)\s+/; - my $make = $1; - my $searchmake = handle_configs::searchstr($make); - $s =~ s/($searchmake)\s*$searchmake/$1/; - return $s; -} - -sub auto { - my $changed = 0; - foreach (@f) { - my $c = 0; - if (member($_->{val}{DESCRIPTION}, keys %$scanner::scannerDB)) { - my $name = $_->{val}{DESCRIPTION}; - $name =~ s/\s$//; # some HP entries have a trailing space, i will correct usbtable asap - if ($scanner::scannerDB->{$name}{flags}{unsupported}) { - $in->ask_warn('Scannerdrake', N("The %s is not supported by this version of Mandrake Linux.", removeverticalbar($name))); - next; - } - if ($in->ask_yesorno('Scannerdrake', N("%s found on %s, configure it automatically?", removeverticalbar($name), $_->{port}),1)) { - $c = (tryConfScanner($name, $_->{port}, - $_->{val}{vendor}, - $_->{val}{id}) or - manual($_->{port}, $_->{val}{vendor}, - $_->{val}{id}, $name)); - } else { - $c = manual($_->{port}, $_->{val}{vendor}, - $_->{val}{id}, $name); - } - } else { - $in->ask_yesorno('Scannerdrake', - N("%s is not in the scanner database, configure it manually?", - removeverticalbar($_->{val}{DESCRIPTION})),1) - and ($c = - manual($_->{port}, $_->{val}{vendor}, $_->{val}{id}, - $_->{val}{DESCRIPTION})); - } - $changed ||= $c; - } - return $changed; -} - -sub manual { - my ($port, $vendor, $product, $name) = @_; - my $s = - $in->ask_from_treelist('Scannerdrake', - N("Select a scanner model") . - if_($port || $name, N(" (")) . - if_($name, N("Detected model: %s", - removeverticalbar($name))) . - if_($port && $name, N(", ")) . - if_($port, N("Port: %s", $port)) . - if_($port || $name, N(")")), - '|', [' None', keys %$scanner::scannerDB], - '') or return 0; - return 0 if $s eq ' None'; - if ($scanner::scannerDB->{$s}{flags}{unsupported}) { - $in->ask_warn('Scannerdrake', N("The %s is not supported by this version of Mandrake Linux.", removeverticalbar($s))); - return 0; - } - return tryConfScanner($s, $port, $vendor, $product); -} - -sub dynamic { - @f = scanner::detect(); - my $name; - foreach (@f) { - if (member($_->{val}{DESCRIPTION}, keys %$scanner::scannerDB)) { - $name = $_->{val}{DESCRIPTION}; - $name =~ s/\s$//; #some HP entry have a trailing space, i will correct usbtable asap - if ($scanner::scannerDB->{$name}{flags}{unsupported}) { - $in->ask_warn('Scannerdrake', N("The %s is not supported by this version of Mandrake Linux.", removeverticalbar($name))); - next; - } - scanner::confScanner($name, $_->{port}, - $_->{val}{vendor}, $_->{val}{id}); - } else { - $in->ask_warn('Scannerdrake', N("The %s is not known by this version of Scannerdrake.", removeverticalbar($name))); - } - } -} - -sub tryConfScanner { - # take care if interactive output is needed (unsupported, parallel..) - my ($model, $port, $vendor, $product) = @_; - if ($scanner::scannerDB->{$model}{flags}{unsupported}) { - $in->ask_warn('Scannerdrake', N("The %s is unsupported", - removeverticalbar($model))); - return 0; - } - if ($scanner::scannerDB->{$model}{server} =~ /(printerdrake|hpoj)/i) { - $in->ask_warn('Scannerdrake', N("The %s must be configured by printerdrake.\nYou can launch printerdrake from the Mandrake Control Center in Hardware section.", removeverticalbar($model))); - return 0; - } - if ($scanner::scannerDB->{$model}{ask} =~ /DEVICE/ || !$port) { - $port ||= N("Auto-detect available ports"); - $in->ask_from('Scannerdrake', - N("Please select the device where your %s is attached", removeverticalbar($model)) . " " . - N("(Note: Parallel ports cannot be auto-detected)"), - [ - { label => N("choose device"), - val => \$port, - list => [N("Auto-detect available ports"), - '/dev/scanner', - '/dev/usb/scanner0', - '/dev/usb/scanner1', - '/dev/usb/scanner2', - 'libusb:001:001', - 'libusb:001:002', - 'libusb:001:003', - 'libusb:001:004', - 'libusb:001:005', - 'libusb:001:006', - 'libusb:001:007', - 'libusb:001:008', - 'libusb:001:009', - 'libusb:001:010', - '/dev/sg0', - '/dev/sg1', - '/dev/sg2', - '/dev/sg3', - '/dev/sg4', - '/dev/parport0', - '/dev/parport1', - '/dev/parport2', - '/dev/pt_drv', - '/dev/ttyS0', - '/dev/ttyS1', - '/dev/ttyS2'], - not_edit => 0, sort => 0 }, - ], - ) or return 0; - if ($port eq N("Auto-detect available ports")) { - $wait = $in->wait_message(N("Scannerdrake"), - N("Searching for scanners ...")); - my @d = scanner::detect(); - undef $wait; - my @list = map { - $_->{port} . " (" . - removeverticalbar($_->{val}{DESCRIPTION}) . ")"; - } @d; - $port ||= $list[0]; - $in->ask_from('Scannerdrake', - N("Please select the device where your %s is attached", removeverticalbar($model)), - [ - { label => N("choose device"), - val => \$port, - list => \@list, - not_edit => 1, sort => 0 }, - ], - ) or return 0; - $port =~ s/^\s*([^\(\s]*)\s*\(.*$/$1/; - foreach (@d) { - next if $_->{port} ne $port; - $vendor = $_->{val}{vendor}; - $product = $_->{val}{id}; - last; - } - } - } - ($vendor, $product) = scanner::get_usb_ids_for_port($port); - scanner::confScanner($model, $port, $vendor, $product); - $in->ask_warn(N("Congratulations!"), - N("Your %s has been configured.\nYou may now scan documents using \"XSane\" from Multimedia/Graphics in the applications menu.", removeverticalbar($model))); - return 1; -} - -sub quit { - $in->exit(0); -} - -sub mainwindow { - my @configured = @_; - # main loop - my $maindone; - while (!$maindone) { - # Generate list of configured scanners - my $msg = do { - if (@configured) { - my @scannerlist = - map { - my $entry = $_->{val}{DESCRIPTION}; - if_($entry, " - $entry\n"); - } @configured; - if (@scannerlist) { - my $main_msg = - @scannerlist > 1 ? - N_("The following scanners\n\n%s\nare available on your system.\n") : - N_("The following scanner\n\n%s\nis available on your system.\n"); - sprintf($main_msg, join('', @scannerlist)); - } else { - N("There are no scanners found which are available on your system.\n"); - } - } else { - N("There are no scanners found which are available on your system.\n"); - } - }; - my $buttonclicked; - #- Show dialog - if ($in->ask_from_ - ( - { - title => N("Scannerdrake"), - messages => $msg, - ok => "", - cancel => "", - }, - [ - { val => N("Search for new scanners"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "autoadd"; - 1; - } }, - { val => N("Add a scanner manually"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "manualadd"; - 1; - } }, - { val => N("Scanner sharing"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "sharing"; - 1; - } }, - { val => N("Quit"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "quit"; - 1; - } }, - ] - ) - ) { - my $changed = 0; - if ($buttonclicked eq "autoadd") { - # Do scanner auto-detection - my $wait = - $in->wait_message(N("Scannerdrake"), - N("Searching for configured scanners ...")); - @configured = scanner::configured(); - $wait = - $in->wait_message(N("Scannerdrake"), - N("Searching for new scanners ...")); - my @f = scanner::detect(@configured); - $wait = undef; - if (@f) { - $changed = auto(); - } - } elsif ($buttonclicked eq "manualadd") { - # Show dialogs to manually add a scanner - $changed = manual(); - } elsif ($buttonclicked eq "sharing") { - # Show dialog to set up scanner sharing - $changed = sharewindow(@configured); - } elsif ($buttonclicked eq "quit") { - # We have clicked "Quit" - $maindone = 1; - } - if ($changed) { - my $wait = - $in->wait_message(N("Scannerdrake"), - N("Re-generating list of configured scanners ...")); - @configured = scanner::configured(); - } - } else { - # Cancel clicked - $maindone = 1; - } - } -} - -sub makeexportmenues { - my @exports = @_; - my %menuexports = map { - ($_ eq '+' ? N("All remote machines") : $_) => $_; - } map { - # Remove comments and blank lines - (/^\s*($|\#)/ ? () : chomp_($_)); - } @exports; - my %menuexports_inv = reverse %menuexports; - return (\%menuexports, \%menuexports_inv); -} - -sub makeimportmenues { - my @imports = @_; - my %menuimports = map { - ($_ eq 'localhost' ? N("This machine") : $_) => $_; - } map { - # Remove comments and blank lines - if_(!/^\s*($|\#)/, chomp_($_)); - } @imports; - my %menuimports_inv = reverse %menuimports; - return (\%menuimports, \%menuimports_inv); -} - -sub sharewindow { - my @configured = @_; - # Read list of hosts to where to export the local scanners - my @exports = cat_("/etc/sane.d/saned.conf"); - my ($menuexports, $menuexports_inv) = - makeexportmenues(@exports); - # Read list of hosts from where to import scanners - my @imports = cat_("/etc/sane.d/net.conf"); - my ($menuimports, $menuimports_inv) = - makeimportmenues(@imports); - # Is saned running? - my $sanedrunning = services::starts_on_boot("saned"); - my $oldsanedrunning = $sanedrunning; - # Is the "net" SANE backend active - my $netbackendactive = grep { /^\s*net\s*$/ } - cat_("/etc/sane.d/dll.conf"); - my $oldnetbackendactive = $netbackendactive; - # Set this to 1 to tell the caller that the list of locally available - # scanners has changed (Here if the SANE client configuration has - # changed) - my $changed = 0; - my $importschanged = 0; - # main loop - my $maindone; - while (!$maindone) { - my $buttonclicked; - #- Show dialog - if ($in->ask_from_ - ( - { - title => N("Scannerdrake"), - messages => N("Here you can choose whether the scanners connected to this machine should be accessable by remote machines and by which remote machines.") . - N("You can also decide here whether scanners on remote machines should be made available on this machine."), - }, - [ - { text => N("The scanners on this machine are available to other computers"), type => 'bool', - val => \$sanedrunning }, - { val => N("Scanner sharing to hosts: ") . - (keys %{$menuexports} > 0 ? - (keys %{$menuexports} > 2 ? - join(", ", (keys %{$menuexports})[0,1]) . " ..." : - join(", ", keys %{$menuexports})) : - N("No remote machines")), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "exports"; - 1; - }, - disabled => sub { - !$sanedrunning; - } }, - { text => N("Use scanners on remote computers"), - type => 'bool', - val => \$netbackendactive }, - { val => N("Use the scanners on hosts: ") . - (keys %{$menuimports} > 0 ? - (keys %{$menuimports} > 2 ? - join(", ", (keys %{$menuimports})[0,1]) . " ..." : - join(", ", keys %{$menuimports})) : - N("No remote machines")), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "imports"; - 1; - }, - disabled => sub { - !$netbackendactive; - } }, - ] - ) - ) { - if ($buttonclicked eq "exports") { - # Show dialog to add hosts to share scanners to - my $subdone = 0; - my $choice; - while (!$subdone) { - my @list = keys %{$menuexports}; - # Entry should be edited when double-clicked - $buttonclicked = "edit"; - $in->ask_from_ - ( - { title => N("Sharing of local scanners"), - messages => N("These are the machines on which the locally connected scanner(s) should be available:"), - ok => "", - cancel => "", - }, - # List the hosts - [ { val => \$choice, format => \&translate, - sort => 0, separator => "####", - tree_expanded => 1, - quit_if_double_click => 1, - allow_empty_list => 1, - list => \@list }, - { val => N("Add host"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "add"; - 1; - } }, - { val => N("Edit selected host"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "edit"; - 1; - }, - disabled => sub { - return ($#list < 0); - } }, - { val => N("Remove selected host"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "remove"; - 1; - }, - disabled => sub { - return ($#list < 0); - } }, - { val => N("Done"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = ""; - $subdone = 1; - 1; - } }, - ] - ); - if ($buttonclicked eq "add" || - $buttonclicked eq "edit") { - my ($hostchoice, $ip); - if ($buttonclicked eq "add") { - # Use first entry as default for a new entry - $hostchoice = - N("Name/IP address of host:"); - } else { - if ($menuexports->{$choice} eq '+') { - # Entry is "All hosts" - $hostchoice = $choice; - } else { - # Entry is a name/an IP address - $hostchoice = - N("Name/IP address of host:"); - $ip = $choice; - } - } - my @menu = (N("All remote machines"), - N("Name/IP address of host:")); - # Show the dialog - my $address; - my $oldaddress = - ($buttonclicked eq "edit" ? - $menuexports->{$choice} : ""); - if ($in->ask_from_ - ( - { title => N("Sharing of local scanners"), - messages => N("Choose the host on which the local scanners should be made available:"), - callbacks => { - complete => sub { - if ($hostchoice eq $menu[0]) { - $address = "+"; - } elsif ($hostchoice eq $menu[1]) { - $address = $ip; - } - # Do not allow an empty address - if ($address !~ /\S/) { - $in->ask_warn(N("Scannerdrake"), - N("You must enter a host name or an IP address.\n")); - return (1,0); - } - # Strip off leading and trailing - # spaces - $address =~ s/^\s*(.*?)\s*$/$1/; - # Check whether item is duplicate - if ($address ne $oldaddress && - member("$address\n", - @exports)) { - $in->ask_warn(N("Scannerdrake"), - N("This host is already in the list, it cannot be added again.\n")); - return (1,1); - } - return 0; - }, - }, - }, - # List the host types - [ { val => \$hostchoice, format => \&translate, - type => 'list', - sort => 0, - list => \@menu }, - { val => \$ip, - disabled => sub { - $hostchoice ne - N("Name/IP address of host:"); - } }, - ], - )) { - # OK was clicked, insert new item into the list - if ($buttonclicked eq "add") { - handle_configs::set_directive(\@exports, - $address); - } else { - handle_configs::replace_directive(\@exports, - $oldaddress, - $address); - } - # Refresh list of hosts - ($menuexports, $menuexports_inv) = - makeexportmenues(@exports); - # Position the list cursor on the new/modified - # item - $choice = $menuexports_inv->{$address}; - } - } elsif ($buttonclicked eq "remove") { - my $address = $menuexports->{$choice}; - handle_configs::remove_directive(\@exports, - $address); - # Refresh list of hosts - ($menuexports, $menuexports_inv) = - makeexportmenues(@exports); - } - } - } elsif ($buttonclicked eq "imports") { - # Show dialog to add hosts on which the scanners should be - # used - my $subdone = 0; - my $choice; - while (!$subdone) { - my @list = keys %{$menuimports}; - # Entry should be edited when double-clicked - $buttonclicked = "edit"; - $in->ask_from_ - ( - { title => N("Usage of remote scanners"), - messages => N("These are the machines from which the scanners should be used:"), - ok => "", - cancel => "", - }, - # List the hosts - [ { val => \$choice, format => \&translate, - sort => 0, separator => "####", - tree_expanded => 1, - quit_if_double_click => 1, - allow_empty_list => 1, - list => \@list }, - { val => N("Add host"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "add"; - 1; - } }, - { val => N("Edit selected host"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "edit"; - 1; - }, - disabled => sub { - return ($#list < 0); - } }, - { val => N("Remove selected host"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = "remove"; - 1; - }, - disabled => sub { - return ($#list < 0); - } }, - { val => N("Done"), - type => 'button', - clicked_may_quit => sub { - $buttonclicked = ""; - $subdone = 1; - 1; - } }, - ] - ); - if ($buttonclicked eq "add" || - $buttonclicked eq "edit") { - my ($hostchoice, $ip); - if ($buttonclicked eq "add") { - # Use first entry as default for a new entry - $hostchoice = - N("Name/IP address of host:"); - } else { - if ($menuimports->{$choice} eq 'localhost') { - # Entry is "This machine" - $hostchoice = $choice; - } else { - # Entry is a name/an IP address - $hostchoice = - N("Name/IP address of host:"); - $ip = $choice; - } - } - my @menu = (N("This machine"), - N("Name/IP address of host:")); - # Show the dialog - my $address; - my $oldaddress = - ($buttonclicked eq "edit" ? - $menuimports->{$choice} : ""); - if ($in->ask_from_ - ( - { title => N("Sharing of local scanners"), - messages => N("Choose the host on which the local scanners should be made available:"), - callbacks => { - complete => sub { - if ($hostchoice eq $menu[0]) { - $address = 'localhost'; - } elsif ($hostchoice eq $menu[1]) { - $address = $ip; - } - # Do not allow an empty address - if ($address !~ /\S/) { - $in->ask_warn(N("Scannerdrake"), - N("You must enter a host name or an IP address.\n")); - return (1,0); - } - # Strip off leading and trailing - # spaces - $address =~ s/^\s*(.*?)\s*$/$1/; - # Check whether item is duplicate - if ($address ne $oldaddress && - member("$address\n", - @imports)) { - $in->ask_warn(N("Scannerdrake"), - N("This host is already in the list, it cannot be added again.\n")); - return (1,1); - } - return 0; - }, - }, - }, - # List the host types - [ { val => \$hostchoice, format => \&translate, - type => 'list', - sort => 0, - list => \@menu }, - { val => \$ip, - disabled => sub { - $hostchoice ne - N("Name/IP address of host:"); - } }, - ], - )) { - # OK was clicked, insert new item into the list - if ($buttonclicked eq "add") { - handle_configs::set_directive(\@imports, - $address); - } else { - handle_configs::replace_directive(\@imports, - $oldaddress, - $address); - } - $importschanged = 1; - # Refresh list of hosts - ($menuimports, $menuimports_inv) = - makeimportmenues(@imports); - # Position the list cursor on the new/modified - # item - $choice = $menuimports_inv->{$address}; - } - } elsif ($buttonclicked eq "remove") { - my $address = $menuimports->{$choice}; - handle_configs::remove_directive(\@imports, - $address); - # Refresh list of hosts - ($menuimports, $menuimports_inv) = - makeimportmenues(@imports); - $importschanged = 1; - } - } - } else { - # We have clicked "OK" - $maindone = 1; - if ($importschanged) { - $changed = 1; - } - # Write /etc/sane.d/saned.conf - output("/etc/sane.d/saned.conf", @exports); - # Write /etc/sane.d/net.conf - output("/etc/sane.d/net.conf", @imports); - # Turn on/off saned - if ($sanedrunning != $oldsanedrunning) { - if ($sanedrunning) { - # Make sure saned and xinetd is installed and - # running - if (!files_exist('/usr/sbin/xinetd', - '/usr/sbin/saned')) { - $in->do_pkgs->install('xinetd', 'saned'); - } - # Start saned and make sure that it gets started on - # every boot - services::start_service_on_boot("saned"); - services::start_service_on_boot("xinetd"); - services::restart("xinetd"); - } else { - # Stop saned and make sure that it does not get - # started when booting - services::do_not_start_service_on_boot("saned"); - services::restart("xinetd"); - } - } - # Turn on/off "net" SANE backend - if ($netbackendactive != $oldnetbackendactive) { - my @dllconf = cat_("/etc/sane.d/dll.conf"); - if ($netbackendactive) { - handle_configs::set_directive(\@dllconf, "net"); - } else { - handle_configs::comment_directive(\@dllconf, "net"); - } - output("/etc/sane.d/dll.conf", @dllconf); - $changed = 1; - } - } - } else { - # Cancel clicked - $maindone = 1; - } - } - return $changed; -} diff --git a/perl-install/standalone/service_harddrake b/perl-install/standalone/service_harddrake deleted file mode 100755 index 9b960de5c..000000000 --- a/perl-install/standalone/service_harddrake +++ /dev/null @@ -1,100 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use strict; -use diagnostics; -use standalone; #- warning, standalone must be loaded very first, for 'explanations' -use common; -use interactive; -use harddrake::data; -use harddrake::sound; -use modules; -use Storable qw(store retrieve); - -my $invert_do_it = $ARGV[0] eq 'X11' ? 1 : 0; -my ($hw_sysconfdir, $timeout) = ("/etc/sysconfig/harddrake2", $invert_do_it ? 600 : 25); -my $last_boot_config = $hw_sysconfdir."/previous_hw"; - -$last_boot_config .= '_X11' if $invert_do_it; - -modules::mergein_conf('/etc/modules.conf'); - -# first run ? if not read old hw config -my $previous_config = -f $last_boot_config && -s $last_boot_config ? Storable::retrieve($last_boot_config) : {}; -$previous_config = $$previous_config if ref($previous_config) !~ /HASH/; -my (%config, $wait); -my $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 ^ $invert_do_it; - # No detector ? (should never happen but who know ?) - ref($detector) eq 'CODE' or next; - - my %ID = map { - my $i = $_; - my $id = defined $i->{device} ? $i->{device} : join(':', map { $i->{$_} } qw(vendor id subvendor subid)); - $id => $i; - } &$detector; - $config{$Ident} = \%ID; - next if is_empty_hash_ref $previous_config; # don't fsck on first run - - my $oldconfig = $previous_config->{$Ident}; - - my $msg; - my @was_removed = difference2([ keys %$oldconfig ], [ keys %ID ]); - if (@was_removed) { - $msg .= N("Some devices in the \"%s\" hardware class were removed:\n", $item) . - "- " . join('', map { harddrake::data::custom_id($oldconfig->{$_}, $item) . " was removed\n" } @was_removed) . "\n"; - } - my @added = difference2([ keys %ID ], [ keys %$oldconfig ]); - $msg .= N("Some devices were added:\n", $item) if @added; - $msg .= "- " . harddrake::data::custom_id($ID{$_}, $item) . " was added\n" foreach @added; - modules::load('ohci1394') if $Ident eq 'FIREWIRE_CONTROLLER' && any { $_->{driver} eq 'ohci1394' } @added; - @added || @was_removed or next; - my @configurator_pool; - if (harddrake::data::is_removable($Ident)) { - foreach my $device (@ID{@added}) { - push @configurator_pool, harddrake::data::set_removable_configurator($Ident, $device); - }; - foreach my $device (@$oldconfig{@was_removed}) { - push @configurator_pool, harddrake::data::set_removable_remover($Ident, $device); - } - } else { - @configurator_pool = $configurator; - } - next unless -x first(split /\s+/, $configurator_pool[0]); - foreach my $configurator (@configurator_pool) { - my ($pid, $no); - $SIG{ALRM} = sub { $no = 1; kill 15, $pid }; - unless ($pid = fork()) { - exec("/usr/share/harddrake/confirm 'Hardware changes in $Ident class ($timeout seconds to answer)' '" . $msg . "Do you want to run the appropriate config tool ?'"); - } - alarm($timeout); - wait(); - my $res = $?; - alarm(0); - if ($no) { - require interactive; - undef $wait; - $in ||= interactive->vnew; - $wait = $in->wait_message(N("Please wait"), N("Hardware probing in progress")); - } elsif ($res) { - if (fork()) { - wait(); - } else { exec("$configurator 2>/dev/null") or die "$configurator missing\n" } - } - } -} - -# output new hw config -log::explanations("created file $last_boot_config"); -Storable::store(\%config, $last_boot_config); - -# automatic sound slots configuration -harddrake::sound::configure_sound_slots(); -modules::write_conf(); - -$in->exit(0) if $in; diff --git a/perl-install/standalone/service_harddrake.sh b/perl-install/standalone/service_harddrake.sh deleted file mode 100644 index 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 |
