diff options
Diffstat (limited to 'perl-install/standalone')
40 files changed, 0 insertions, 6846 deletions
diff --git a/perl-install/standalone/XFdrake b/perl-install/standalone/XFdrake deleted file mode 100755 index 891722d50..000000000 --- a/perl-install/standalone/XFdrake +++ /dev/null @@ -1,96 +0,0 @@ -#!/usr/bin/perl - -# XFdrake -# Copyright (C) 1999 MandrakeSoft (pixel@mandrakesoft.com) -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use lib qw(/usr/lib/libDrakX); - -use interactive; -use standalone; -use modules; -use Xconfigurator; -use Xconfig; -use c; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; - -local $_ = join '', @ARGV; - -/-h/ and die "usage: XFdrake [--xf3] [--beginner] [--expert] [--auto] [--noauto] [--skiptest] [--testing]\n"; - -my $i = {}; - -$::force_xf3 = /-xf3/; -$::beginner = /-beginner/; -$::expert = /-expert/; -$::auto = /-auto/; -$::noauto = /-noauto/; -$::testing = /-testing/; -$i->{skiptest} = /-skiptest/; - -my $in = 'interactive'->vnew('su', 'X'); - --r '/etc/modules.conf' and modules::mergein_conf('/etc/modules.conf'); - -my $f = "/usr/X11R6/lib/X11/rgb.txt"; #- this one is on all platform (instead of Cards ?) -$in->do_pkgs->install('XFree86', 'XFree86-75dpi-fonts') if !-e $f; --e $f or die "install XFree86 first!\n"; - -`pidof xfs` > 0 or system("/etc/rc.d/init.d/xfs start") if !$i->{skiptest}; - -system("mount /proc 2>/dev/null"); # ensure /proc is mounted for pci probing - -begin: -Xconfig::getinfo($i); -Xconfig::getinfoFromXF86Config($i); #- take default from here at least. - -my $allowNVIDIA_rpms; -my (%list, %select); -local *F; -open F, "/var/lib/urpmi/depslist.ordered"; -while (<F>) { - /(.*NVIDIA.*)-([^-]*)-([^-]*)\s+/ and $list{$1} = 1; -} -close F; -if ($list{NVIDIA_GLX}) { - eval { - my ($version, $release, $ext) = `uname -r` =~ /([^-]*)-([^-]*mdk)(\S*)/; - $ext and $ext = "-$ext"; - $list{"NVIDIA_kernel-$version-$release$ext"} or die "no NVIDIA kernel for current kernel"; - $select{"NVIDIA_kernel-$version-$release$ext"} = 1; - foreach (`rpm -q kernel kernel-smp kernel-entreprise kernel22 kernel22-smp kernel22-secure`) { - ($ext, $version, $release) = /kernel[^-]*(-[^-]*)-([^-]*)-([^-]*mdk)/; - $list{"NVIDIA_kernel-$version-$release$ext"} and $select{"NVIDIA_kernel-$version-$release$ext"} = 1; - } - $allowNVIDIA_rpms = [ keys(%select), "NVIDIA_GLX" ]; - } -} -if (!$allowNVIDIA_rpms) { - my ($uname_r) = `uname -r` =~ /(\S+)/; - $allowNVIDIA_rpms = ((-e "/lib/modules/$uname_r/kernel/drivers/char/NVdriver.o.gz" || - -e "/lib/modules/$uname_r/kernel/drivers/char/NVdriver.o") && - -e "/usr/X11R6/lib/modules/drivers/nvidia_drv.o" && - -e "/usr/X11R6/lib/modules/extensions/libglx.so") && []; #- empty list but true. -} - -$::isEmbedded and kill USR2, $::CCPID; -Xconfigurator::main('', $i, $in, $in->do_pkgs, - { allowFB => $::expert, - allowNVIDIA_rpms => $allowNVIDIA_rpms }); -!$::isEmbedded and $in->exit(0); -kill USR1, $::CCPID; -goto begin; diff --git a/perl-install/standalone/adduserdrake b/perl-install/standalone/adduserdrake deleted file mode 100755 index d2893c850..000000000 --- a/perl-install/standalone/adduserdrake +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use common; -use interactive; -use standalone; -use any; - -local $_ = join '', @ARGV; - -/-h/ and die "usage: adduserdrake [--beginner] [--expert] [<users...>]\n"; - -$::beginner = /-beginner/; -$::expert = /-expert/; - -my @etc_pass_fields = qw(name pw uid gid realname home shell); -my @shells = grep { -x $_ } map { "/bin/$_" } qw(bash tcsh zsh ash ksh); -my $isMD5 = cat_("/etc/pam.d/passwd") =~ /md5/; -my $isShadow = cat_("/etc/pam.d/passwd") =~ /shadow/; - - -my $users = []; -my $in; - -if (my @l = grep { ! /^-/ } @ARGV) { - $users = [ map { { name => $_, realname => $_ } } @l ]; -} else { - $in = 'interactive'->vnew('su', 'user'); - any::ask_users('', $in, $users, $ENV{SECURE_LEVEL}); -} - -system("adduser", $_->{name}) foreach @$users; -any::addUsers('', $users); - -any::write_passwd_user('', $_, $isMD5) foreach @$users; -system("pwconv") if $isShadow; - -#$in->do_pkgs->install("autologin") if $o->{autologin}; -#any::set_autologin('', $o->{autologin}, $o->{desktop}); - -$in->exit(0) if $in; diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake deleted file mode 100755 index 4ae662a86..000000000 --- a/perl-install/standalone/diskdrake +++ /dev/null @@ -1,81 +0,0 @@ -#!/usr/bin/perl - -# DiskDrake -# Copyright (C) 1999 MandrakeSoft (pixel@mandrakesoft.com) -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -# DiskDrake uses resize_fat which is a perl rewrite of the work of Andrew -# Clausen (libresize). -# DiskDrake is also based upon the libfdisk and the install from Red Hat Software - - -use lib qw(/usr/lib/libDrakX); -use common; -use diskdrake_interactive; -use standalone; -use interactive; -use detect_devices; -use fsedit; -use fs; -use log; -use c; - - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -if ($::isEmbedded) { - print "EMBED\n"; - print "parent XID\t$::XID\n"; - print "mcc pid\t$::CCPID\n"; -} - -local $_ = join '', @ARGV; - -/-h/ and die "usage: diskdrake [--expert] [--testing]\n"; - -$::expert = /-expert/; -$::testing = /-testing/; - -if ($>) { - $ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}"; -} - - -my $in = 'interactive'->vnew('su'); -my ($all_hds) = - catch_cdie { fsedit::hds([ detect_devices::hds() ], {}) } - sub { - my ($err) = $@ =~ /(.*) at /; - $@ =~ /overlapping/ and $in->ask_warn('', $@), return 1; - $in->ask_okcancel(_("Error"), -[_("I can't read your partition table, it's too corrupted for me :( -I'll try to go on blanking bad partitions"), $err]); - }; - -$SIG{__DIE__} = sub { my $m = chomp_($_[0]); log::l("ERROR: $m") }; -my $fstab = [ fsedit::get_all_fstab($all_hds) ]; - -fs::get_raw_hds('', $all_hds); - -fs::merge_info_from_fstab([ fsedit::get_really_all_fstab($all_hds) ]); -fs::merge_info_from_mtab([ fsedit::get_really_all_fstab($all_hds) ]); - -if ($ENV{TEST_DEFAULT_OPTIONS}) { - fs::set_all_default_options($all_hds); - fs::set_removable_mntpoints($all_hds); -} -diskdrake_interactive::main($in, $all_hds); - -$in->exit(0); diff --git a/perl-install/standalone/drakautoinst b/perl-install/standalone/drakautoinst deleted file mode 100755 index c0d640135..000000000 --- a/perl-install/standalone/drakautoinst +++ /dev/null @@ -1,410 +0,0 @@ -#!/usr/bin/perl - -# -# Guillaume Cottenceau (gc@mandrakesoft.com) -# -# Copyright 2001 MandrakeSoft -# -# This software may be freely redistributed under the terms of the GNU -# public license. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# - -use lib qw(/usr/lib/libDrakX); - -use common; -use interactive; -use standalone; -use devices; -use detect_devices; -use steps; -use commands; -use fs; -use Data::Dumper; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; - - -local $_ = join '', @ARGV; - -/-h/ and die "usage: drakautoinst [--version]\n"; -/-version/ and die 'version: $Id$ '."\n"; -$::direct = /-direct/; -$::direct = 1; #DEBUG - -my $in = 'interactive'->vnew('su', 'default'); - -begin: -$::isEmbedded and kill USR2, $::CCPID; - -my $imagefile = "/root/replay_install.img"; --f $imagefile or $in->ask_okcancel(_("Error!"), - _("I can't find needed image file `%s'.", $imagefile), 1), quit_global($in, 0); - -$::direct or $in->ask_okcancel(_("Auto Install Configurator"), -_("You are about to configure an Auto Install floppy. This feature is somewhat dangerous and must be used circumspectly. - -With that feature, you will be able to replay the installation you've performed on this computer, being interactively prompted for some steps, in order to change their values. - -For maximum safety, the partitioning and formatting will never be performed automatically, whatever you chose during the install of this computer. - -Do you want to continue?"), 1) or quit_global($in, 0); - - -my @manual_steps = qw(doPartitionDisks formatPartitions); -my @all_steps; -my @choices; - -my $st = \%steps::installSteps; - -for (my $f = $st->{first}; $f; $f = $st->{$f}{next}) { - next if member($f, @manual_steps); - my $def_choice = 'replay'; - push @choices, { label => _($st->{$f}{text}), val => \$def_choice, list => [ _('replay'), _('manual') ] }; - push @all_steps, [ $f, \$def_choice ]; -} - -$in->ask_from(_("Automatic Steps Configuration"), - _("Please choose for each step whether it will replay like your install, or it will be manual"), - \@choices - ) or quit_global($in, 0); - -${$_->[1]} eq _('manual') and push @manual_steps, $_->[0] foreach @all_steps; - -my $mountdir = "/root/tmp/drakautoinst-mountdir"; -d $mountdir or mkdir $mountdir, 0755; -my $floppy = detect_devices::floppy(); -my $dev = devices::make($floppy); -$in->ask_okcancel('', _("Insert a blank floppy in drive %s", $floppy), 1) or quit_global($in, 0); -{ - my $w = $in->wait_message('', _("Creating auto install floppy")); - commands::dd("if=$imagefile", "of=$dev", "bs=1440", "count=1024"); - common::sync(); -} -fs::mount($dev, $mountdir, 'vfat', 0); -my $cfgfile = "$mountdir/auto_inst.cfg"; -eval(cat_($cfgfile)); -my $o_old = $o; - -if (!$::isEmbedded && $in->isa('interactive_gtk')) { - require Gtk; - init Gtk; - require my_gtk; - import my_gtk qw(:helpers :wrappers); - - my %tree; - $struct_gui{$_} = 'General' foreach qw(lang isUpgrade autoExitInstall timezone default_packages mkbootdisk); - $struct_gui{$_} = 'Security' foreach qw(crypto security); - $struct_gui{$_} = 'Harddrive' foreach qw(partitions manualFstab useSupermount partitioning); - $struct_gui{$_} = 'Network' foreach qw(intf netc netcnx); - $struct_gui{$_} = 'Users' foreach qw(superuser users authentication); - $struct_gui{$_} = 'Hardware' foreach qw(keyboard mouse X printer wacom nomouseprobe); - - %pixmap = ( lang => 'language', - isUpgrade => '', - security => 'security', - autoExitInstall => '', - timezone => '', - default_packages => '', - partitions => 'harddrive', - manualFstab => 'partition', - useSupermount => '', - partitioning => 'partition', - intf => 'network', - netc => 'network', - netcnx => 'network', - superuser => 'user', - users => 'user', - authentication => '', - keyboard => 'keyboard', - mouse => 'mouse', - X => 'X', - printer => 'printer', - wacom => '', - ); - - member($_, keys %struct_gui) and push @{$tree{$struct_gui{$_}}}, [$_ , $pixmap{$_}, h2widget($o->{$_}, "\$o->\{$_\}") ] foreach (keys %$o); - - my $W = my_gtk->new(_('$o edition')); - my @box_to_hide; - my $nb_pages=0; - my $notebook = new Gtk::Notebook; - $notebook->set_show_border(0); - $notebook->set_show_tabs(0); - $notebook->append_page(gtkpack_(gtkset_border_width(new Gtk::VBox(0,0), 10), - 1, new Gtk::VBox(0,0), - 0, gtkpack_(new Gtk::HBox(0,0), - 1, new Gtk::VBox(0,0), - 0, gtkadd(gtkset_shadow_type(new Gtk::Frame, 'etched-in'), - new Gtk::Pixmap(gtkcreate_png('mdk_logo'))), - 1, new Gtk::VBox(0,0), - ), - 0, _("\nWelcome.\n\nThe parameters of the auto-install are available in the sections on the left"), - 1, new Gtk::VBox(0,0), - ), undef); - $notebook->show_all; - $notebook->set_page(0); - - gtkadd($W->{window}, - gtkpack_(new Gtk::VBox(0,5), - 1, gtkpack_(new Gtk::HBox(0,0), - 0, gtkadd(gtkset_usize(gtkset_shadow_type(new Gtk::Frame, 'in'), 130, 470), - gtkpack_(new Gtk::VBox(0,0), - map { - my $box = new Gtk::VBox(0,0); - push @box_to_hide, $box; - $box->{vis} = 0; - my @button_to_hide; - 0, gtksignal_connect(new Gtk::Button(_("$_")), clicked => sub { - if($box->{vis}) { $box->hide(); $box->{vis} = 0; $notebook->set_page(0); } - else { - $_->hide, $_->{vis}=0 foreach @box_to_hide; - $box->show; $box->{vis} = 1; - $box->{active_function} and $box->{active_function}->(); - } - }), 1, gtkpack__($box, - map { - my $button = gtkset_relief(new Gtk::ToggleButton(), 'none'); - push @button_to_hide, $button; - my $gru = $_->[0]; - $notebook->append_page(gtkshow($_->[2]), undef); - $nb_pages++; - my $local_page = $nb_pages; - my $function = sub { $notebook->set_page($local_page) }; - gtksignal_connect($button, toggled => sub { - $button->get_active() and $function->() - }); - my $b; - if ($_->[1] ne "") { $b = new Gtk::Pixmap(gtkcreate_png($_->[1]))} else { $b = ()}; - gtksignal_connect(gtkadd($button, - gtkpack__(new Gtk::VBox(0,3), - $b, - _($_->[0]), - ) - ), released => sub { - $button->get_active() or $button->set_active(1),return; - $_->set_active(0) foreach @button_to_hide; - $button->set_active(1); - $box->{active_function} = $function; - $function->(); - }) - } @{$tree{$_}} - ) - } keys(%tree) - ) - ), - 1, $notebook, - ), - 0, new Gtk::HSeparator, - 0, gtkadd(gtkset_border_width(gtkset_layout(new Gtk::HButtonBox, 'end'), 5), - gtksignal_connect(new Gtk::Button(_("Accept")), clicked => sub { Gtk->main_quit; }), - gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub { $o = $o_old; Gtk->main_quit; quit_global($in, 0) }), - ) - ) - ); - $_->hide foreach @box_to_hide; -# $W->{window}->show_all; -# gtkadd($W->{window}, -# gtkpack_($W->create_box_with_title(_("Edit variables")), -# 1, my $notebook = create_notebook( map { $_, h2widget($o->{$_}, "\$o->\{$_\}") } keys %$o ), -# 0, gtkpack(gtkset_border_width(new Gtk::HBox(0,0),5), $W->create_okcancel), -# ), -# ); -# $notebook->set_tab_pos('left'); -# $::isEmbedded and Gtk->main_iteration while Gtk->events_pending; - $::isEmbedded and kill (12, $::CCPID); - $W->main; -# $W->destroy(); -} - -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']), q( -package install_steps_auto_install; -$graphical = 1; -), Data::Dumper->Dump([\@manual_steps], ['$msteps']), -q(push @graphical_steps, @$msteps; -), "\0"); -$str =~ s/ {8}/\t/g; #- replace all 8 space char by only one tabulation, this reduces file size so much :-) -output($cfgfile, $str); - -fs::umount($mountdir); - -$in->ask_okcancel(_("Congratulations!"), -_("The floppy has been successfully generated. -You may now replay your installation.")); - -quit_global($in, 0); - - -sub quit_global { - my ($in, $exitcode) = @_; - $::isEmbedded ? kill USR1, $::CCPID : $in->exit($exitcode); - goto begin; -} - - - -sub h2widget { - my ($k, $label) = @_; - my $w; - if(ref($k) =~ /HASH/) { - my $vb; - my @widget_list; - my $i = -1; - my @list_keys = keys(%{$k}); - if (ref(${$k}{$list_keys[0]}) =~ /HASH/) { - $i++; - my ($button_add, $button_remove); - $w = gtkpack_(new Gtk::VBox(0,0), - 1, createScrolledWindow(gtkpack__($vb = new Gtk::VBox(0,10), - $widget_list[$i] = create_packtable({ col_spacings => 10, row_spacings => 3 }, - map { - my $e; - $e = h2widget(${$k}{$_}, "$label\{$_\}"); - [ "$_ : ", $e ] } @list_keys - ), - ) - ), - control_buttons(${$k}{$list_keys[0]}, - sub { my ($vb, $widget_list2, $ref_local_k, $i) = @_; - my @widget_list = @{$widget_list2}; - my $field = $in->ask_from_entry(_("Auto Install"), ("Enter the name of the new field you want to add")) or return undef; - $field eq '' and return undef; - gtkpack__($vb, - $widget_list[$i] = create_packtable({ col_spacings => 10, row_spacings => 3 }, - [ "$field : ", h2widget($ref_local_k, "$label\{$field\}")]) - ); - @{$widget_list2} = @widget_list; - }, - $vb, \$i, \@widget_list) - ); - } else { - $w = create_packtable({ col_spacings => 10, row_spacings => 3 }, - map { create_entry_element(${$k}{$_}, "$label\{$_\}", $_) } @list_keys - ) - } - } elsif(ref($k) =~ /ARRAY/) { - my $vb; - my @widget_list; - my $i = -1; - $w = gtkpack_(new Gtk::VBox(0,0), - 1, createScrolledWindow( - gtkpack__($vb = new Gtk::VBox(0,5), - map { $i++; $widget_list[$i] = h2widget($_, "$label\[$i\]") } @{$k}, - ) - ), - control_buttons(@{$k}[0], - sub { my ($vb, $widget_list2, $ref_local_k, $i) = @_; - my @widget_list = @{$widget_list2}; - gtkpack__($vb, $widget_list[$i] = h2widget($ref_local_k, "$label\[$i\]")); - @{$widget_list2} = @widget_list; - }, - $vb, \$i, \@widget_list) - ); - } else { - $label =~ /\$o->\{(.+)\}/; - $w = create_packtable({ col_spacings => 10, row_spacings => 3 }, - create_entry_element($k, $label, $1)) - } - return $w; -} - - -sub create_entry_element { - my ($text, $value, $label) = @_; - my $e = new Gtk::Entry; - $e->{value} = $value; - my $tag = Gtk->timeout_add(1000, sub { $e->set_text($text); 0 }); - gtksignal_connect($e, changed => sub { - my $exe = $e->{value} . "='" . $e->get_text() . "'"; - print "EXEC : $exe\n "; - eval "$exe"; - }); - [ "$label : ", $e ] -} - -sub control_buttons { - my ($ref_local_k, $local_gui, $vb, $j, $widget_list2) = @_; - my @widget_list = @{$widget_list2}; - my $i = ${$j}; - my (%local_k) = %{$ref_local_k}; - my ($button_add, $button_remove); - 0, gtkadd(gtkset_border_width(gtkset_layout(new Gtk::HButtonBox, 'spread'), 5), - gtksignal_connect($button_add = new Gtk::Button(_("Add an item")), clicked => sub { - $local_k{$_} = undef foreach keys %local_k; - $i++; - $local_gui->($vb, \@widget_list, \%local_k, $i) or $i--, return; - $i>=0 and $button_remove->set_sensitive(1); - } - ), - gtksignal_connect($button_remove = new Gtk::Button(_("Remove the last item")), clicked => sub { - $i>=0 or return; - $widget_list[$i]->destroy(); - $i--; - $i>=0 or $button_remove->set_sensitive(0); - } - ) - ) -} - -#------------------------------------------------- -#- $Log$ -#- Revision 1.14 2001/11/05 16:07:21 damien -#- typo -#- -#- Revision 1.13 2001/10/30 20:11:31 damien -#- corrected ref($in) =~ /gtk/ -#- -#- Revision 1.12 2001/10/30 17:00:05 damien -#- updated -#- -#- Revision 1.11 2001/10/26 13:45:11 damien -#- progress bar hack -#- -#- Revision 1.10 2001/10/25 11:59:58 damien -#- simple variables handled, code compression. -#- -#- Revision 1.9 2001/10/25 11:17:03 damien -#- The new and shiny drakautoinst is coming. P|-|34R -#- -#- Revision 1.8 2001/10/25 02:18:24 damien -#- The new drakautoinst is coming. P|-|34R -#- -#- Revision 1.7 2001/09/18 17:35:50 gc -#- have "manual" and "replay" translated -#- -#- Revision 1.6 2001/09/14 17:30:23 siegel -#- Check exisence of "/root/replay_install.img" before anything else ... -#- -#- Revision 1.5 2001/08/29 21:58:24 gc -#- quit_global -#- -#- Revision 1.4 2001/08/26 14:34:10 gc -#- require -> use -#- -#- Revision 1.3 2001/08/18 17:52:21 prigaux -#- big renaming of ask_from_entries_refH in ask_from and ask_from_entries_refH_powered in ask_from_ -#- -#- Revision 1.2 2001/08/13 19:08:27 gc -#- ouch! use lib from /usr/lib/libDrakX, rather than from .. -#- -#- Revision 1.1 2001/08/13 19:06:50 gc -#- initial revision for drakautoinst -#- - put %installSteps in a separate package (steps.pm) (for drakxtools) -#- - use additional fields {auto} and {noauto}, by step, to ease interactive auto install and oem stuff -#- - in install2.pm, perform each step either from the interactive class or from install_steps, according to the {auto} flag -#- - id, tell each step to not try to be automatic if {noauto} -#- - in the install, have auto install bootdisk created in install_any so we can always write a bootdisk (from install_steps) for further use from drakautoinst in standalone -#- - interactive version of install_steps_auto_install is now inheriting from the interactive class, so we can click on a previous automatic step and have it interactively during an interactive auto install -#- -#- diff --git a/perl-install/standalone/drakbackup b/perl-install/standalone/drakbackup deleted file mode 100755 index 78d98e932..000000000 --- a/perl-install/standalone/drakbackup +++ /dev/null @@ -1,219 +0,0 @@ -#!/usr/bin/perl -# -# Copyright (C) 2001 by Sebastien DUPONT <sdupont@mandrakesoft.com> -# Redistribution of this file is permitted under the terms of the GNU -# Public License (GPL) -## description: -# -# Drakbacup is use to backup system files and user files -# Drakbacup allow to restore the system (etc, var files) -# from starup or on drakconf utility. -# -#backup name format: all the time from the / -# backup_sys_12102001.tar.gz -> default system backup -# backup_sys_etc_var_proc_12102001.tar.gz -> specific system directories -# backup_user_james_12102001.tar.gz -> default user backup -# backup_user_james_documents_12102001.tar.gz -> specific user directories -# backup_other_proc_12102001.tar.gz -> specific other directories -# -# backup name rules: system: begin by sys -# user: begin by user -# other: begin by other -# end of all `date`.tar.gz -# -# seems to be good idea to have a txt file where user explain the differences -# between all the backup -# -# save only the differences... -# find / -mtime -1 \! -type d -print > /tmp/liste.jour -# -# build iso fs with rescue. -# -# configuration file on /etc/drakconf/drakbackup/drakbakup.conf -# - -use Gtk; -use lib qw(/usr/lib/libDrakX); -use interactive; -use standalone; -use my_gtk qw(:helpers :wrappers); -use common; -use strict; - - -if ("@ARGV" =~ /--help|-h/) { - print q(Backup and monitoring application - ---list : list of files or directories to backup. ---default : save default directories. ---build_cd : build restore iso with the currents backups files - & rescue options. ---build_floppy : build restore floppy. ---update : don t replace the old backup, only update it. ---replace : delete backup files before build new. ---save_dir : by default the backup files are saved in - in /var/backup directory so write other directory - to change to change it. ---conf_file : to read other configuration file. -); - exit(0); -} - -# Backend Options. -my $default = 0; -my $build_cd = 0; -my $build_floppy = 0; -my $comp_mode = 0; -my $mode = 0; -my $replace = 0; -my $update = 0; -my $conf_file = 0; -my @list_arg = (); -my @sys_files ; -my @home_files; -my @other_files; -my $save_path; -my $option_replace = 0; -my $option_update = 0; -my $windows = 0; -my $central_widget; -my $interactive; - - -# PATH & Global variables. -my $cfg_file = "/etc/drakconf/drakbackup/drakbackup.conf"; - - - -foreach (@ARGV) { - /--default/ and $default = 1, $mode=-1; - /--build_cd/ and $build_cd = 1, $mode=-1; - /--build_floppy/ and $build_floppy = 1, $mode=-1; - /--replace|-r/ and $replace = 1, $mode=-1; - /--update|-u/ and $update = 1, $mode=-1; - /--conf_file/ and $mode = 0, next; -# $mode == 0 and push $conf_file, $_; - /--list/ and $mode = 1, next; - $mode == 1 and push @list_arg, $_; -} - -sub debug { - print "SYS_FILES: $_ \n" foreach (@sys_files); - print "HOME_FILES: $_ \n" foreach (@home_files); - print "OTHER_FILES: $_ \n" foreach (@other_files); - print "PATH_TO_SAVE: $save_path \n"; - print "OPTION_REPLACE: $option_replace \n"; - print "OPTION_UPDATE: $option_update \n"; - print "OPTION_COMP: $comp_mode \n"; -} - -sub read_conf_file { - foreach (cat_("$cfg_file")) { - if (/^SYS_FILES/) { - chomp; - s/^SYS_FILES=//gi; - @sys_files = split(' ', $_ ); - } - if (/^HOME_FILES/) { - chomp; - s/^HOME_FILES=//gi; - @home_files = split(' ', $_ ); - } - if (/^OTHER_FILES/) { - chomp; - s/^OTHER_FILES=//gi; - @other_files = split(' ', $_ ); - } - if (/^PATH_TO_SAVE/) { - chomp; - $save_path = $_; - } - if (/^OPTION_REPLACE/){ - $option_replace = 1; - $option_update = 0; - } - if (/^OPTION_UPDATE/){ - $option_replace = 0; - $option_update = 1; - } - if (/^OPTION_COMP/) { - chomp; - s/^OPTION_COMP=//gi; - /TAR.GZ/ and $comp_mode = 0; - /TAR.BZ2/ and $comp_mode = 1; - } - } - debug; -} - -$build_floppy || $build_cd || $default || @list_arg || $conf_file ? backend_mod() : interactive_mode(); - -sub backend_mod { - read_conf_file(); -} - -sub build_cd_fct { - -} - -sub build_floppy_fct { - -} - -sub build_backup_files { - -} - -sub interactive_mode { - my $font_box; - my $font_sel; - $interactive = 1; - - init Gtk; - - my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel; - $window1->signal_connect (delete_event => sub { Gtk->exit(0) }); - $window1->set_position(1); - $window1->set_title(_("Fonts Importation")); - $window1->set_border_width(5); - - gtkadd($window1, - gtkpack_(new Gtk::HBox(0,2), - 1, gtkpack_(new Gtk::VBox(0,2), - 1, new Gtk::VBox(0,0), - 1, gtkpack(gtkset_usize($font_box = new Gtk::VBox(0,5),500, 350), - $font_sel = new Gtk::FontSelection, - ), - 1, new Gtk::VBox(0,0) - ), - 0, gtkpack_(new Gtk::VBox(0,5), - 0, _("DrakFont"), - 0, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end), - gtksignal_connect(new Gtk::Button(_("Windows Importation")), clicked => - sub { ${$central_widget}->destroy(); $windows = 1; license(\&appli_choice)}), - gtksignal_connect(new Gtk::Button(_("Advanced Importation")), clicked => - sub { ${$central_widget}->destroy(); $windows = 0; license(\&advanced_install)}), - gtksignal_connect(new Gtk::Button(_("Uninstall Fonts")), clicked => - sub { ${$central_widget}->destroy(); uninstall() }), - gtksignal_connect(new Gtk::Button(_("Font List")), clicked => - sub { ${$central_widget}->destroy(); create_fontsel()}), - ), - 1, new Gtk::VBox(0,0), - 1, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end), - gtksignal_connect(new Gtk::Button(_(" Help ")), clicked => sub { - ${$central_widget}->destroy(); help() }), - gtksignal_connect(new Gtk::Button(_("Close")), clicked => sub { Gtk->main_quit() }), - ), - ) - ), - ); - $central_widget = \$font_sel; - $window1->show_all; - $window1->realize; - $window1->show_all(); - - Gtk->main; - Gtk->exit(0); -} - - diff --git a/perl-install/standalone/drakboot b/perl-install/standalone/drakboot deleted file mode 100755 index 8a17b4813..000000000 --- a/perl-install/standalone/drakboot +++ /dev/null @@ -1,56 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - - -use common; -use interactive; -use standalone; -use any; -use bootloader; -use detect_devices; -use fsedit; -use fs; -use c; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -local $_ = join '', @ARGV; - -/-h/ and die "usage: drakboot [--expert]\n"; - -$::expert = /-expert/; - -my $in = 'interactive'->vnew('su', 'bootloader'); - -require 'bootlook.pm' if $in->isa('interactive_gtk'); -lilo_choice(); - - -sub lilo_choice -{ - my $bootloader = bootloader::read('', '/etc/lilo.conf'); - local ($_) = `detectloader`; - $bootloader->{methods} = { lilo => 1, grub => !!/grub/i }; - - my ($all_hds) = catch_cdie { fsedit::hds([ detect_devices::hds() ], {}) } sub { 1 }; - my $fstab = [ fsedit::get_all_fstab(@$all_hds) ]; - fs::merge_info_from_fstab($fstab); - - $::expert=1; - - ask: - any::setupBootloader($in, $bootloader, $all_hds, $fstab, $ENV{SECURE_LEVEL}) or $in->exit(0); - eval { bootloader::install('', $bootloader, $fstab, $all_hds->{hds}) }; - - if ($@) { - $in->ask_warn('', - [ _("Installation of LILO failed. The following error occured:"), - grep { !/^Warning:/ } cat_("/tmp/.error") ]); - unlink "/tmp/.error"; - goto ask; - } -} - !$::isEmbedded and $in->exit(0); - kill(USR1, $::CCPID); - goto ask; - diff --git a/perl-install/standalone/drakbug_report b/perl-install/standalone/drakbug_report deleted file mode 100755 index e031a008f..000000000 --- a/perl-install/standalone/drakbug_report +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use MDK::Common; -use any; - -my %other = ( - 'rpm -qa' => join('', sort `rpm -qa`), - 'mandrake version' => cat_('/etc/redhat-release'), -); - -print any::report_bug('', %other); diff --git a/perl-install/standalone/drakfont b/perl-install/standalone/drakfont deleted file mode 100755 index 03de1cc96..000000000 --- a/perl-install/standalone/drakfont +++ /dev/null @@ -1,904 +0,0 @@ -#!/usr/bin/perl -# -# Copyright (C) 2001 by MandrakeSoft (sdupont@mandrakesoft.com) -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -# -# drakfont Future Overview -# - Fonts import : -# pfb ( Adobe Type 1 binary ) -# pfa ( Adobe Type 1 ASCII ) -# ttf ( True-Type ) -# pcf.gz -# Speedo -# and Bitmap (PCF, BDF, and SNF) -# - Features -# - Install fonts from any directory -# - Get windows fonts on any vfat partitions -# - Get fonts on any partitions. -# - UN-installation of any fonts (even if not installed through drakfont) -# - Support -# - Xfs -# - ghostscript & printer -# - Staroffice & printer -# - abiword -# - netscape -# - Koffice, Gnumeric, ... studying -# - all fonts supported by printer -# - anti-aliases by RENDER in Xfree86 .... -# supported by KDE. -# will be supported by gnome 1.2. -# Visual Interface: -# Window interface: -# - Fontselectiondialog widget -# - Command buttons under Fontselectiondialog (like the actual frontend). -# Commands buttons: -# - import from windows partition. -# import from all fat32 partitions and look for winnt/windows/font -# and import all (delete doublon) but don't import if already exist. -# - import from directory -# look for if it exist before for each font and not delete the original. -# (replace all, no, none) -# expert options: -# ask the directory, and look for if it exist before -# if it exist ask: (replace all, no, none) -# - uninstall with list per font type -# Expert additional switch -# - option support: ghostscript, Staroffice, etc... -# check-button. (by default all check) -# - Printer Application Fonts Support... -# check-button. (by default all check) -# -# TODO: -# - abiword, Koffice, Gnumeric, ... -# - Speedo and Bitmap (PCF, BDF, and SNF) -# -# REQUIRE: -# - font-tools.*.mdk.i586.rpm -# -# USING: -# - pfm2afm: by Ken Borgendale: Convert a Windows .pfm file to a .afm (Adobe Font Metrics) -# - type1inst: by James Macnicol: type1inst generates files fonts.dir fonts.scale & Fontmap. -# - ttf2pt1: by Andrew Weeks, Frank Siegert, Thomas Henlich, Sergey Babkin convert ttf font files to afm and pfb fonts -# -# -# directory to install fonts /usr/X11R6/lib/X11/fonts/ -# -->> /usr/X11R6/lib/X11/fonts/drakfont - -use Gtk; -use lib qw(/usr/lib/libDrakX); -use interactive; -use standalone; -use my_gtk qw(:helpers :wrappers); -use common; -use strict; - -if ("@ARGV" =~ /--help|-h/) { - print q(Font Importation and monitoring application ---windows_import : import from all available windows partitions. ---xls_fonts : show all fonts that already exist from xls ---strong : strong verification of font. ---install : accept any font file and any directry. ---uninstall : uninstall any font or any directory of font. ---replace : replace all font if already exist ---application : 0 none application. - : 1 all application available supported. - : name_of_application like so for staroffice - : and gs for ghostscript for only this one. -); - exit(0); -} - -# global variables needed by each functions -my $xlsfonts = 0; -my $windows = 0; -my $strong; -my $replace; -my $application; -my $install; -my $uninstall; -my $so = 1; -my $gs = 1; -my $abi = 1; -my $printer = 1; -my $mode = -1; -my @application; -my @install; -my @uninstall; -my $interactive; -my $text; -my $vscrollbar; -my $check4; -my $check1; -my $check2; -my $check3; -my $pbar; -my $pbar1; -my $pbar2; -my $pbar3; -my $font_box; -my $central_widget; -my $label1; -my $label2; -my $label3; -my $label4; -my $list_path; -my $path_list; -my $current_path; -my $list; -my $list_all_font_path; - -foreach (@ARGV) { - /--list|-l/ and $list_all_font_path = 1, $mode=-1; - /--xls_fonts/ and $xlsfonts = 1, $mode=-1; - /--windows_import|-wi/ and $windows = 1, $mode=-1; - /--strong|-s/ and $strong = 1, $mode=-1; - /--replace|-r/ and $replace = 1, $mode=-1; - /--application/ and $mode = 0, next; - $mode == 0 and push @application, $_; - /--install/ and $mode = 1, next; - $mode == 1 and push @install, $_; - /--uninstall/ and $mode = 2, next; - $mode == 2 and push @uninstall, $_; -} - - - -foreach my $i (@application) { - if ( $i =~ /so/i) { - if ( $gs != 2 ) { $gs = 0;} - $so = 2; - } - if ($i =~ /gs/i){ - if ( $so != 2 ) { $so = 0; } - $gs = 2; - } -} - -# PATH and binary full path -my $xfs_conffile = '/etc/X11/fs/config'; -my $drakfont_dir = '/usr/X11R6/lib/X11/fonts/drakfont'; -my $ttf2pt1 = '/usr/sbin/ttf2pt1'; -my $pfm2afm = '/usr/sbin/pfm2afm'; -my $type1inst = '/usr/sbin/type1inst'; -my $chkfontpath = '/usr/sbin/chkfontpath'; -my $ttmkfdir = '/usr/sbin/ttmkfdir'; -my $ghostscript; - -# Global lists, just to manipulate it easily. -# my @font_list => list of fonts to install. -# my @installed_fonts; => list of installed fonts. -# my @installed_fonts_path; => list of path included in xfs. -# my @fontsdir_to_install; => list of fonts to uninstall. -# my @fontsdir_to_uninstall; => path to remove in xfs font file. -# my @installed_fonts_full_path; => full path list of fonts to uninstall. - -my @font_list; -my @installed_fonts; -my @installed_fonts_path; -my @fontsdir_to_install; -my @fontsdir_to_uninstall; -my @installed_fonts_full_path; - - -sub list_fontpath { - foreach (grep { /\d+:\s/ } `$chkfontpath -l`) { - chomp; - s/\d+:\s//gi; - s/:\w*$//gi; - push @installed_fonts_path, $_; - } -} - - -sub chk_empty_xfs_path { - my @temp3; - foreach my $tmp_path (@installed_fonts_path) { - @temp3 = (); - foreach my $temp2 (all($tmp_path)) { - if (!(($temp2 =~ /^fonts/ ) || ($temp2 =~ /^type/ ))) { - push @temp3, $temp2; - } - } - if(!(@temp3)) { - system("chkfontpath -r $tmp_path ") or - print "PERL::system command failed during chkfontpath\n"; - } - } -} - - - - - -sub search_installed_fonts { - list_fontpath(); - $interactive and progress($pbar, 0.01, _("Search installed fonts")); - push @installed_fonts, all($_) foreach @installed_fonts_path; - $interactive and progress($pbar, 1/4, _("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/ } cat_('/etc/mtab') ) { - my $win_dir = (split('\s', $fstab_line))[1]; - my @list_fonts_win = all("$win_dir/windows/fonts"); - my @list_fonts_winnt = all("$win_dir/winnt/fonts"); - my $nb_dir = @list_fonts_win + @list_fonts_winnt; - foreach $_ ([\@list_fonts_win, "windows"], [\@list_fonts_winnt, "winnt"]) { - foreach my $i (@{$_->[0]}) { - if($interactive) { - if($nb_dir) { progress($pbar, 0.25/$nb_dir, _("parse all fonts")) } else { - display_error(_("no fonts found")); - return 0; - } - } - !$replace && grep(/$i/, @installed_fonts) and next; - grep ( /$i$/, @font_list) or push @font_list, "$win_dir/$_->[1]/fonts/$i"; - } - } - $interactive && $nb_dir and progress($pbar, 1/4, _("done")); - } - if(!@font_list) { - print "[35mdrakfont:: could not find any font in /win*/fonts [0m\n"; - $interactive and display_error(_("could not find any font in /win*/fonts")); - return 0; - } - 1; -} - -sub is_a_font { - local $_ = $_[0]; - /.ttf$/i || /.pfa$/i || /.pfb$/i || /.pcf$/i || /.pcf.gz$/i || /.pfm$/i || /.gsf$/; -} - -# Optimisation de cette etape indispensable - -sub search_dir_font { - foreach my $fn (@install) { - my @font_list_tmp = (); - my @font_list_tmpp = (); - my $dir ; - if (!(-e $fn )) { print "$_ :: no such file or directory \n" } else { - if ( -d $fn ) { - $dir = $fn; - foreach my $i (all($fn)) { - if (is_a_font($i)) { - push @font_list_tmp, "$i"; - foreach my $i (@font_list_tmp) { - !$replace && grep(/$i/, @installed_fonts) and next; - grep /$i/, @font_list or push @font_list, "$fn/$i"; - } - } - } - } else { - if (is_a_font($fn)) { - !$replace && grep(/$fn/, @installed_fonts) and next; - !grep /$fn/, (@installed_fonts) and push @font_list, "$fn"; - } - } - } - $interactive and progress($pbar, 0.50/@install, _("Reselect correct fonts")); - } - $interactive and progress($pbar, 1/3, _("done")); - !@font_list && $interactive and display_error(_("could not find any font.\n")); -} - -sub search_dir_font_uninstall { - my @font_list_tmp = (); - my $fn = $_; - if ( -d $fn ) { - foreach my $i (all($fn)) { - if (is_a_font($i)) { push @font_list_tmp, "$i"; } - } - } - else { if (is_a_font($fn)) { push @font_list_tmp, "$fn"; } - } - foreach my $i (@installed_fonts_full_path) { - foreach my $j (@font_list_tmp) { - if ( $i =~ /$j/) { push @font_list, "$i" ;} - } - } - print "Fonts to uninstal : " . $_ . "\n" foreach (@font_list); -} - -sub search_dir_font_uninstall_gi { - @font_list = @uninstall; - $interactive and progress($pbar, 1, _("Search fonts in installed list")); -} - - -sub print_list { print "Font(s) to Install :\n\n"; print "$_\n" foreach (@font_list) } - -sub dir_created { - -e $drakfont_dir || mkdir_p($drakfont_dir); - -e $drakfont_dir . "/Type1" || mkdir_p($drakfont_dir."/Type1"); - -e $drakfont_dir . "/ttf" || mkdir_p($drakfont_dir."/ttf"); - -e $drakfont_dir . "/tmp" || mkdir_p($drakfont_dir."/tmp"); - -e $drakfont_dir . "/tmp/ttf" || mkdir_p($drakfont_dir."/tmp/ttf"); - -e $drakfont_dir . "/tmp/Type1" || mkdir_p($drakfont_dir."/tmp/Type1"); - -e $drakfont_dir . "/tmp/tmp" || mkdir_p($drakfont_dir."/tmp/tmp"); -} - -sub put_font_dir { - my @tmpl; - my @list_ttf; - -e "/usr/share/ghostscript" or $gs = 0 && print "ghostscript is not installed on your system...\n" ; - if (@font_list) { - dir_created(); - foreach my $i (@font_list) { - cp_af($i, $drakfont_dir . "/tmp/tmp"); - $interactive and progress($pbar1, 1/@font_list, _("Fonts copy")); - } - $interactive and progress($pbar1, 0.01, _("done")); - $interactive and progress($pbar2, 0.10, _("True Type fonts installation")); - - system ("cd $drakfont_dir/tmp/tmp && cp *.ttf ../../ttf"); - $interactive and progress($pbar2, 0.20, _("please wait during ttmkfdir...")); - system ("cd $drakfont_dir/ttf && $ttmkfdir > fonts.dir" ); - $interactive and progress($pbar2, 0.10, _("True Type install done")); - my $restart_xfs = "$chkfontpath -a $drakfont_dir/ttf"; - - if ($so && $gs) { - my @glob_drak = glob ("$drakfont_dir/tmp/tmp/*.ttf"); - foreach my $fontname (@glob_drak) { - system ("cd $drakfont_dir/tmp/tmp && $ttf2pt1 -b $fontname"); - $interactive and progress($pbar2, 0.50/@glob_drak, _("Fonts conversion")); - } - system ("cd $drakfont_dir/tmp/tmp && mv *.gsf *.pfb *.pfm *.afm ../Type1"); - system ("cd $drakfont_dir/tmp/Type1 && $type1inst" ); - $interactive and progress($pbar2, 0.10, _("type1inst building")); - -e "$drakfont_dir/tmp/Type1/Fontmap" and - system ("cd $drakfont_dir/tmp/Type1 && cat Fontmap >> `rpm -ql ghostscript | grep Fontmap.GS` " ); - system ("cd $drakfont_dir/tmp/Type1 && mv *.pfm *.gsf *.afm *.pfb ../../Type1 "); - system ("cd $drakfont_dir/Type1 && $type1inst"); - $interactive and progress($pbar2, 0.05, _("Ghostscript referencing")); - $restart_xfs .= "; $chkfontpath -a $drakfont_dir/Type1"; - } - - if (!$so && $gs) { - foreach my $fontname ( @tmpl = glob ("$/drakfont_dir/tmp/tmp/*.ttf") ) { - system ("cd $/drakfont_dir/tmp/tmp && $ttf2pt1 -b $fontname"); - $interactive and progress($pbar2, 0.50/@tmpl, _("Fonts conversion")); - } - system ("cd $drakfont_dir/tmp/tmp && mv *.gsf *.pfb *.pfm ../Type1"); - system ("cd $drakfont_dir/tmp/Type1 && $type1inst" ); - $interactive and progress($pbar2, 0.1, _("type1inst building")); - system ("cd $drakfont_dir/tmp/Type1 && cat Fontmap >> `rpm -ql ghostscript | grep Fontmap.GS` " ); - system ("cd $drakfont_dir/tmp/Type1 && mv *.pfm *.afm *.gsf *.pfb ../../Type1 "); - system ("cd $drakfont_dir/Type1 && $type1inst"); - $interactive and progress($pbar2, 0.05, _("Ghostscript referencing")); - $restart_xfs .= "; $chkfontpath -a $drakfont_dir/Type1"; - } - - if ($so && !$gs) { - foreach my $fontname ( @tmpl = glob ("$drakfont_dir/tmp/tmp/*.ttf") ) { - system ("cd $drakfont_dir/tmp/tmp && $ttf2pt1 $fontname"); - $interactive and progress($pbar2, 0.25/@tmpl, _("ttf fonts conversion")); - } - foreach my $fontname ( @tmpl = glob ("$drakfont_dir/tmp/tmp/*.pfm") ) { - system ("cd $drakfont_dir/tmp/tmp && $pfm2afm $fontname"); - $interactive and progress($pbar2, 0.25/@tmpl, _("pfm fonts conversion")); - } - system ("cd $drakfont_dir/tmp/tmp && mv *.afm ../Type1"); - system ("cd $drakfont_dir/tmp/Type1 && mv *.afm ../../Type1 "); - system ("cd $drakfont_dir/Type1 && $type1inst"); - $interactive and progress($pbar2, 0.14, _("type1inst building")); - $restart_xfs .= "; $chkfontpath -a $drakfont_dir/Type1"; - } - - $interactive and progress($pbar2, 0.01, _("done")); - $interactive and progress($pbar3, 0.25, _("Suppress temporary Files")); - rm_rf("$drakfont_dir/tmp/"); - print "\n\nretarting xfs......\n"; - $interactive and progress($pbar3, 0.5 , _("Restart XFS")); - system ($restart_xfs); - $interactive and progress($pbar3, 0.30, _("done")); - } -} - -sub remove_gs_fonts { - my @Fontmap_new; - - if (all("$drakfont_dir/remove")) { - system (" cd $drakfont_dir/remove && $type1inst"); - my @Fontmap_out = cat_("$drakfont_dir/remove/Fontmap"); - my $FontmapGS = `rpm -ql ghostscript | grep Fontmap.GS`; - chomp ($FontmapGS); - my @FontmapGS_list = cat_($FontmapGS); - foreach my $font_gs (@FontmapGS_list) { - my @tmp_list = split (' ',$font_gs); - grep ( $_ =~ /$tmp_list[0]/ , @Fontmap_out) or push @Fontmap_new, $font_gs; - } - print $_ foreach @Fontmap_new; - output($FontmapGS, @Fontmap_new ); - } -} - -sub remove_fonts { - my @list_dir; - -e $drakfont_dir . "/remove" || mkdir_p($drakfont_dir . "/remove"); - $interactive and progress($pbar, 1, _("done")); - foreach my $i (@font_list) { - $_ = $i; - if ( /.pfb$/ || /.gsf$/ || /.pfm$/ || /.pfa$/ ) { - system ("mv $_ $drakfont_dir/remove "); - } else { - rm_rf($i); - } - $i =~ s/\/\w*\.\w*//gi; - grep ( $i, (@list_dir)) or push @list_dir, $i; - $interactive and progress($pbar1, 1/@font_list, _("Suppress Fonts Files")); - } - $interactive and progress($pbar1, 0.01, _("done")); - -e "/usr/share/ghostscript" and remove_gs_fonts(); - foreach my $i (@list_dir) { - if (listlength all("$i") < 3) { - system("chkfontpath -r $i") or print "PERL::system command failed during chkfontpath\n"; - } else { - system("cd $i && type1inst") or print "PERL::system command failed during cd or type1inst\n"; - } - $interactive and progress($pbar2, 1/@list_dir, _("Suppress Fonts Files")); - } - $interactive and progress($pbar2, 0.01, _("xfs restart")); - system ("/etc/rc.d/init.d/xfs restart"); - -e "/usr/share/ghostscript" and rm_rf("$drakfont_dir/remove"); - $interactive and progress($pbar2, 0.01, _("done")); -} - -sub license_msg { - print _("Before installing any fonts, be sure that you have the right to use and install them on your system.\n\n-You can install the fonts using the normal way. In rare cases, bogus fonts may hang up your X Server.")."\n"; -} - -$list_all_font_path || $xlsfonts || $windows || @install || @uninstall ? backend_mod() : interactive_mode(); - -sub backend_mod { - if ($xlsfonts) { - system ("xlsfonts"); - } - if ($list_all_font_path) { - system ("$chkfontpath"); - } - if ($windows) { - license_msg(); - print "\nWindows fonts Installation........\n"; - search_installed_fonts(); - if(search_windows_font()) { - print_list(); - put_font_dir(); - } - print "\nThe End...........................\n"; - } - - if (@install) { - license_msg(); - print "\nInstall Specifics Fonts...........\n"; - search_installed_fonts(); - search_dir_font; - print "Font to install : " . $_ . "\n" foreach (@font_list); - put_font_dir(); - print "\nThe End...........................\n"; - } - - if (@uninstall) { - print "\nUninstall Specifics Fonts.........\n"; - search_installed_fonts_full_path(); - if ($interactive) { search_dir_font_uninstall_gi() } - else { search_dir_font_uninstall $_ foreach (@uninstall) } - remove_fonts(); - print "\nThe End............................\n"; - } -} - - - -sub create_fontsel { - my $font_sel; - gtkpack($font_box, - $font_sel = new Gtk::FontSelection, - ); - $central_widget = \$font_sel; -} - -sub display_error { - my ($message) = @_; - my $label; - my $error_box; - ${$central_widget}->destroy(); - gtkpack($font_box, - $error_box = gtkpack_(new Gtk::VBox(0,0), - 1, new Gtk::Label($message), - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread), - gtksignal_connect(new Gtk::Button(_("OK")), clicked => - sub { ${$central_widget}->destroy(); create_fontsel() }), - ), - ) - ); - $central_widget = \$error_box; -} - -sub interactive_mode { - my $font_sel; - $interactive = 1; - - init Gtk; - - my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel; - $window1->signal_connect (delete_event => sub { Gtk->exit(0) }); - $window1->set_position(1); - $window1->set_title(_("Fonts Importation")); - $window1->set_border_width(5); - - gtkadd($window1, - gtkpack_(new Gtk::HBox(0,2), - 1, gtkpack_(new Gtk::VBox(0,2), - 1, new Gtk::VBox(0,0), - 1, gtkpack(gtkset_usize($font_box = new Gtk::VBox(0,5),500, 350), - $font_sel = new Gtk::FontSelection, - ), - 1, new Gtk::VBox(0,0) - ), - 0, gtkpack_(new Gtk::VBox(0,5), - 0, _("DrakFont"), - 0, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end), - gtksignal_connect(new Gtk::Button(_("Windows Importation")), clicked => - sub { ${$central_widget}->destroy(); $windows = 1; license(\&appli_choice)}), - gtksignal_connect(new Gtk::Button(_("Advanced Importation")), clicked => - sub { ${$central_widget}->destroy(); $windows = 0; license(\&advanced_install)}), - gtksignal_connect(new Gtk::Button(_("Uninstall Fonts")), clicked => - sub { ${$central_widget}->destroy(); uninstall() }), - gtksignal_connect(new Gtk::Button(_("Font List")), clicked => - sub { ${$central_widget}->destroy(); create_fontsel()}), - ), - 1, new Gtk::VBox(0,0), - 1, gtkadd(gtkset_layout(new Gtk::VButtonBox, -end), - gtksignal_connect(new Gtk::Button(_(" Help ")), clicked => sub { - ${$central_widget}->destroy(); help() }), - gtksignal_connect(new Gtk::Button(_("Close")), clicked => sub { Gtk->main_quit() }), - ), - ) - ), - ); - $central_widget = \$font_sel; - $window1->show_all; - $window1->realize; - $window1->show_all(); - - Gtk->main; - Gtk->exit(0); -} - - -sub license { - my ($function) = @_, - my $text = new Gtk::Text(undef, undef); - my $license_box; - gtkpack($font_box, - $license_box = gtkpack_(new Gtk::VBox(0,10), - 1, gtkpack_(new Gtk::HBox(0,0), - 1, gtktext_insert(gtkset_editable($text, 1), "Before installing any fonts, be sure that you have the right to use and install them on your system.\n\n-You can install the fonts using the normal way. In rare cases, bogus fonts may hang up your X Server."), - 0, new Gtk::VScrollbar($text->vadj), - ), - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread), - gtksignal_connect(new Gtk::Button(_("OK")), clicked => sub { - ${$central_widget}->destroy(); $function->(); }), - gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub { - ${$central_widget}->destroy(); create_fontsel() }), - ), - ) - ); - $central_widget = \$license_box; - $font_box->show_all(); -} - -sub help { - my $text = new Gtk::Text(undef, undef); - my $help_box; - gtkpack($font_box, - $help_box = gtkpack_(new Gtk::VBox(0,10), - 1, gtkpack_(new Gtk::HBox(0,0), - 1, gtktext_insert(gtkset_editable($text, 1), "drakfont Future Overview - - Fonts import : - pfb ( Adobe Type 1 binary ) - pfa ( Adobe Type 1 ASCII ) - ttf ( True-Type ) - pcf.gz - Speedo - and Bitmap (PCF, BDF, and SNF) - - Features - - Install fonts from any directory - - Get windows fonts on any vfat partitions - - Get fonts on any partitions. - - UN-installation of any fonts (even if not installed through drakfont) - - Support - - Xfs - - ghostscript & printer - - Staroffice & printer - - abiword - - netscape - - Koffice, Gnumeric, ... studying - - all fonts supported by printer - - anti-aliases by RENDER in Xfree86 .... - supported by KDE. - will be supported by gnome 1.2. -Visual Interface: - Window interface: - - Fontselectiondialog widget - - Command buttons under Fontselectiondialog (like the actual frontend). - Commands buttons: - - import from windows partition. - import from all fat32 partitions and look for winnt/windows/font - and import all (delete doublon) but don't import if already exist. - - import from directory - look for if it exist before for each font and not delete the original. - (replace all, no, none) - expert options: - ask the directory, and look for if it exist before - if it exist ask: (replace all, no, none) - - uninstall with list per font type - Expert additional switch - - option support: ghostscript, Staroffice, etc... - check-button. (by default all check) - - Printer Application Fonts Support... - -________________________ ABOUT ____________________________ - - - 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 - - -"), - 0, new Gtk::VScrollbar($text->vadj), - ), - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread), - gtksignal_connect(new Gtk::Button(_("OK")), clicked => - sub { ${$central_widget}->destroy(); create_fontsel() }), - ), - ) - ); - $central_widget = \$help_box; - $font_box->show_all(); -} - - -sub appli_choice { - my $choice_box; - gtkpack($font_box, - $choice_box = gtkpack_(new Gtk::VBox(0,10), - 1, my $table2 = create_packtable({ col_spacings => 2, row_spacings => 15}, - [_("Choose the applications that will support the fonts :"), ], - [ "" , "" ], - [_("Ghostscript"), gtksignal_connect(my $check11 = new Gtk::CheckButton(), clicked => sub { print "appli = " ; })], - [_("StarOffice"), my $check22 = new Gtk::CheckButton()], - [_("Abiword"), my $check33 = new Gtk::CheckButton()], - [_("Generic Printers"), my $check44 = new Gtk::CheckButton()], - ), - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread), - gtksignal_connect(new Gtk::Button(_("OK")), clicked => sub { - ${$central_widget}->destroy(); import_status() }), - gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub { - ${$central_widget}->destroy(); create_fontsel() }), - ), - ) - ); - foreach ([$check11, \$gs], [$check22, \$so], [$check33, \$abi], [$check44, \$printer]) { - my $ref = $_->[1]; - gtksignal_connect(gtkset_active($_->[0], ${$ref}), toggled => sub { ${$ref} = ${$ref} ? 0 : 1; }) - } - $central_widget = \$choice_box; - $font_box->show_all(); -} - -sub font_choice { - my $file_dialog; - - $file_dialog = gtksignal_connect(new Gtk::FileSelection(_("File Selection")), destroy => sub { $file_dialog->destroy(); } ); - $file_dialog->ok_button->signal_connect(clicked => \&file_ok_sel, $file_dialog); - $file_dialog->ok_button->child->set(_("Add")); - $file_dialog->cancel_button->signal_connect(clicked => sub { $file_dialog->destroy() }); - $file_dialog->cancel_button->child->set(_("Close")); - $file_dialog->set_filename(_("Select the font file or directory and click on 'Add'")); - $file_dialog->show(); -} - -sub file_ok_sel { - my ( $widget, $file_selection ) = @_; - my $file_name = $file_selection->get_filename(); - print "-- @install\n"; - if(!member($file_name, @install)) { - push(@install, $file_name); - $list->add(gtkshow(new Gtk::ListItem($file_name))); - } -} - -sub list_remove { - my($widget, $list) = @_; - my @to_remove; - push @to_remove, $list->child_position($_) foreach($list->selection); - splice @install, $_, 1 foreach(reverse sort @to_remove); - $list->remove_items($list->selection); -} - -sub advanced_install { - my $scrolled_window; - my $adv_box; - $list = new Gtk::List(); - $list->set_selection_mode(-extended); - - gtkpack($font_box, - $adv_box = gtkpack_(new Gtk::VBox(0,10), - 1, gtkpack_(new Gtk::HBox(0,4), - 1, createScrolledWindow($list), - ), - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread), - gtksignal_connect(new Gtk::Button(_("Add")), clicked => sub { font_choice() }), - gtksignal_connect(new Gtk::Button(_("Remove Selected")), clicked => \&list_remove, $list), - gtksignal_connect(new Gtk::Button(_("Install List")), clicked => sub { - ${$central_widget}->destroy(); appli_choice() }), -#import_status() }),$ - ), - ) - ); - $central_widget = \$adv_box; - $adv_box->show_all(); -} - -sub list_to_remove { - my @number_to_remove; - my @files_path = grep( !/fonts/ ,all($current_path)); - Gtk->main_iteration while Gtk->events_pending; - push @number_to_remove, $path_list->child_position($_) foreach($path_list->selection); - @uninstall = (); - push @uninstall, $current_path . "/" . $files_path[$_] foreach (@number_to_remove); - ${$central_widget}->destroy(); - show_list_to_remove(); -} - -sub show_list_to_remove { - my $show_box; - my $show_list = new Gtk::List(); - $show_list->add(gtkshow(new Gtk::ListItem($_))) foreach @uninstall ; - gtkpack($font_box, - $show_box = gtkpack_(new Gtk::VBox(0,10), - 1, gtkpack_(new Gtk::HBox(0,4), - 1, createScrolledWindow($show_list) - ), - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread), - gtksignal_connect(new Gtk::Button(_("click here if you are sure.")), clicked => - sub { ${$central_widget}->destroy(); import_status_uninstall() }), - gtksignal_connect(new Gtk::Button(_("here if no.")), clicked => - sub { ${$central_widget}->destroy(); create_fontsel() } ), - ), - ) - ); - $central_widget = \$show_box; - $show_box->show_all(); -} - -sub uninstall { - my $scrolled_window; - my $scrolled_window2; - my $uninst_box; - @install= (); - @installed_fonts_path = (); - list_fontpath(); - chk_empty_xfs_path(); - $list_path = new Gtk::List(); - $list_path->set_selection_mode(-extended); - foreach (@installed_fonts_path) { - my $t = $_; - $list_path->add(gtkshow(gtksignal_connect(new Gtk::ListItem($t), select => sub { - $current_path = $t; - $path_list->clear_items(0, -1); - $path_list->append_items(map { /fonts/ ? () : gtkshow(new Gtk::ListItem($_)) } all($t)); }))); - } - $list_path->set_selection_mode(-single); - $path_list = new Gtk::List(); - $path_list->set_selection_mode(-extended); - - gtkpack($font_box, - $uninst_box = gtkpack_(new Gtk::VBox(0,10), - 1, gtkpack_(new Gtk::HBox(0,4), - 1, createScrolledWindow($list_path), - 1, createScrolledWindow($path_list) - ), - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -spread), - gtksignal_connect(new Gtk::Button(_("Unselected All")), clicked => - sub {$path_list->unselect_all (); }), - gtksignal_connect(new Gtk::Button(_("Selected All")), clicked => - sub {$path_list->select_all (); } ), - gtksignal_connect(new Gtk::Button(_("Remove List")), clicked => - sub { list_to_remove() }), - ), - ) - ); - $central_widget = \$uninst_box; - $uninst_box->show_all(); -} - -sub import_status { - my $table; - $pbar = new Gtk::ProgressBar; - $pbar1 = new Gtk::ProgressBar; - $pbar2 = new Gtk::ProgressBar; - $pbar3 = new Gtk::ProgressBar; - gtkpack($font_box, - $table = create_packtable({ col_spacings => 10, row_spacings => 50}, - ["",""], - [_("Initials tests"), $pbar, $pbar->{label} = new Gtk::Label(' ' )], - [_("Copy fonts on your system"), $pbar1,$pbar1->{label} = new Gtk::Label(' ' ) ], - [_("Install & convert Fonts"), $pbar2, $pbar2->{label} = new Gtk::Label(' ' ) ], - [_("Post Install"), $pbar3,$pbar3->{label} = new Gtk::Label(' ' ) ], - ), - ); - $central_widget = \$table; - $font_box->show_all(); - Gtk->main_iteration while Gtk->events_pending; - backend_mod(); -} - -sub import_status_uninstall { - my $table; - $pbar = new Gtk::ProgressBar; - $pbar1 = new Gtk::ProgressBar; - $pbar2 = new Gtk::ProgressBar; - gtkpack($font_box, - $table = create_packtable({ col_spacings => 10, row_spacings => 50}, - ["",""], ["",""], - [_("Initials tests"), $pbar, $pbar->{label} = new Gtk::Label(' ' )], - [_("Remove fonts on your system"), $pbar1,$pbar1->{label} = new Gtk::Label(' ' ) ], - [_("Post Uninstall"), $pbar2,$pbar2->{label} = new Gtk::Label(' ' ) ], - ), - ); - $central_widget = \$table; - $font_box->show_all(); - Gtk->main_iteration while Gtk->events_pending; - backend_mod(); -} - -sub progress { - my ($progressbar, $incr, $label_text) = @_; - my($new_val) = $progressbar->get_current_percentage; - $new_val += $incr; - if ($new_val > 1) {$new_val = 1} - $progressbar->update($new_val); - $progressbar->{label}->set($label_text); - Gtk->main_iteration while Gtk->events_pending; -} - - -# option strong: verifier strong ttmkfdir -c ??? -# gestion abiword, netscape, gimp.... -# remove this directory of the de fontpath if there is only 2 files in directory (fonts.dir & fonts.scale) -# do type1inst in this path -# peu etre un petit pb avec "/etc/rc.d/init.d/xfs restart" -# ?? :$check11->signal_connect( 'toggled', sub { $gs == 0 and $gs = 1 or $gs = 0; print "gs = $gs\n" }); diff --git a/perl-install/standalone/drakgw b/perl-install/standalone/drakgw deleted file mode 100755 index 6ec6599b7..000000000 --- a/perl-install/standalone/drakgw +++ /dev/null @@ -1,800 +0,0 @@ -#!/usr/bin/perl - -# -# Guillaume Cottenceau (gc@mandrakesoft.com) -# -# Copyright 2000 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 interactive; -use standalone; -use log; -use c; -use network::netconnect; -use detect_devices; -use common; - -$::isInstall and die "Not supported during install.\n"; - - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; - -local $_ = join '', @ARGV; - -/-h/ and die "usage: drakgw [--version]\n"; -/-version/ and die 'version: $Id$ '."\n"; -$::Wizard_pix_up = "wiz_drakgw.png"; -$::Wizard_title = _("Internet Connection Sharing"); -$::direct = /-direct/; - - -my $sysconf_network = "/etc/sysconfig/network"; -my $sysconf_dhcpd = "/etc/sysconfig/dhcpd"; -my $rc_firewall_generic = "/etc/rc.d/rc.firewall"; -my $rc_firewall_drakgw = "/etc/rc.d/rc.firewall.inet_sharing"; -my $rc_firewall_22 = "/etc/rc.d/rc.firewall.inet_sharing-2.2"; -my $rc_firewall_24 = "/etc/rc.d/rc.firewall.inet_sharing-2.4"; -my $dhcpd_conf = "/etc/dhcpd.conf"; -my $cups_conf = "/etc/cups/cupsd.conf"; -my $drakgw_setup = "/etc/sysconfig/inet_sharing"; - - -my ($kernel_version) = c::kernel_version() =~ /(...)/; -log::l("[drakgw] kernel_version $kernel_version"); - -$kernel_version eq '2.2' || $kernel_version eq '2.4' or die "Only for 2.2 or 2.4 kernels.\n"; - -my $in = 'interactive'->vnew('su', 'default'); - -!$::isEmbedded && $in->isa('interactive_gtk') and $::isWizard=1; - -pur_gtk_mode() if $::isEmbedded && $in->isa('interactive_gtk'); - -sub sys { system(@_) == 0 or log::l("[drakgw] Warning, sys failed for $_[0]") } - -sub outpend { 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::l("[drakgw] Starting daemons"); - if (-f "/etc/rc.d/init.d/cups") { - if (grep(/is running/, `/etc/rc.d/init.d/cups status`)) { - $cups_used = 1; - sys("/etc/rc.d/init.d/cups stop"); - } - } - grep(/is running/, `/etc/rc.d/init.d/dhcpd status 2> /dev/null`) and sys("/etc/rc.d/init.d/dhcpd stop"); - grep(/connection refused/, `/etc/rc.d/init.d/named status 2> /dev/null`) or sys("/etc/rc.d/init.d/named stop"); - sys("/etc/rc.d/init.d/network restart"); - sys("sh $rc_firewall_generic"); - - sys("/etc/rc.d/init.d/$_ start"), sys("/sbin/chkconfig --level 345 $_ on") foreach 'named', 'dhcpd'; - sys("/etc/rc.d/init.d/cups start") if $cups_used; - - substInFile { s/^INET_SHARING.*\n//; $_ .= "INET_SHARING=enabled\n" if eof } $drakgw_setup; -} - -sub stop_daemons () -{ - log::l("[drakgw] Stopping daemons"); - grep /is running/, `/etc/rc.d/init.d/dhcpd status` and sys("/etc/rc.d/init.d/dhcpd stop"); - grep /Connection refused/, `/etc/rc.d/init.d/named status 2>&1` or sys("/etc/rc.d/init.d/named stop"); - if ($kernel_version eq "2.2") { - sys("/sbin/ipchains -F"); - } else { - sys("/sbin/iptables -t nat -F"); - } - sys("/sbin/chkconfig --level 345 $_ off") foreach 'named', 'dhcpd'; - - substInFile { s/^INET_SHARING.*\n//; $_ .= "INET_SHARING=disabled\n" if eof } $drakgw_setup; -} - -sub fatal_quit ($) -{ - log::l("[drakgw] FATAL: $_[0]"); - undef $wait_configuring; - $in->ask_warn('', $_[0]); - quit_global($in, -1); -} - -begin: - -#- ********************************** -#- * 0th step: verify if we are already set up - -if (-f $drakgw_setup) { - $::Wizard_no_previous = 1; - - if (grep(/enabled/, cat_($drakgw_setup))) { - my $r = $in->ask_from_list_(_("Internet Connection Sharing currently enabled"), -_("The setup of Internet connection sharing has already been done. -It's currently enabled. - -What would you like to do?"), - [ __("disable"), __("reconfigure"), __("dismiss") ]) or quit_global($in, 0); - if ($r eq "disable") { - { - my $wait_disabl = $in->wait_message('', _("Disabling servers...")); - stop_daemons(); - } - foreach ($dhcpd_conf, $rc_firewall_22, $rc_firewall_24) { - renamef($_, "$_.drakgwdisable") or die "Could not rename $_ to $_.drakgwdisable" - } - log::l("[drakgw] Disabled"); - $::Wizard_finished = 1; - $in->ask_okcancel('', _("Internet connection sharing is now disabled.")); - quit_global($in, 0); - } - if ($r eq "dismiss") { - quit_global($in, 0); - } - } - elsif (grep(/disabled/, cat_($drakgw_setup))) - { - my $r = $in->ask_from_list_(_("Internet Connection Sharing currently disabled"), -_("The setup of Internet connection sharing has already been done. -It's currently disabled. - -What would you like to do?"), - [ __("enable"), __("reconfigure"), __("dismiss") ]); - if ($r eq "enable") { - foreach ($dhcpd_conf, $rc_firewall_22, $rc_firewall_24) { - rename($_, "$_.old") if -f $_; - rename("$_.drakgwdisable", $_) or die "Could not find configuration. Please reconfigure."; - } - { - my $wait_enabl = $in->wait_message('', _("Enabling servers...")); - start_daemons(); - } - log::l("[drakgw] Enabled"); - $::Wizard_finished = 1; - $in->ask_okcancel('', _("Internet connection sharing is now enabled.")); - quit_global($in, 0); - } - if ($r eq "dismiss") { - quit_global($in, 0); - } - } - else { - log::l("[drakgw] Warning, unrecognized config file, ignoring"); - renamef($drakgw_setup, "$drakgw_setup.unrecognized"); - } -} - - -#- ********************************** -#- * 1st step: detect/setup -step_ask_confirm: - -$::Wizard_no_previous = 1; - -$::direct or $in->ask_okcancel(_("Internet Connection Sharing"), -_("You are about to configure your computer to share its Internet connection. -With that feature, other computers on your local network will be able to use this computer's Internet connection. - -Note: you need a dedicated Network Adapter to set up a Local Area Network (LAN)."), 1) or quit_global($in, 0); - -undef $::Wizard_no_previous; - - -step_detectsetup: - -my @configured_devices = map { /ifcfg-(\S+)/ } `ls /etc/sysconfig/network-scripts/ifcfg*`; - -my %aliased_devices; -/^\s*alias\s+(eth[0-9])\s+(\S+)/ and $aliased_devices{$1} = $2 foreach cat_("/etc/modules.conf"); - -my $card_netconnect = network::netconnect::get_net_device(); -defined $card_netconnect and log::l("[drakgw] Information from netconnect: ignore card $card_netconnect"); - -my @cards = grep { - log::l("[drakgw] Have network card: $_"); - $_ ne $card_netconnect -} detect_devices::getNet(); -log::l("[drakgw] Available network cards: ", join(", ", @cards)); - -my $format = sub { - $aliased_devices{$_[0]} ? - _("Interface %s (using module %s)", $_[0], $aliased_devices{$_[0]}) : - _("Interface %s", $_[0]); -}; - -#- setup the network interface we shall use - -my $device; -if (!@cards) -{ - $in->ask_warn(_("No network adapter on your system!"), - _("No ethernet network adapter has been detected on your system. Please run the hardware configuration tool.")); - quit_global($in, 0); -} -elsif (@cards == 1) -{ - $device = $cards[0]; - $in->ask_okcancel(_("Network interface"), -_("There is only one configured network adapter on your system: - -%s - -I am about to setup your Local Area Network with that adapter.", $format->($device)), 1) or goto step_ask_confirm; -} -else -{ - $device = $in->ask_from_listf(_("Choose the network interface"), - _("Please choose what network adapter will be connected to your Local Area Network."), - $format, - \@cards, - ) or goto step_ask_confirm; - defined $device or quit_global($in, 0); -} -log::l("[drakgw] Choosing network card: $device\n"); - -grep(/$device/, @configured_devices) and - ($in->ask_okcancel('', _("Warning, the network adapter is already configured. I will reconfigure it.")) or goto step_detectsetup); - - -my $lan_address = "192.168.0"; - - -#- test for potential conflict with other networks - -foreach (grep { $_ ne $device } @configured_devices) -{ - grep(/$lan_address/, cat_("/etc/sysconfig/network-scripts/ifcfg-$_")) and - ($in->ask_warn('', _("Potential LAN address conflict found in current config of %s!\n", $_)) or goto step_detectsetup); -} - - -#- test for potential conflict with previous firewall config - -if ($kernel_version eq '2.2') { - if (-f '/etc/sysconfig/ipchains' || -x '/sbin/ipchains' && listlength(`/sbin/ipchains -nL`) > 3) { - $in->ask_okcancel(_("Firewalling configuration detected!"), - _("Warning! An existing firewalling configuration has been detected. You may need some manual fix after installation.")) or goto step_detectsetup; - } -} else { - system('modprobe iptable_nat'); - if (-f '/etc/sysconfig/iptables' || -x '/sbin/iptables' && listlength(`/sbin/iptables -t nat -nL`) > 8) { - $in->ask_okcancel(_("Firewalling configuration detected!"), - _("Warning! An existing firewalling configuration has been detected. You may need some manual fix after installation.")) or goto step_detectsetup; - } -} - - -#- ********************************** -#- * 2nd step: configure - -$wait_configuring = $in->wait_message(_("Configuring..."), - _("Configuring scripts, installing software, starting servers...")); - - -#- setup the /etc/sysconfig/network-script/ script - -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=$lan_address.1 -NETMASK=255.255.255.0 -NETWORK=$lan_address.0 -BROADCAST=$lan_address.255 -ONBOOT=yes -)); - - -#- install and setup the RPM packages - -my $rpms_to_install; -my %rpm2file = ( ipchains => '/sbin/ipchains', - iptables => '/sbin/iptables', - 'dhcp-server' => '/usr/sbin/dhcpd', - bind => '/usr/sbin/named', - 'caching-nameserver' => '/var/named/named.local'); - -#- first: try to install all in one step -my @needed_to_install = grep { !-e $rpm2file{$_} } keys %rpm2file; -@needed_to_install and $in->do_pkgs->install(@needed_to_install); -#- second: try one by one if failure detected -if (grep { !-e $rpm2file{$_} } keys %rpm2file) { - foreach (keys %rpm2file) { - -e $rpm2file{$_} or $in->do_pkgs->install($_); - -e $rpm2file{$_} or fatal_quit(_("Problems installing package %s", $_)); - } -} - - -#- setup the masquerading configuration - -if (!-f $rc_firewall_generic) { - output($rc_firewall_generic, "#!/bin/sh -# -# Automatically generated by drakgw -[ -x $rc_firewall_drakgw ] && $rc_firewall_drakgw -"); - chmod 0700, $rc_firewall_generic; -} -elsif (!grep(/drakgw/, cat_($rc_firewall_generic))) { - outpend($rc_firewall_generic, " -# Automatically added by drakgw -[ -x $rc_firewall_drakgw ] && $rc_firewall_drakgw - -"); -} - -output($rc_firewall_drakgw, q(#!/bin/sh -KERNELMAJ=`uname -r | sed -e 's,\..*,,'` -KERNELMIN=`uname -r | sed -e 's,[^\.]*\.,,' -e 's,\..*,,'` - -if [ "$KERNELMAJ" -eq 2 -a "$KERNELMIN" -eq 2 ]; then - [ -x ) . $rc_firewall_22 . ' ] && ' . $rc_firewall_22 . q( -fi -if [ "$KERNELMAJ" -eq 2 -a "$KERNELMIN" -eq 4 ]; then - [ -x ) . $rc_firewall_24 . ' ] && ' . $rc_firewall_24 . q( -fi - )); - -chmod 0700, $rc_firewall_drakgw; - - -output($rc_firewall_22, -qq(#!/bin/sh -# -# rc.firewall - Initial SIMPLE IP Masquerade test for 2.1.x and 2.2.x kernels using IPCHAINS -# -# Load all required IP MASQ modules -# -# NOTE: Only load the IP MASQ modules you need. All current IP MASQ modules -# are shown below but are commented out from loading. - -# Needed to initially load modules -# -/sbin/depmod -a - -# Supports the proper masquerading of FTP file transfers using the PORT method -# -/sbin/modprobe ip_masq_ftp - -# Supports the masquerading of RealAudio over UDP. Without this module, -# RealAudio WILL function but in TCP mode. This can cause a reduction -# in sound quality -# -/sbin/modprobe ip_masq_raudio - -# Supports the masquerading of IRC DCC file transfers -# -/sbin/modprobe ip_masq_irc - - -# Supports the masquerading of Quake and QuakeWorld by default. This modules is -# for for multiple users behind the Linux MASQ server. If you are going to play -# Quake I, II, and III, use the second example. -# -# NOTE: If you get ERRORs loading the QUAKE module, you are running an old -# ----- kernel that has bugs in it. Please upgrade to the newest kernel. -# -#Quake I / QuakeWorld (ports 26000 and 27000) -#/sbin/modprobe ip_masq_quake -# -#Quake I/II/III / QuakeWorld (ports 26000, 27000, 27910, 27960) -/sbin/modprobe ip_masq_quake 26000,27000,27910,27960 - - -# Supports the masquerading of the CuSeeme video conferencing software -# -/sbin/modprobe ip_masq_cuseeme - -#Supports the masquerading of the VDO-live video conferencing software -# -/sbin/modprobe ip_masq_vdolive - - -#CRITICAL: Enable IP forwarding since it is disabled by default since -# -# Redhat Users: you may try changing the options in /etc/sysconfig/network from: -# -# FORWARD_IPV4=false -# to -# FORWARD_IPV4=true -# -echo 1 > /proc/sys/net/ipv4/ip_forward - - -# Dynamic IP users: -# -# If you get your IP address dynamically from SLIP, PPP, or DHCP, enable this following -# option. This enables dynamic-ip address hacking in IP MASQ, making the life -# with Diald and similar programs much easier. -# -#echo 1 > /proc/sys/net/ipv4/ip_dynaddr - - -# MASQ timeouts -# -# 2 hrs timeout for TCP session timeouts -# 10 sec timeout for traffic after the TCP/IP "FIN" packet is received -# 160 sec timeout for UDP traffic (Important for MASQ'ed ICQ users) -# -/sbin/ipchains -M -S 7200 10 160 - - -# DHCP: For people who receive their external IP address from either DHCP or BOOTP -# such as ADSL or Cablemodem users, it is necessary to use the following -# before the deny command. The "bootp_client_net_if_name" should be replaced -# the name of the link that the DHCP/BOOTP server will put an address on to? -# This will be something like "eth0", "eth1", etc. -# -# This example is currently commented out. -# -# -#/sbin/ipchains -A input -j ACCEPT -i bootp_clients_net_if_name -s 0/0 67 -d 0/0 68 -p udp - -# Enable simple IP forwarding and Masquerading -# -# NOTE: The following is an example for an internal LAN address in the 192.168.0.x -# network with a 255.255.255.0 or a "24" bit subnet mask. -# -# Please change this network number and subnet mask to match your internal LAN setup -# -/sbin/ipchains -P forward DENY -/sbin/ipchains -A forward -s $lan_address.0/24 -j MASQ - -# Let incoming packets arrive to our interface, in case there are some firewall rules to come -/sbin/ipchains -A input -i $device -j ACCEPT -)); -chmod 0700, $rc_firewall_22; - - -output($rc_firewall_24, qq(#!/bin/sh -# Load the NAT module (this pulls in all the others). -modprobe iptable_nat - -# Turn on IP forwarding -echo 1 > /proc/sys/net/ipv4/ip_forward - -# In the NAT table (-t nat), Append a rule (-A) after routing (POSTROUTING) -# which says to MASQUERADE the connection (-j MASQUERADE). -/sbin/iptables -t nat -A POSTROUTING -s $lan_address.0/24 -j MASQUERADE - -# Allows forwarding specifically to our LAN -/sbin/iptables -A FORWARD -s $lan_address.0/24 -j ACCEPT - -# Allow dhcp requests -/sbin/iptables -A INPUT -i $device -p udp --sport bootpc --dport bootps -j ACCEPT -/sbin/iptables -A INPUT -i $device -p tcp --sport bootpc --dport bootps -j ACCEPT -/sbin/iptables -A INPUT -i $device -p udp --sport bootps --dport bootpc -j ACCEPT -/sbin/iptables -A INPUT -i $device -p tcp --sport bootps --dport bootpc -j ACCEPT - -# Allow dns requests -/sbin/iptables -A INPUT -i $device -p udp --dport domain -j ACCEPT -/sbin/iptables -A INPUT -i $device -p tcp --dport domain -j ACCEPT -)); -chmod 0700, $rc_firewall_24; - - -#- 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 - -renamef($dhcpd_conf, "$dhcpd_conf.old"); -output($dhcpd_conf, qq(subnet $lan_address.0 netmask 255.255.255.0 { - # default gateway - option routers $lan_address.1; - option subnet-mask 255.255.255.0; - - option domain-name "homelan.org"; - option domain-name-servers $lan_address.1; - - range dynamic-bootp $lan_address.16 $lan_address.253; - default-lease-time 21600; - max-lease-time 43200; -} -)); -my $update_dhcp = '/usr/sbin/update_dhcp.pl'; --e $update_dhcp and system($update_dhcp); - - -#- put the interface for the dhcp server in the sysconfig-dhcp config, for the /etc/init.d script of dhcpd - -substInFile { s/^INTERFACES\n//; $_ .= "INTERFACES=\"$device\"\n" if eof } $sysconf_dhcpd; - - -#- Set up /etc/cups/cupsd.conf to make the broadcasting of the printer info -#- working correctly: -#- -#- 1. ServerName <server's IP address> # because clients do necessarily -#- # know the server's name -#- -#- 2. BrowseAddress <server's Broadcast IP> # broadcast printer info into -#- # the local network. -#- -#- 3. BrowseOrder Deny,Allow -#- BrowseDeny All -#- BrowseAllow <IP mask for local net> # Only accept broadcast signals -#- # coming from local network -#- -#- 4. <Location /> -#- Order Deny,Allow -#- Deny From All -#- Allow From <IP mask for local net> # Allow only machines of local -#- </Location> # network to access the server -#- -#- These steps are only done when the CUPS package is installed. - -substInFile { - s/^ServerName[^:].*\n//; $_ .= "ServerName $lan_address.1\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; - - -#- Modify the root location block in /etc/cups/cupsd.conf - -if (-f $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 - -substInFile { s/^INTERFACE.*\n//; $_ .= "INTERFACE=$device\n" if eof } $drakgw_setup; -start_daemons(); - - -#- bye-bye message - -undef $wait_configuring; - -$::Wizard_no_previous = 1; -$::Wizard_finished = 1; - -$in->ask_okcancel(_("Congratulations!"), -_("Everything has been configured. -You may now share Internet connection with other computers on your Local Area Network, using automatic network configuration (DHCP).")); - - -log::l("[drakgw] Installation complete, exiting\n"); -quit_global($in, 0); - -sub quit_global { - my ($in, $exitcode) = @_; - $in->exit($exitcode); - goto begin -} - -sub pur_gtk_mode -{ - require Gtk; - init Gtk; - my $setup_state = grep(/disabled/, cat_($drakgw_setup)) ? _("The setup has already been done, but it's currently disabled.") : - grep(/enabled/, cat_($drakgw_setup)) ? _("The setup has already been done, and it's currently enabled.") : - _("No Internet Connection Sharing has ever been configured."); - - my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel; - $window1->signal_connect ( delete_event => sub { Gtk->exit(0); }); - $window1->set_position(1); - $window1->set_title(_("Internet connection sharing configuration")); - $window1->border_width(10); - my $vbox1 = new Gtk::VBox(0,0); - $window1->add($vbox1); - my $hbox1 = new Gtk::HBox(0,0); - $vbox1->pack_start($hbox1,1,1,0); - my $label1 = new Gtk::Label( -_("Welcome to the Internet Connection Sharing utility! - -%s - -Click on Configure to launch the setup wizard.", $setup_state)); - $hbox1->pack_start($label1,1,1,0); - my $hbox2 = new Gtk::HBox(0,0); - $vbox1->pack_start($hbox2,1,1,0); - - my $bbox1 = new Gtk::HButtonBox; - $vbox1->pack_start($bbox1,0,0,0); - $bbox1->set_layout(-end); - my $button_conf = new Gtk::Button _("Configure"); - $button_conf->signal_connect ( clicked => sub { - system("/usr/sbin/drakgw --wizard"); - }); - $bbox1->add($button_conf); - my $button_cancel = new Gtk::Button _("Cancel"); - $button_cancel->signal_connect ( clicked => sub { - kill(USR1, $::CCPID); - }); - $bbox1->add($button_cancel); - $window1->show_all(); - Gtk->main_iteration while Gtk->events_pending; - $::isEmbedded and kill USR2, $::CCPID; - Gtk->main; - Gtk->exit(0); - -} - - - - - - -#------------------------------------------------- -#- $Log$ -#- Revision 1.56 2001/10/30 19:10:41 gc -#- use isa rather than ref to test if we're gtk -#- -#- Revision 1.55 2001/10/02 10:28:14 gc -#- don't call pkgs_install when no package needs to be installed -#- -#- Revision 1.54 2001/09/18 20:36:20 damien -#- debug -#- -#- Revision 1.53 2001/09/12 10:57:01 damien -#- corrected wizard mode in newt mode -#- -#- Revision 1.52 2001/09/06 15:38:09 gc -#- works now ;p -#- -#- Revision 1.51 2001/08/29 21:52:34 gc -#- quit_global -#- -#- Revision 1.50 2001/08/18 00:06:32 siegel -#- fixed i18n -#- -#- Revision 1.49 2001/08/09 09:35:37 gc -#- use vnew the right way everywhere -#- -#- Revision 1.48 2001/08/09 09:15:38 gc -#- - if package installs fail, redo one by one to know which one failed -#- - try to not end up with a failing configuration file, if program is brutally stopped -#- - if unrecognized config file, don't fail, rather ignore it and proceed -#- - run dhcpd_update feature (if present) after setup of dhcp server -#- -#- Revision 1.47 2001/08/08 18:26:31 prigaux -#- add interactive_pkgs stuff -#- -#- Revision 1.46 2001/08/06 13:11:35 yduret -#- use MDK::Common; -#- use network::netconnect; and update functions call from netconnect -#- -#- Revision 1.45 2001/07/24 22:39:28 prigaux -#- move to MDK::Common, bool->to_bool -#- -#- Revision 1.44 2001/05/16 11:13:21 damien -#- added icon management -#- -#- Revision 1.43 2001/05/15 14:36:31 gc -#- full path for iptables -#- -#- Revision 1.42 2001/04/12 13:50:24 gc -#- add some rule so later on tinyfirewall will not prevent everything from working -#- -#- Revision 1.41 2001/04/11 15:28:36 gc -#- kosmetik -#- -#- Revision 1.40 2001/04/11 15:16:34 gc -#- do i18n for title also -#- -#- Revision 1.39 2001/04/10 21:33:15 gc -#- add INTERFACE param in sysconfig parameter for smooth interoperation with bastille-firewall -#- -#- Revision 1.38 2001/04/09 18:09:38 yduret -#- deyvounification : remove some un-useful comments in code -#- -#- Revision 1.37 2001/04/09 16:29:20 gc -#- do not die when an initscript returns non-0 (initscripts too buggy) -#- -#- Revision 1.36 2001/04/09 11:39:40 gc -#- fix for when there is an already existing rc.firewall -#- complies with old format of drakgw so that upgrades will work -#- -#- Revision 1.35 2001/04/08 05:33:14 damien -#- updated -#- -#- Revision 1.34 2001/04/06 15:09:15 yduret -#- swap cancel/configure button -#- -#- Revision 1.33 2001/04/06 14:12:06 gc -#- - correct yvounetification in i18n stuff -#- - remove some remaining debugging printings -#- - add a bit more of explanations when starting drakgw in wizard mode -#- -#- Revision 1.32 2001/04/06 01:34:44 yduret -#- recoded a embedded && gtk mode -#- -#- Revision 1.31 2001/03/31 14:21:10 pablo -#- Updated po files and help messages (patch from Pixel) -#- -#- Revision 1.30 2001/03/29 11:52:15 damien -#- updated for new wiz png policy -#- -#- Revision 1.29 2001/03/26 15:29:01 gc -#- first attempt at pixelization of code (till's cups patches) -#- -#- Revision 1.28 2001/03/21 18:07:36 gc -#- honour embedded mode -#- -#- Revision 1.27 2001/03/13 16:23:29 gc -#- fix for bind -#- -#- Revision 1.26 2001/03/13 15:31:05 gc -#- - fix destructive parts of pixelization -#- - fix some own bugs -#- -#- Revision 1.25 2001/03/13 00:00:11 prigaux -#- pixelization -#- -#- Revision 1.24 2001/03/12 18:26:16 gc -#- - make it work as a wizard -#- - make it work with iptables (kernel-2.4) -#- -#- Revision 1.23 2001/03/01 00:18:17 damien -#- updated embedded mode -#- -#- Revision 1.22 2001/02/26 18:39:12 prigaux -#- pixelization -#- -#- Revision 1.21 2001/02/08 10:11:37 damien -#- implemented or updated embedded mode -#- -#- Revision 1.20 2001/02/08 07:00:41 damien -#- added embedded and (ugly) wizard mode. -#- -#- Revision 1.19 2001/01/10 00:32:42 prigaux -#- use standalone and standalone::pkgs_install -#- -#- Revision 1.18 2000/12/16 16:13:34 prigaux -#- use ldetect-lst -#- -#- Revision 1.17 2000/11/13 15:48:33 gc -#- Integrate Till's patches for better work with Cups. -#- -#- Revision 1.16 2000/10/10 15:31:50 gc -#- make only one call to urpmi in order to install all the needed rpm's -#- diff --git a/perl-install/standalone/draknet b/perl-install/standalone/draknet deleted file mode 100755 index 33577f62e..000000000 --- a/perl-install/standalone/draknet +++ /dev/null @@ -1,689 +0,0 @@ -#!/usr/bin/perl - -# DrakNet - -# Copyright (C) 1999 MandrakeSoft (damien@mandrakesoft.com) -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use lib qw(/usr/lib/libDrakX); - -use interactive; -use standalone; -use common; -use network::netconnect; -use network::ethernet; -use network::tools; -use network; -use c; -use MDK::Common; -use any; -use network::isdn; -use network::adsl; -use MDK::Common::Globals "network", qw($in $prefix $disconnect_file $connect_prog $connect_file $disconnect_file); - -my $xpm_path="/usr/share/libDrakX/pixmaps"; -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -$::isWizard = "@ARGV" =~ /--wizard/; -$::expert = "@ARGV" =~ /--expert/; -local $_ = join '', @ARGV; - -#/-h/ and die "usage: draknet[--xf3] [--beginner] [--expert] [--auto] [--noauto] [--skiptest] [--testing]\n"; - -my $netcnx = {}; -my $netc = {}; -my $intf = {}; -my @conx_type = ('modem', 'isdn_internal', 'isdn_external', 'adsl', 'cable', 'lan' ); - -#$::wizard_xpm = "/usr/share/pixmaps/internet.xpm"; - -my $in = 'interactive'->vnew('su', 'network'); -!$::isEmbedded && $in->isa('interactive_gtk') and $::isWizard=1; -$::Wizard_pix_up = "wiz_draknet.png"; -$::Wizard_title = "Network & Internet Configuration"; - -MDK::Common::Globals::init( - in => $in, - prefix => '', - connect_file => "/etc/sysconfig/network-scripts/net_cnx_up", - disconnect_file => "/etc/sysconfig/network-scripts/net_cnx_down", - connect_prog => "/etc/sysconfig/network-scripts/net_cnx_pg" - ); - -$::isEmbedded && ref($in) =~ /gtk/ or goto dd; -require Gtk; -init Gtk; -require my_gtk; -import my_gtk qw(:helpers :wrappers); -my $expert_mode=0; -network::netconnect::read_net_conf('', $netcnx, $netc); -any::setup_thiskind_backend('net', undef); -my @all_cards = network::ethernet::conf_network_card_backend ($netc, $intf, undef, undef, undef, undef); -network::netconnect::load_conf($netcnx, $netc, $intf); - -my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel; -$window1->signal_connect ( delete_event => sub { Gtk->exit(0); }); -$window1->set_position(1); -$window1->set_title(_("Network configuration (%d adapters)", @all_cards)); -$window1->border_width(10); -$::isEmbedded or $window1->set_usize(500, 400); -my $vbox1 = new Gtk::VBox(0,10); -$window1->add($vbox1); -my $hbox1 = new Gtk::HBox(0,0); -$vbox1->pack_start($hbox1,0,0,0); -$hbox1->pack_start(new Gtk::Label(_("Profile: ")),0,0,0); - -my $combo1 = new Gtk::Combo; -$combo1->set_popdown_strings (network::netconnect::get_profiles() ); -my $old_profile=$netcnx->{PROFILE}; -$combo1->entry->set_text($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default"); -$combo1->entry->set_editable(0); -$hbox1->pack_start($combo1,0,0,0); -my $button_del = new Gtk::Button(_("Del profile...")); -$button_del->signal_connect( clicked => sub { - my $dialog = new Gtk::Dialog(); - $dialog->set_position(1); - $dialog->vbox->set_border_width(10); - $dialog->signal_connect ( delete_event => sub { Gtk->main_quit(); }); - $dialog->vbox->pack_start(new Gtk::Label(_("Profile to delete:")),1,1,0); - my $combo_dialog = new Gtk::Combo; - $combo_dialog->set_popdown_strings ( grep { ! /default/ } network::netconnect::get_profiles() ); - $combo_dialog->entry->set_editable(0); - $dialog->vbox->pack_start($combo_dialog,1,1,0); - my $bbox_dialog = new Gtk::HButtonBox; - $dialog->action_area->add($bbox_dialog); - $bbox_dialog->set_layout(-end); - my $button_ok = new Gtk::Button _("OK"); - $button_ok->signal_connect ( clicked => sub { - network::netconnect::del_profile($netcnx, $combo_dialog->entry->get_text()); - $netcnx->{PROFILE} eq $combo_dialog->entry->get_text() and $netcnx->{PROFILE}="default"; - Gtk->main_quit(); - }); - $bbox_dialog->add($button_ok ); - my $button_cancel = new Gtk::Button _("Cancel"); - $button_cancel->signal_connect ( clicked => sub { Gtk->main_quit(); }); - $bbox_dialog->add($button_cancel); - $dialog->show_all; - $dialog->set_modal(1); - Gtk->main(); - $dialog->destroy; - $combo1->entry->set_text((-e "/etc/sysconfig/network-scripts/draknet_conf." . $combo1->entry->get_text) ? $combo1->entry->get_text : "default"); - $combo1->set_popdown_strings(network::netconnect::get_profiles()); - apply(); - }); -$hbox1->pack_start($button_del,0,0,5); -$button_del->set_sensitive(network::netconnect::get_profiles() > 1); -my $button_new = new Gtk::Button(_("New profile...")); -$button_new->signal_connect( clicked => sub { - my $dialog = new Gtk::Dialog(); - $dialog->set_position(1); - $dialog->vbox->set_border_width(10); - $dialog->signal_connect ( delete_event => sub { Gtk->main_quit(); }); - $dialog->vbox->pack_start(new Gtk::Label(_("Name of the profile to create (the new profile is created as a copy of the current one) :")),1,1,0); - my $entry_dialog = new Gtk::Entry; - $dialog->vbox->pack_start($entry_dialog,1,1,0); - my $bbox_dialog = new Gtk::HButtonBox; - $dialog->action_area->add($bbox_dialog); - $bbox_dialog->set_layout(-end); - my $button_ok = new Gtk::Button _("OK"); - $button_ok->signal_connect ( clicked => sub { - network::netconnect::add_profile($netcnx, $entry_dialog->get_text()); - $netcnx->{PROFILE} = $entry_dialog->get_text(); - Gtk->main_quit(); - }); - $bbox_dialog->add($button_ok ); - my $button_cancel = new Gtk::Button _("Cancel"); - $button_cancel->signal_connect ( clicked => sub { Gtk->main_quit(); }); - $bbox_dialog->add($button_cancel); - $dialog->show_all; - $dialog->set_modal(1); - Gtk->main(); - $dialog->destroy; - $combo1->entry->set_text((-e "/etc/sysconfig/network-scripts/draknet_conf." . $netcnx->{PROFILE}) ? $netcnx->{PROFILE} : "default"); - $combo1->set_popdown_strings(network::netconnect::get_profiles()); -}); -$hbox1->pack_start($button_new,0,0,5); -my $hbox2 = new Gtk::HBox(0,0); -$vbox1->pack_start($hbox2,0,0,0); -$hbox2->pack_start(new Gtk::Label(_("Hostname: ")),0,0,0); -my $hostname = chomp_(`hostname`); -my $label_host = new Gtk::Label($hostname); -$hbox2->pack_start($label_host,0,0,0); - -#$vbox1->pack_start(new Gtk::HSeparator,1,1,5); - -my $frame1 = new Gtk::Frame (_("Internet access")); -$vbox1->pack_start($frame1,1,1,0); -my $vbox_frame1 = new Gtk::VBox(0,0); -$vbox_frame1->set_border_width(5); -$frame1->add($vbox_frame1); -my $table1 = new Gtk::Table (3,3, 0); -$table1->set_border_width(5); -$table1->set_row_spacings(5); -$table1->set_col_spacings(5); -#$table1->border_width(10); -$vbox_frame1->pack_start($table1,1,1,0); -#attach (table, child, left_attach, right_attach, top_attach, bottom_attach, xoptions, yoptions, xpadding, ypadding) -#$table->attach($button[0], 0, 1, 0, 1, {expand=>1,fill=>1}, {expand=>1,fill=>1},0,0); -$table1->attach(new Gtk::Label(_("Type:")), 0, 1, 0, 1, 'fill', 'fill',0,0); -my $label4 = new Gtk::Label($netcnx->{type}); -$table1->attach($label4, 1, 2, 0, 1, 'fill', 'fill',0,0); -my $label5 = new Gtk::Label($netcnx->{type} eq 'lan' ? _("Gateway:") : _("Interface:")); -$table1->attach($label5, 0, 1, 1, 2, 'fill', 'fill',0,0); -my $label6 = new Gtk::Label($netcnx->{type} eq 'lan' ? $netc->{GATEWAY} : $netcnx->{NET_INTERFACE}); -$table1->attach($label6, 1, 2, 1, 2, 'fill', 'fill',0,0); -my $isconnected = -1; -sub connected_local { - print "in connected local\n"; - my $w = $in->wait_message('', _("Testing your connection..."), 1); - Gtk->main_iteration while Gtk->events_pending; - $isconnected=connected(); -} -my $label7 = new Gtk::Label(_("Status:")); -$table1->attach($label7, 0, 1, 2, 3, 'fill', 'fill',0,0); -my $label8 = new Gtk::Label(_("Testing your connection...")); -$table1->attach($label8, 1, 2, 2, 3, 'fill', 'fill',0,0); - -my $button2 = new Gtk::Button(_("Wait please")); -$button2->set_sensitive(0); -$button2->signal_connect (clicked => sub { - my $dialog = new Gtk::Dialog(); - $dialog->signal_connect ( delete_event => sub { Gtk->main_quit(); }); - $dialog->set_position(1); - $dialog->vbox->set_border_width(10); - $dialog->signal_connect ( delete_event => sub { Gtk->main_quit(); }); - $dialog->vbox->pack_start(my $l = new Gtk::Label(""),1,1,0); - my $bbox_dialog = new Gtk::HButtonBox; - $dialog->action_area->add($bbox_dialog); - $bbox_dialog->set_layout(-end); - my $button_ok = new Gtk::Button _("OK"); - $button_ok->signal_connect ( clicked => sub { Gtk->main_quit(); }); - $button_ok->set_sensitive(0); - $bbox_dialog->add($button_ok ); - $dialog->show_all; - $dialog->set_modal(1); - if (!$isconnected) { - $l->set(_("Starting your connection...")); - Gtk->main_iteration while Gtk->events_pending; - connect_backend(); - foreach (1..10) { Gtk->main_iteration while Gtk->events_pending; sleep 1; } - my $up=connected_local(); - $l->set($up ? _("The system is now connected to Internet.") : _("The system doesn't seem to be connected to internet. -Try to reconfigure your connection.")); - } else { - $l->set(_("Closing your connection...")); - Gtk->main_iteration while Gtk->events_pending; - disconnect_backend(); - foreach (1..10) { Gtk->main_iteration while Gtk->events_pending; sleep 1; } - my $up=connected_local(); - $l->set($up ? _("The connection is not closed. -Try to do it manually by running -/etc/sysconfig/network-scripts/net_cnx_down -in root.") : _("The system is now disconnected.") ); - } - $button_ok->set_sensitive(1); - Gtk->main(); - $dialog->destroy; - update2(); - }); -$table1->attach($button2, 2, 3, 2, 3, 'fill', 'fill',0,0); - -#$table1->attach($button1, 2, 3, 1, 2, 'fill', 'fill',0,0); - -my $hbox_frame1_button = new Gtk::HBox(0,0); -my $button1 = new Gtk::Button(_("Configure Internet Access...")); -$button1->signal_connect( clicked => [ \&configure_net, '', $netcnx, $netc, $intf]); -$hbox_frame1_button->pack_start($button1, 0, 0, 0); -$vbox_frame1->pack_start($hbox_frame1_button,0,0,0); - -#$vbox1->pack_start(new Gtk::HSeparator,1,1,5); - -my $frame2 = new Gtk::Frame (_("LAN configuration")); -$vbox1->pack_start($frame2,1,1,0); -my $vbox2 = new Gtk::VBox(0,0); -$vbox2->set_border_width(5); -$frame2->add($vbox2); -my $clist1 = new_with_titles Gtk::CList("", _("Interface"), _("IP address"), _("Protocol"), _("Driver"), _("State")); -$clist1->set_column_auto_resize($_,1) foreach (0..4); -$clist1->column_titles_passive(); -$clist1->set_shadow_type('etched_out'); -$vbox2->pack_start($clist1, 0, 0, 5); -#$scrolled1->add_with_viewport($table2); - -my $ip_regexp = qr/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})/; - -build_clist(); - -my $hbox3 = new Gtk::HBox(0,0); -my $button3 = new Gtk::Button(_("Configure Local Area Network...")); -$button3->signal_connect( clicked => [ \&configure_lan, '', $netcnx, $netc, $intf]); -$hbox3->pack_start($button3, 0, 0, 0); -$vbox2->pack_start($hbox3, 0, 0, 0); - -#$vbox1->pack_start(new Gtk::HSeparator,0,0,5); - -my $bbox0 = new Gtk::HButtonBox; -$vbox1->pack_start($bbox0,0,0,0); -$bbox0->set_layout(-end); - - -$bbox0->add(new Gtk::Label(_("Click here to launch the wizard ->"))); -my $button_wizard = new Gtk::Button _("Configure"); -$button_wizard->signal_connect( clicked => sub { - $::isWizard = 1; - system("draknet --wizard"); -# netconnect::intro('', $netcnx, $in); - $combo1->entry->set_text((-e "/etc/sysconfig/network-scripts/draknet_conf." . $combo1->entry->get_text) ? $combo1->entry->get_text : "default"); - network::netconnect::load_conf($netcnx, $netc, $intf); - update(); - }); -$bbox0->add($button_wizard ); - -$vbox1->pack_start(new Gtk::HSeparator,0,0,5); - -my $bbox1 = new Gtk::HButtonBox; -$vbox1->pack_start($bbox1,0,0,0); -$bbox1->set_layout(-end); -#$bbox1->set_border_width(5); - -my $button_expert = new Gtk::Button _("Expert Mode"); -$button_expert->signal_connect ( clicked => sub { - foreach($button1, $button3) { $expert_mode ? $_->hide() : $_->show() } - $button_expert->child->set($expert_mode ? _("Expert Mode") : _("Normal Mode")); - $expert_mode = !$expert_mode; - }); -$bbox1->add($button_expert ); - -my $button_apply = new Gtk::Button _("Apply"); -$button_apply->signal_connect ( clicked => sub { - apply(); - }); -$button_apply->set_sensitive(0); -$bbox1->add($button_apply); - -my $button_cancel = new Gtk::Button _("Cancel"); -$button_cancel->signal_connect ( clicked => sub { - $combo1->entry->set_text($old_profile); - update(); - quit_global(); - }); -$bbox1->add($button_cancel); -my $button_ok = new Gtk::Button _("OK"); -$button_ok->signal_connect ( clicked => sub { - my $dialog = new Gtk::Dialog(); - $dialog->set_position(1); - $dialog->vbox->set_border_width(10); - my $label = new Gtk::Label(_("Please Wait... Applying the configuration")); - $dialog->signal_connect ( delete_event => sub { Gtk->main_quit(); }); - $dialog->vbox->pack_start($label,1,1,20); - $dialog->show_all; - Gtk->main_iteration while Gtk->events_pending; - apply(); - $dialog->destroy; - update(); - quit_global(); - }); -$bbox1->add($button_ok); -$combo1->entry->signal_connect( 'changed', sub { -# connected() and disconnect_backend(); - network::netconnect::set_profile($netcnx, $combo1->entry->get_text()); - network::netconnect::load_conf($netcnx, $netc, $intf); - $netcnx->{$_}=$netc->{$_} foreach qw(NET_DEVICE NET_INTERFACE); - network::netconnect::set_net_conf($netcnx, $netc); - update(); - $button_apply->set_sensitive(1); - }); - -$window1->show_all(); -$_->hide foreach ($button1, $button3); -Gtk->main_iteration while Gtk->events_pending; -$::isEmbedded and kill USR2, $::CCPID; -my $tag = Gtk->timeout_add(4000, \&update2); -Gtk->main; -Gtk->exit(0); - -dd: -network::netconnect::intro('', $netcnx, $in); -$in->exit(0); - -sub build_clist { - foreach my $i (0..$#all_cards) { - my $ip; - if (-e "/sbin/ifconfig") { - local $_=`LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C /sbin/ifconfig "eth$i"`; - /inet addr\:$ip_regexp/; $ip = if_($1 && $2 && $3, "$1.$2.$3.$4"); - $_=`LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C /sbin/ifconfig`; - $state = /eth$i/ ? "up" : "down"; - } else { $ip=$intf->{"eth$_"}{IPADDR}; $state = "n/a"; } - $clist1->append("", "eth$i", $ip , $intf->{"eth$i"}{BOOTPROTO}, $all_cards[$i]->[1], $state); - $clist1->set_pixmap ($i, 0, gtkcreate_png("eth_card_mini2.png")); - - $clist1->set_selectable($i, 0); - } -} - -sub apply { - $old_profile=$netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default"; - network::netconnect::save_conf($netcnx, $netc, $intf); - - $netcnx->{type} eq 'modem' and any::pppConfig($in, $netcnx->{$netcnx->{type}}, ''); - $netcnx->{type} eq 'isdn_internal' and network::isdn::isdn_write_config_backend($netcnx->{$netcnx->{type}}, 1, $netc, $netcnx); #$light - $netcnx->{type} eq 'isdn_external' and any::pppConfig($in, $netcnx->{$netcnx->{type}}, ''); - $netcnx->{type} eq 'adsl_ppoe' and network::adsl::adsl_conf_backend($netcnx->{$netcnx->{type}}, $netc, 'pppoe', $netcnx); - $netcnx->{type} eq 'adsl_pptp' and network::adsl::adsl_conf_backend($netcnx->{$netcnx->{type}}, $netc, 'pptp', $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"); - 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]/ } - -sub update { - my $h = chomp_(`hostname`); - $label_host->set ($h); - $label4->set($netcnx->{type}); - $label5->set($netcnx->{type} eq 'lan' ? _("Gateway:") : _("Interface:")); - $label6->set($netcnx->{type} eq 'lan' ? $netc->{GATEWAY} : $netcnx->{NET_INTERFACE}); - $clist1->freeze(); - $clist1->clear(); - build_clist(); - $clist1->thaw(); - $button_del->set_sensitive(network::netconnect::get_profiles() > 1); - $isconnected !=-1 or return 1; - $label8->set($isconnected ? _("Connected") : _("Not connected")); - $button2->child->set($isconnected ? _("Disconnect...") : _("Connect...")); - $button2->set_sensitive(1); - 1; -} - -sub update2 { - connected_bg(\$isconnected); - update(); - 1; -} -sub quit_global { - $::isEmbedded ? kill(USR1, $::CCPID) : Gtk->exit(0); -} - -sub configure_lan { - my (undef, $prefix, $netcnx, $netc, $intf) = @_; - my $window = new Gtk::Window -toplevel; - - my @card_tab; - - if (@all_cards < 1) { - my $dialog = new Gtk::Dialog(); - $dialog->set_position(1); - $dialog->vbox->set_border_width(10); - $dialog->signal_connect ( delete_event => sub { Gtk->main_quit() }); - $dialog->vbox->pack_start(new Gtk::Label(_("You don't have any configured interface. -Configure them first by clicking on 'Configure'")),1,1,0); - my $bbox_dialog = new Gtk::HButtonBox; - $dialog->action_area->add($bbox_dialog); - $bbox_dialog->set_layout(-end); - my $button_ok = new Gtk::Button _("OK"); - $button_ok->signal_connect ( clicked => sub { Gtk->main_quit() }); - $bbox_dialog->add($button_ok ); - $dialog->show_all; - $dialog->set_modal(1); - Gtk->main(); - $dialog->destroy; - return; - } - - $window->set_policy (1, 1, 1); - $window->signal_connect ( delete_event => sub { Gtk->main_quit; }); - $window->set_position(1); - $window->set_title(_("LAN configuration")); - $window->border_width(10); - my $vbox1 = new Gtk::VBox(0,0); - $window->add($vbox1); - $vbox1->pack_start(new Gtk::Label(_("LAN Configuration")),0,1,0); - my $notebook = new Gtk::Notebook; - $vbox1->pack_start($notebook,0,1,0); - my @eth_data; - foreach (0..$#all_cards) { - my @infos; - my @conf_data; - $card_tab[2*$_] = \@infos; - $card_tab[2*$_+1] = \@conf_data; - my $vbox_local=new Gtk::VBox(0,0); - $vbox_local->set_border_width(10); - $vbox_local->pack_start(new Gtk::Label( _("Adapter %s: %s", $_+1 , "eth$_")),1,1,0); - # Eth${_}Hostname=$netc->{HOSTNAME} - # Eth${_}HostAlias=" . do { $netc->{HOSTNAME} =~ /([^\.]*)\./; $1 } . " - # Eth${_}Driver=$all_cards[$_]->[1] - @conf_data = ([_("IP address"), \$intf->{"eth$_"}{IPADDR}], - [_("Netmask"), \$intf->{"eth$_"}{NETMASK}], - [_("Boot Protocol"), \$intf->{"eth$_"}{BOOTPROTO}, ["static", "dhcp", "bootp"]], - [_("Started on boot"), \$intf->{"eth$_"}{ONBOOT} , ["yes", "no"]], - [_("DHCP client"), \$netcnx->{dhcp_client}] - ); - my $i=0; - foreach my $j (@conf_data) { - $infos[2*$i]=new Gtk::HBox(0,0); - my $l=new Gtk::Label($j->[0]); - $l->set_justify('left'); - $infos[2*$i]->pack_start($l,1,1,0); - $vbox_local->pack_start($infos[2*$i],0,0,0); - if (defined $j->[2]) { - my $c=new Gtk::Combo(); - $c->set_popdown_strings(@{$j->[2]}); - $infos[2*$i+1]=$c->entry; - $infos[2*$i+1]->set_editable(0); - $infos[2*$i]->pack_start($c,0,0,0); - } else { - $infos[2*$i+1]=new Gtk::Entry(); - $infos[2*$i]->pack_start($infos[2*$i+1],0,0,0); - } - $infos[2*$i+1]->set_text(${$j->[1]}); - $i++; - } - my $c = $_; - $vbox_local->pack_start(gtkpack__(new Gtk::HBox(0,0), - gtksignal_connect(my $b = new Gtk::Button(ethisup($c) ? _("desactivate now") : _("activate now")), clicked => sub { - system("/sbin/if".(ethisup($c)?"down":"up")." eth$c"); - gtkbuttonset($_[0], ethisup($c)?_("desactivate now"):_("activate now")); - })),0,0,0); - # $clist1->append($_+1, "eth$_", $intf->{"eth$_"}{IPADDR}, $intf->{"eth$_"}{BOOTPROTO}, $all_cards[$_]->[1]); - # $clist1->set_selectable($_, 0); -# require Data::Dumper; -# print "------------\n" . Data::Dumper->Dump([$b],['b']) . "\n"; - my $hbox_local = new Gtk::HBox(0,0); - my $pix = gtkpng("/usr/share/libDrakX/pixmaps/eth_card_mini.png"); - $hbox_local->pack_start($pix,0,0,0); - $hbox_local->pack_start(new Gtk::Label("eth$_"),0,0,0); - $hbox_local->show_all; - $notebook->append_page($vbox_local, $hbox_local); - } - my $bbox1 = new Gtk::HButtonBox; - $vbox1->pack_start($bbox1,0,0,10); - $bbox1->set_layout(-end); - my $button_ok = new Gtk::Button( _("OK") ); - $button_ok->signal_connect ( clicked => sub { - foreach (0..$#all_cards) { - my $i=0; - my @infos = @{$card_tab[2*$_]}; - my @conf_data = @{$card_tab[2*$_+1]}; - foreach my $j (@conf_data) { - ${$j->[1]}=$infos[2*$i+1]->get_text(); - $i++; - } - } - update(); - $button_apply->set_sensitive(1); - $window->destroy(); Gtk->main_quit; - }); - $bbox1->add($button_ok); - my $button_cancel = new Gtk::Button( _("Cancel") ); - $button_cancel->signal_connect ( clicked => sub { $window->destroy(); Gtk->main_quit }); - $bbox1->add($button_cancel); - - $window->set_modal(1); - $window->show_all(); - foreach (0..$#all_cards) { - my @infos = @{$card_tab[2*$_]}; - $intf->{"eth$_"}{BOOTPROTO} eq "dhcp" or $infos[8]->hide; - } - $window->set_position('center_always'); - Gtk->main; -} - - -sub configure_net { - my (undef, $prefix, $netcnx, $netc, $intf) = @_; - if (!$netcnx->{type}) { - my $dialog = new Gtk::Dialog(); - $dialog->set_position(1); - $dialog->vbox->set_border_width(10); - $dialog->signal_connect ( delete_event => sub { Gtk->main_quit(); }); - $dialog->vbox->pack_start(new Gtk::Label(_("You don't have any internet connection. -Create one first by clicking on 'Configure'")),1,1,0); - my $bbox_dialog = new Gtk::HButtonBox; - $dialog->action_area->add($bbox_dialog); - $bbox_dialog->set_layout(-end); - my $button_ok = new Gtk::Button _("OK"); - $button_ok->signal_connect ( clicked => sub { - Gtk->main_quit(); - }); - $bbox_dialog->add($button_ok ); - $dialog->show_all; - $dialog->set_modal(1); - Gtk->main(); - $dialog->destroy; - return; - } - my $cnx={}; - my @infos; - $cnx=$netcnx->{$netcnx->{type}}; - my $auto_detect={}; - my $window = new Gtk::Window -toplevel; - $window->set_policy (1, 1, 1); - $window->signal_connect ( delete_event => sub { Gtk->main_quit; }); - $window->set_position(1); - $window->set_title(_("Internet connection configuration")); - $window->border_width(10); - my $vbox1 = new Gtk::VBox(0,0); - $window->add($vbox1); - $vbox1->pack_start(new Gtk::Label(_("Internet Connection Configuration")),0,1,0); - - $vbox1->pack_start(new Gtk::HSeparator,0,0,5); - my $table1 = new Gtk::Table (2, 4, 0); - $table1->set_row_spacings(5); - $table1->set_col_spacings(5); - $vbox1->pack_start($table1,0,0,0); - $table1->attach(new Gtk::Label(_("Profile: ")), 0, 1, 0, 1, 'fill', 'fill',0,0); - $table1->attach(new Gtk::Label(_($netcnx->{PROFILE})), 1, 2, 0, 1, 'fill', 'fill',0,0); - $table1->attach(new Gtk::Label(_("Connection type: ")), 0, 1, 1, 2, 'fill', 'fill',0,0); - $table1->attach(new Gtk::Label(_($netcnx->{type})), 1, 2, 1, 2, 'fill', 'fill',0,0); -# my $button1 = new Gtk::Button(_("Reconfigure using wizard...")); -# $table1->attach($button1, 2, 4, 0, 2, 'fill', 'fill',0,0); - $vbox1->pack_start(new Gtk::HSeparator,0,0,5); - - my $frame1 = new Gtk::Frame (_("Parameters")); - $vbox1->pack_start($frame1,1,1,0); - my $vbox2 = new Gtk::VBox(0,0); - $frame1->add($vbox2); - my $i=0; - my @conf_data = ([_("Card IRQ"), \$cnx->{irq} ], - [_("Card mem (DMA)"), \$cnx->{mem} ], - [_("Card IO"), \$cnx->{io} ], - [_("Card IO_0"), \$cnx->{io0} ], - [_("Card IO_1"), \$cnx->{io1} ], - [_("Your personal phone number"), \$cnx->{phone_in} ], - [_("Provider name (ex provider.net)"), \$netc->{DOMAINNAME2}], - [_("Provider phone number"), \$cnx->{phone_out} ], - [_("Provider dns 1 (optional)"), \$netc->{dnsServer2}], - [_("Provider dns 2 (optional)"), \$netc->{dnsServer3}], - [_("Account Login (user name)"), \$cnx->{login} ], - [_("Account Password"), \$cnx->{passwd} ], - [_("Dialing mode"), \$cnx->{dialing_mode}, [ "auto", "manual"] ], - [_("Gateway"), \$netc->{GATEWAY}], - [_("Connection name"), \$cnx->{connection} ], - [_("Phone number"), \$cnx->{phone} ], - [_("Login ID"), \$cnx->{login} ], - [_("Password"), \$cnx->{passwd} ], - [_("Authentication"), \$cnx->{auth}, [ _("PAP"), _("Terminal-based"), _("Script-based"), __("CHAP") ] ], - [_("Domain name"), \$cnx->{domain} ], - [_("First DNS Server (optional)"), \$cnx->{dns1} ], - [_("Second DNS Server (optional)"), \$cnx->{dns2} ], - [_("Ethernet Card"), \$netc->{NET_DEVICE}, [ 'eth0', 'eth1', 'eth2', 'eth3', 'eth4', 'eth5','eth6', 'eth7', 'eth8', 'eth9' ]], - [_("DHCP Client"), \$netcnx->{dhcp_client}, ["dhcpcd", "dhcpxd", "dhcp-client"] ], - [_("Connection speed"), \$cnx->{speed}, ["64 Kb/s", "128 Kb/s"]], - [_("Connection timeout (in sec)"), \$cnx->{huptimeout} ] -); - foreach (@conf_data) { - $infos[2*$i]=new Gtk::HBox(0,0); - my $l=new Gtk::Label($_->[0]); - $l->set_justify('left'); - $infos[2*$i]->pack_start($l,1,1,0); - $vbox2->pack_start($infos[2*$i],0,0,0); - if (defined $_->[2]) { - my $c=new Gtk::Combo(); - $c->set_popdown_strings(@{$_->[2]}); - $infos[2*$i+1]=$c->entry; - $infos[2*$i]->pack_start($c,0,0,0); - } else { - $infos[2*$i+1]=new Gtk::Entry(); - $infos[2*$i]->pack_start($infos[2*$i+1],0,0,0); - } - $infos[2*$i+1]->set_text(${$_->[1]}); - $i++; - } - my @mask; -@mask=(0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0) if $netcnx->{type} eq 'lan'; -@mask=(0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,1) if $netcnx->{type} eq'isdn_internal'&& defined $cnx->{vendor} && defined $cnx->{id}; -@mask=(1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,1,1) if $netcnx->{type} eq'isdn_internal'&&(!defined $cnx->{vendor}||!defined $cnx->{id}); -@mask=(0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0) if ($netcnx->{type} eq 'modem'||$netcnx->{type} eq 'isdn_external'); -@mask=(0,0,0,0,0,0,1,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,1,0,0,0) if $netcnx->{type} =~ 'adsl'; -@mask=(0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0) if $netcnx->{type} eq 'cable'; - $vbox1->pack_start(new Gtk::HSeparator,0,0,5); - - - my $bbox1 = new Gtk::HButtonBox; - $vbox1->pack_start($bbox1,0,0,0); - $bbox1->set_layout(-end); - my $button_ok = new Gtk::Button _("OK"); - $button_ok->signal_connect ( clicked => sub { - $i=0; - foreach (@mask) { - if ($_) { - ${$conf_data[$i]->[1]}=$infos[2*$i+1]->get_text(); - } - $i++; - } - update(); - $button_apply->set_sensitive(1); - $window->destroy(); Gtk->main_quit; - }); - $bbox1->add($button_ok); - my $button_cancel = new Gtk::Button _("Cancel"); - $button_cancel->signal_connect ( clicked => sub { $window->destroy(); Gtk->main_quit }); - $bbox1->add($button_cancel); - - $window->set_modal(1); - $window->show_all(); - $i=0; - foreach (@mask) { - if ($_) { $infos[2*$i]->show } - else { $infos[2*$i]->hide; } - $i++; - } - $window->set_position('center_always'); - Gtk->main; -} diff --git a/perl-install/standalone/drakproxy b/perl-install/standalone/drakproxy deleted file mode 100755 index acfc159ba..000000000 --- a/perl-install/standalone/drakproxy +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl - -# -# DindinX (odin@mandrakesoft.com) -# -# Copyright 2001 MandrakeSoft -# -# This software may be freely redistributed under the terms of the GNU -# public license. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -# - -use lib qw(/usr/lib/libDrakX); - -use interactive; -use standalone; -use proxy; - -use my_gtk qw(:helpers :wrappers); -# use detect_devices; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; - -local $_ = join '', @ARGV; - -/-h/ and die "usage: drakproxy [--version]\n"; -/-version/ and die 'version: drakproxy 1.0 2001/05/22 dindinx'."\n"; -$::isEmbedded or $::isWizard = 1; -$::Wizard_pix_up = "wiz_drakgw.png"; # FIXME -$::Wizard_title = _("Proxy handling"); - -my $in = 'interactive'->vnew('su', 'default'); - -if ($::isWizard || ($::isEmbedded && $in->isa('interactive_gtk'))) { - proxy::main('', $in); - $in->exit(0); -} - -# pure gtk_mode -my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel; -$window1->signal_connect ( delete_event => sub { Gtk->exit(0); }); -$window1->set_position(1); -$window1->set_title(_("Proxy configuration")); -$window1->border_width(10); -gtkshow(gtkadd($window1, - gtkpack_(new Gtk::VBox(0,0), - 1, gtkpack(new Gtk::HBox(0,0), - new Gtk::Label _("Welcome to the Proxy Connection utility - -Click on Configure to launch the setup wizard."), - ), - 1, gtkpack(my $hbox2 = new Gtk::HBox(0,0),), - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -end), - gtksignal_connect(new Gtk::Button(_("Configure")), clicked => sub { system ("/usr/sbin/drakproxy --wizard") }), - gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub { kill(USR1, $::CCPID) }), - ) - ) - ) - ); -Gtk->main_iteration while Gtk->events_pending; -$::isEmbedded and kill USR2, $::CCPID; -Gtk->main; -Gtk->exit(0); - -#------------------------------------------------- -#- $Log$ -#- Revision 1.8 2001/10/30 20:11:31 damien -#- corrected ref($in) =~ /gtk/ -#- -#- Revision 1.7 2001/08/09 09:35:37 gc -#- use vnew the right way everywhere -#- -#- Revision 1.6 2001/08/08 18:26:31 prigaux -#- add interactive_pkgs stuff -#- -#- Revision 1.5 2001/06/12 12:45:57 odin -#- ui for drakproxy almost done -#- -#- Revision 1.4 2001/06/11 16:34:49 damien -#- corrected CVS: ---------------------------------------------------------------------- -#- -#- Revision 1.2 2001/06/11 16:03:10 damien -#- perlised -#- -#- Revision 1.1 2001/06/11 15:22:41 odin -#- first import of drakproxy -#- -#- diff --git a/perl-install/standalone/draksec b/perl-install/standalone/draksec deleted file mode 100755 index cf536104c..000000000 --- a/perl-install/standalone/draksec +++ /dev/null @@ -1,93 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use common; -use interactive; -use standalone; -use mouse; -use c; - -local $_ = join '', @ARGV; - -/-h/ and die "usage: draksec [--expert]\n"; - -$::expert = /-expert/ || cat_("/etc/sysconfig/system") =~ /^CLASS="?expert/m; #" -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; - -my $in = 'interactive'->vnew('su', 'security'); - -my %m = reverse (my %l = ( - 0 => _("Welcome To Crackers"), - 1 => _("Poor"), - 2 => _("Low"), - 3 => _("Medium"), - 4 => _("High"), - 5 => _("Paranoid"), -)); -my %help = ( - 0 => _("This level is to be used with care. It makes your system more easy to use, -but very sensitive: it must not be used for a machine connected to others -or to the Internet. There is no password access."), - 1 => _("Password are now enabled, but use as a networked computer is still not recommended."), - 2 => _("Few improvements for this security level, the main one is that there are -more security warnings and checks."), - 3 => _("This is the standard security recommended for a computer that will be used -to connect to the Internet as a client. There are now security checks. "), - 4 => _("With this security level, the use of this system as a server becomes possible. -The security is now high enough to use the system as a server which accept -connections from many clients. "), - 5 => _("We take level 4 features, but now the system is entirely closed. -Security features are at their maximum."), -); - -delete @l{0,1,5} unless $::expert; -delete @help{0,1,5} unless $::expert; - -begin: -$::isEmbedded and kill USR2, $::CCPID; - - -#$in->ask_from('', -# _("Choose security level") . "\n\n" . join('', map { "$l{$_}: $help{$_}\n\n" } keys %l), -# { label => _($st->{$f}{text}), val => \$def_choice, list => [ 'replay', 'manual' ] }, -# { label => _($st->{$f}{text}), val => \$def_choice, list => [ 'replay', 'manual' ] } -# ) - -my $libsafe; -my $secure_level; -if (-e "$prefix/etc/profile.d/msec.sh") { - local $_ = cat_("$prefix/etc/profile.d/msec.sh"); - /export SECURE_LEVEL=(\d+)/ and $secure_level = $1; -} -$secure_level ||= $ENV{SECURE_LEVEL}; -$secure_level ||= 2; -$secure_level = $l{$secure_level}; - -my %h = getVarsFromSh("$prefix/etc/sysconfig/system"); -$libsafe = $h{LIBSAFE} =~ /yes/i; - -if ($in->ask_from('', _("Choose security level") . "\n\n" . - join('', map { "$l{$_}: $help{$_}\n\n" } keys %l), - [ - { label => _("Security level"), val => \$secure_level, list => [ (values %l) ] }, - if_(pkgs_interactive::is_installed('libsafe') && arch() =~ /^i.86/, - { label => _("Use libsafe for servers"), val => \$libsafe, type => 'bool', text => - _("A library which defends against buffer overflow and format string attacks.") } - ) - ] - )) { - my $w = $in->wait_message('', _("Setting security level")); - $in->suspend; - - $ENV{LILO_PASSWORD} = ''; # make it non interactive - system "/usr/sbin/msec", $m{$secure_level}; - my %t = getVarsFromSh("$prefix/etc/sysconfig/system"); - - $t{LIBSAFE} = bool2yesno($libsafe); - setVarsInSh("$prefix/etc/sysconfig/system", \%t); - $in->resume; -} - -!$::isEmbedded ? $in->exit(0) : kill(USR1, $::CCPID); -goto begin; diff --git a/perl-install/standalone/drakxconf b/perl-install/standalone/drakxconf deleted file mode 100755 index 51530940d..000000000 --- a/perl-install/standalone/drakxconf +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - - -use interactive; -use standalone; -use keyboard; -use Xconfigurator_consts; -use common; -use c; - -local $_ = join '', @ARGV; - -/-h/ and die "usage: drakxconf\n"; -/-version/ and die "version: $Id$\n"; - -my $in = 'interactive'->vnew('su', 'default'); -my @l=( - { des => 'Display Configuration', - cmd => 'XFdrake'}, - { des => 'KeyBoard Configuration', - cmd => 'keyboarddrake'}, - { des => 'Mouse Configuration', - cmd => 'mousedrake'}, - { des => 'Hardware Information', - cmd => 'harddrake'}, - { des => 'Internet & Network', - cmd => 'draknet'}, - { des => 'Printer Configuration', - cmd => 'printerdrake'}, - { des => 'Add new users', - cmd => 'adduserdrake'}, - { des => 'Service Configuration', - cmd => 'drakxservices'}, - { des => 'Security Levels', - cmd => 'draksec'}, - { des => 'Boot Configuration', - cmd => 'drakboot'}, - { des => 'Auto Install', - cmd => 'drakautoinst'}, - { des => 'Connection Sharing', - cmd => 'drakgw'}, - { des => 'Diskdrake', - cmd => 'diskdrake'}, - ); -my $choice = $in->ask_from_listf(_("Control Center"), - _("Choose the tool you want to use"), - sub { (int grep { -x "$_/" . $_[0]{cmd} } split (":", $ENV{PATH})) ? $_[0]{des} : () },#grep { my $prog = $_; int grep { -x "$_/$prog" } split ":", $ENV{PATH} } $_[0]{des} }, - \@l ) or $in->exit(1); -$in->end; - -exec $choice->{cmd}, @ARGV or $in->exit(1); diff --git a/perl-install/standalone/drakxservices b/perl-install/standalone/drakxservices deleted file mode 100755 index 21e7baade..000000000 --- a/perl-install/standalone/drakxservices +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use common; -use interactive; -use standalone; -use services; -use log; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; - -local $_ = join '', @ARGV; - -/-h/ and die "usage: drakxservices\n"; - - -my $in = 'interactive'->vnew('su', 'services'); -begin: -my $l = services::ask($in); -services::doit($in, $l) if $l; -!$::isEmbedded and $in->exit(0); -kill USR1, $::CCPID; -goto begin; diff --git a/perl-install/standalone/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/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/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 d113e1297..000000000 --- a/perl-install/standalone/interactive_http/authorised_progs +++ /dev/null @@ -1,13 +0,0 @@ -/usr/sbin/XFdrake -/usr/sbin/adduserdrake -/usr/sbin/diskdrake -/usr/sbin/drakautoinst -/usr/sbin/drakboot -/usr/sbin/drakgw -/usr/sbin/draknet -/usr/sbin/draksec -/usr/sbin/drakxservices -/usr/sbin/keyboarddrake -/usr/sbin/mousedrake -/usr/sbin/printerdrake -/usr/sbin/tinyfirewall diff --git a/perl-install/standalone/interactive_http/index.html.pl b/perl-install/standalone/interactive_http/index.html.pl deleted file mode 100644 index afd91459b..000000000 --- a/perl-install/standalone/interactive_http/index.html.pl +++ /dev/null @@ -1,14 +0,0 @@ -use MDK::Common; - -print '<html> -'; -foreach (map { chomp_($_) } cat_('authorised_progs')) { - my $name = basename($_); - print -qq(<a href="/interactive_http.cgi?state=new&prog=$_">$name</a> -<br> -); -} -print ' -</html> -'; diff --git a/perl-install/standalone/interactive_http/interactive_http.cgi b/perl-install/standalone/interactive_http/interactive_http.cgi deleted file mode 100755 index 935a4a765..000000000 --- a/perl-install/standalone/interactive_http/interactive_http.cgi +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); -use CGI; -use common; -use c; - -my $q = CGI->new; -$| = 1; - -my $script_name = $q->url(-relative => 1); - -# name inversed (must be in sync with interactive_http.html) -my $pipe_r = "/tmp/interactive_http_w"; -my $pipe_w = "/tmp/interactive_http_r"; - -if ($q->param('state') eq 'new') { - force_exit_dead_prog(); - mkfifo($pipe_r); mkfifo($pipe_w); - - spawn_server($q->param('prog')); - first_step(); - -} elsif ($q->param('state') eq 'next_step') { - next_step(); -} else { - error("booh..."); -} - -sub read_ { - local *F; - open F, "<$pipe_r" or error("Failed to connect to the prog"); - my $t; - print $t while sysread F, $t, 1; -} -sub write_ { - local *F; - open F, ">$pipe_w" or die; - my $q = CGI->new; - $q->save(\*F); -} - -sub first_step { read_() } -sub next_step { write_(); read_() } - - -sub force_exit_dead_prog { - -p $pipe_w or return; - { - local *F; - sysopen F, $pipe_w, 1 | c::O_NONBLOCK() or return; - syswrite F, "force_exit_dead_prog=1\n"; - } - - my $cnt = 10; - while (-p $pipe_w) { - sleep 1; - $cnt-- or error("Dead prog failed to exit"); - } -} - -sub spawn_server { - my ($prog) = @_; - - my @authorised_progs = map { chomp_($_) } cat_('/etc/drakxtools_http/authorised_progs'); - member($prog, @authorised_progs) or error("You tried to call a non-authorised program"); - - fork and return; - - $ENV{INTERACTIVE_HTTP} = $script_name; - - open STDIN, "</dev/zero"; - open STDOUT, ">/dev/null"; #tmp/log"; - open STDERR, ">&STDOUT"; - - c::setsid(); - exec $prog or die "prog $prog not found\n"; -} - -sub error { - my $msg = join '', @_; - - print $q->header(), $q->start_html(); - print $q->h1(_("Error")), @_; - print $q->end_html(), "\n"; - exit 0; -} - -sub mkfifo { - my ($f) = @_; - -p $f and return; - unlink $f; - syscall_('mknod', $f, c::S_IFIFO() | 0600, 0) or die "mkfifo failed"; - chmod 0666, $f; -} diff --git a/perl-install/standalone/interactive_http/miniserv.conf b/perl-install/standalone/interactive_http/miniserv.conf deleted file mode 100644 index 99f6a5172..000000000 --- a/perl-install/standalone/interactive_http/miniserv.conf +++ /dev/null @@ -1,13 +0,0 @@ -ssl=1 -log=1 -port=10001 -listen=10001 -forkcgis=1 -realm=Drakxtools Server - -addtype_cgi=internal/cgi -logfile=/var/log/drakxtools_http.log -pidfile=/var/run/drakxtools_http.pid -root=/usr/share/libDrakX/drakxtools_http/www -keyfile=/usr/share/libDrakX/drakxtools_http/miniserv.pem -userfile=/usr/share/libDrakX/drakxtools_http/miniserv.users diff --git a/perl-install/standalone/interactive_http/miniserv.init b/perl-install/standalone/interactive_http/miniserv.init deleted file mode 100644 index e7673083c..000000000 --- a/perl-install/standalone/interactive_http/miniserv.init +++ /dev/null @@ -1,51 +0,0 @@ -#!/bin/sh -# chkconfig: 235 99 00 -# description: Start or stop the miniserv administration server - -name=drakxtools_http -server=/usr/share/libDrakX/$name/miniserv.pl - -case "$1" in -'start') - echo -n "Starting $name: " - perl $server /etc/$name/conf - touch /var/lock/subsys/drakxtools_http - echo $name - ;; -'stop') - echo -n "Shutting down $name: " - kill `cat /var/run/$name.pid` - rm -f /var/lock/subsys/drakxtools_http - echo $name - ;; -'status') - if [ -s /var/run/$name.pid ]; then - pid=`cat /var/run/$name.pid` - kill -0 $pid >/dev/null 2>&1 - if [ "$?" = "0" ]; then - echo "$name (pid $pid) is running" - else - echo "$name is stopped" - fi - else - echo "$name is stopped" - fi - ;; -'restart') - $0 stop - $0 start - ;; -'reload') - $0 stop - $0 start - ;; -'condrestart') - if [ -f /var/lock/subsys/drakxtools_http ]; then - $0 restart - fi - ;; -*) - echo "Usage: $0 {start|stop|restart|status|reload|condrestart}" - ;; -esac -exit 0 diff --git a/perl-install/standalone/interactive_http/miniserv.logrotate b/perl-install/standalone/interactive_http/miniserv.logrotate deleted file mode 100644 index b1e833f9b..000000000 --- a/perl-install/standalone/interactive_http/miniserv.logrotate +++ /dev/null @@ -1,7 +0,0 @@ -# Logrotate file for drakxtools-http RPM - -/var/log/drakxtools_http.log { - weekly - notifempty - missingok -} diff --git a/perl-install/standalone/interactive_http/miniserv.pam b/perl-install/standalone/interactive_http/miniserv.pam deleted file mode 100644 index 37eae44e0..000000000 --- a/perl-install/standalone/interactive_http/miniserv.pam +++ /dev/null @@ -1,5 +0,0 @@ -#%PAM-1.0 -auth required /lib/security/pam_stack.so service=system-auth -account required /lib/security/pam_stack.so service=system-auth -password required /lib/security/pam_stack.so service=system-auth -session required /lib/security/pam_stack.so service=system-auth diff --git a/perl-install/standalone/interactive_http/miniserv.pem b/perl-install/standalone/interactive_http/miniserv.pem deleted file mode 100644 index e11919e37..000000000 --- a/perl-install/standalone/interactive_http/miniserv.pem +++ /dev/null @@ -1,18 +0,0 @@ ------BEGIN RSA PRIVATE KEY----- -MIIBOgIBAAJBANaRBV7X6DWUbTm8KBjjHx4CAHVSQCmei8QIwruVPngwOkEhsgzf -IT1IY6jyY3QM6a4ASl7xokoy5U4QZ8E/q40CAwEAAQJBAIwMLA0zr4UJVCGTBjj4 -RZ84f0QUY3zG10Mk1LXLO/MFlRol+640x/PB76fPKP+Gx+88s8F6lcx7uV+jB0bM -F6ECIQD3aYxjgxLinAmTjZf5gJDm/5LeEogML7nJ+aXJs8oAFwIhAN4DnKUfjiim -pOowhaRqy8b9fjXG8L+SG/+KcZDsWzP7AiBO2gXTRVgEfwSSUUNJUo9b/8I4IqHX -eHJ3C6ip8zIC+wIgdhsVygHvblC4ip0le0IVBdb0vUcH6+GeY2MS5zXVjuECIEP0 -GLnMXcQ02f8rQz0eeBYVHTNXKRMesgo3ZNcpDB2k ------END RSA PRIVATE KEY----- ------BEGIN CERTIFICATE----- -MIIBNTCB4AIBADANBgkqhkiG9w0BAQQFADAmMRgwFgYDVQQKEw9XZWJtaW4gU29m -dHdhcmUxCjAIBgNVBAMUASowHhcNOTgwMTAzMTAzNDUwWhcNMDcxMDAzMTAzNDUw -WjAmMRgwFgYDVQQKEw9XZWJtaW4gU29mdHdhcmUxCjAIBgNVBAMUASowXDANBgkq -hkiG9w0BAQEFAANLADBIAkEA1pEFXtfoNZRtObwoGOMfHgIAdVJAKZ6LxAjCu5U+ -eDA6QSGyDN8hPUhjqPJjdAzprgBKXvGiSjLlThBnwT+rjQIDAQABMA0GCSqGSIb3 -DQEBBAUAA0EAFCoYeLlWcClpv2sSc7zIchsMR3DKeH/O1ZtfEezzkaonre78HeYV -wSQvuoVleb7A497TFcSB6+FON6azoVqPyQ== ------END CERTIFICATE----- diff --git a/perl-install/standalone/interactive_http/miniserv.pl b/perl-install/standalone/interactive_http/miniserv.pl deleted file mode 100644 index b11ce26e2..000000000 --- a/perl-install/standalone/interactive_http/miniserv.pl +++ /dev/null @@ -1,1817 +0,0 @@ -#!/usr/bin/perl -# A very simple perl web server used by Webmin - -# Require basic libraries -package miniserv; -use Socket; -use POSIX; -use Sys::Hostname; - -# Find and read config file -if (@ARGV != 1) { - die "Usage: miniserv.pl <config file>"; - } -if ($ARGV[0] =~ /^\//) { - $conf = $ARGV[0]; - } -else { - chop($pwd = `pwd`); - $conf = "$pwd/$ARGV[0]"; - } -open(CONF, $conf) || die "Failed to open config file $conf : $!"; -while(<CONF>) { - s/\r|\n//g; - if (/^#/ || !/\S/) { next; } - /^([^=]+)=(.*)$/; - $name = $1; $val = $2; - $name =~ s/^\s+//g; $name =~ s/\s+$//g; - $val =~ s/^\s+//g; $val =~ s/\s+$//g; - $config{$name} = $val; - } -close(CONF); - -# Check is SSL is enabled and available -if ($config{'ssl'}) { - eval "use Net::SSLeay"; - if (!$@) { - $use_ssl = 1; - # These functions only exist for SSLeay 1.0 - eval "Net::SSLeay::SSLeay_add_ssl_algorithms()"; - eval "Net::SSLeay::load_error_strings()"; - if (defined(&Net::SSLeay::X509_STORE_CTX_get_current_cert) && - defined(&Net::SSLeay::CTX_load_verify_locations) && - defined(&Net::SSLeay::CTX_set_verify)) { - $client_certs = 1; - } - } - } - -# Check if the syslog module is available to log hacking attempts -if ($config{'syslog'}) { - eval "use Sys::Syslog qw(:DEFAULT setlogsock)"; - if (!$@) { - $use_syslog = 1; - } - } - -# check if the PAM module is available to authenticate -eval "use Authen::PAM"; -if (!$@) { - # check if the PAM authentication can be used by opening a handle - if (! ref($pamh = new Authen::PAM("miniserv", "root", \&pam_conv_func))) { - print STDERR "PAM module available, but error during init !\n"; - print STDERR "Disabling PAM functions.\n"; - } - else { - $use_pam = 1; - } - } - -# check if the TCP-wrappers module is available -if ($config{'libwrap'}) { - eval "use Authen::Libwrap qw(hosts_ctl STRING_UNKNOWN)"; - if (!$@) { - $use_libwrap = 1; - } - } - -# Get miniserv's perl path and location -$miniserv_path = $0; -open(SOURCE, $miniserv_path); -<SOURCE> =~ /^#!(\S+)/; $perl_path = $1; -close(SOURCE); -@miniserv_argv = @ARGV; - -# Check vital config options -%vital = ("port", 80, - "root", "./", - "server", "MiniServ/0.01", - "index_docs", "index.html index.htm index.cgi", - "addtype_html", "text/html", - "addtype_txt", "text/plain", - "addtype_gif", "image/gif", - "addtype_jpg", "image/jpeg", - "addtype_jpeg", "image/jpeg", - "realm", "MiniServ", - "session_login", "/session_login.cgi" - ); -foreach $v (keys %vital) { - if (!$config{$v}) { - if ($vital{$v} eq "") { - die "Missing config option $v"; - } - $config{$v} = $vital{$v}; - } - } -if (!$config{'sessiondb'}) { - $config{'pidfile'} =~ /^(.*)\/[^\/]+$/; - $config{'sessiondb'} = "$1/sessiondb"; - } -die "Session authentication cannot be used in inetd mode" - if ($config{'inetd'} && $config{'session'}); - -# init days and months for http_date -@weekday = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" ); -@month = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ); - -# Change dir to the server root -chdir($config{'root'}); -$user_homedir = (getpwuid($<))[7]; - -# Read users file -if ($config{'userfile'}) { - open(USERS, $config{'userfile'}); - while(<USERS>) { - s/\r|\n//g; - local @user = split(/:/, $_); - $users{$user[0]} = $user[1]; - $certs{$user[0]} = $user[3] if ($user[3]); - if ($user[4] =~ /^allow\s+(.*)/) { - $allow{$user[0]} = [ &to_ipaddress(split(/\s+/, $1)) ]; - } - elsif ($user[4] =~ /^deny\s+(.*)/) { - $deny{$user[0]} = [ &to_ipaddress(split(/\s+/, $1)) ]; - } - } - close(USERS); - } - -# Setup SSL if possible and if requested -if ($use_ssl) { - $ssl_ctx = Net::SSLeay::CTX_new() || - die "Failed to create SSL context : $!"; - $client_certs = 0 if (!$config{'ca'} || !%certs); - if ($client_certs) { - Net::SSLeay::CTX_load_verify_locations( - $ssl_ctx, $config{'ca'}, ""); - Net::SSLeay::CTX_set_verify( - $ssl_ctx, &Net::SSLeay::VERIFY_PEER, \&verify_client); - } - - Net::SSLeay::CTX_use_RSAPrivateKey_file( - $ssl_ctx, $config{'keyfile'}, - &Net::SSLeay::FILETYPE_PEM) || die "Failed to open SSL key"; - Net::SSLeay::CTX_use_certificate_file( - $ssl_ctx, $config{'keyfile'}, - &Net::SSLeay::FILETYPE_PEM); - } - -# Setup syslog support if possible and if requested -if ($use_syslog) { - eval { openlog("miniserv", "cons,pid,ndelay", "daemon") }; - $use_syslog = 0 if ($@); - } - -# Read MIME types file and add extra types -if ($config{"mimetypes"} ne "") { - open(MIME, $config{"mimetypes"}); - while(<MIME>) { - chop; s/#.*$//; - if (/^(\S+)\s+(.*)$/) { - $type = $1; @exts = split(/\s+/, $2); - foreach $ext (@exts) { - $mime{$ext} = $type; - } - } - } - close(MIME); - } -foreach $k (keys %config) { - if ($k !~ /^addtype_(.*)$/) { next; } - $mime{$1} = $config{$k}; - } - -# get the time zone -if ($config{'log'}) { - local(@gmt, @lct, $days, $hours, $mins); - @make_date_marr = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"); - @gmt = gmtime(time()); - @lct = localtime(time()); - $days = $lct[3] - $gmt[3]; - $hours = ($days < -1 ? 24 : 1 < $days ? -24 : $days * 24) + - $lct[2] - $gmt[2]; - $mins = $hours * 60 + $lct[1] - $gmt[1]; - $timezone = ($mins < 0 ? "-" : "+"); $mins = abs($mins); - $timezone .= sprintf "%2.2d%2.2d", $mins/60, $mins%60; - } - -if ($config{'inetd'}) { - # We are being run from inetd - go direct to handling the request - $SIG{'HUP'} = 'IGNORE'; - $SIG{'TERM'} = 'DEFAULT'; - $SIG{'PIPE'} = 'DEFAULT'; - open(SOCK, "+>&STDIN"); - - # Check if it is time for the logfile to be cleared - if ($config{'logclear'}) { - local $write_logtime = 0; - local @st = stat("$config{'logfile'}.time"); - if (@st) { - if ($st[9]+$config{'logtime'}*60*60 < time()){ - # need to clear log - $write_logtime = 1; - unlink($config{'logfile'}); - } - } - else { $write_logtime = 1; } - if ($write_logtime) { - open(LOGTIME, ">$config{'logfile'}.time"); - print LOGTIME time(),"\n"; - close(LOGTIME); - } - } - - # Initialize SSL for this connection - if ($use_ssl) { - $ssl_con = Net::SSLeay::new($ssl_ctx); - Net::SSLeay::set_fd($ssl_con, fileno(SOCK)); - #Net::SSLeay::use_RSAPrivateKey_file( - # $ssl_con, $config{'keyfile'}, - # &Net::SSLeay::FILETYPE_PEM); - #Net::SSLeay::use_certificate_file( - # $ssl_con, $config{'keyfile'}, - # &Net::SSLeay::FILETYPE_PEM); - Net::SSLeay::accept($ssl_con) || exit; - } - - # Work out the hostname for this web server - if (!$config{'host'}) { - ($myport, $myaddr) = - unpack_sockaddr_in(getsockname(SOCK)); - $myname = gethostbyaddr($myaddr, AF_INET); - if ($myname eq "") { - $myname = inet_ntoa($myaddr); - } - $host = $myname; - } - else { $host = $config{'host'}; } - $port = $config{'port'}; - - while(&handle_request(getpeername(SOCK), getsockname(SOCK))) { } - close(SOCK); - exit; - } - -# Open main socket -$proto = getprotobyname('tcp'); -socket(MAIN, PF_INET, SOCK_STREAM, $proto) || - die "Failed to open main socket : $!"; -setsockopt(MAIN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)); -$baddr = $config{"bind"} ? inet_aton($config{"bind"}) : INADDR_ANY; -for($i=0; $i<5; $i++) { - last if (bind(MAIN, sockaddr_in($config{port}, $baddr))); - sleep(1); - } -die "Failed to bind port $config{port} : $!" if ($i == 5); -listen(MAIN, SOMAXCONN); - -if ($config{'listen'}) { - # Open the socket that allows other miniserv servers to find this one - $proto = getprotobyname('udp'); - if (socket(LISTEN, PF_INET, SOCK_DGRAM, $proto)) { - setsockopt(LISTEN, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)); - bind(LISTEN, sockaddr_in($config{'listen'}, INADDR_ANY)); - listen(LISTEN, SOMAXCONN); - } - else { - print STDERR "Failed to open listening socket : $!\n"; - $config{'listen'} = 0; - } - } - - -# Split from the controlling terminal -if (fork()) { exit; } -setsid(); - -# write out the PID file -open(PIDFILE, "> $config{'pidfile'}"); -printf PIDFILE "%d\n", getpid(); -close(PIDFILE); - -# Start the log-clearing process, if needed. This checks every minute -# to see if the log has passed its reset time, and if so clears it -if ($config{'logclear'}) { - if (!($logclearer = fork())) { - while(1) { - local $write_logtime = 0; - local @st = stat("$config{'logfile'}.time"); - if (@st) { - if ($st[9]+$config{'logtime'}*60*60 < time()){ - # need to clear log - $write_logtime = 1; - unlink($config{'logfile'}); - } - } - else { $write_logtime = 1; } - if ($write_logtime) { - open(LOGTIME, ">$config{'logfile'}.time"); - print LOGTIME time(),"\n"; - close(LOGTIME); - } - sleep(5*60); - } - exit; - } - push(@childpids, $logclearer); - } - -# Setup the logout time dbm if needed -if ($config{'session'}) { - eval "use SDBM_File"; - dbmopen(%sessiondb, $config{'sessiondb'}, 0700); - eval { $sessiondb{'1111111111'} = 'foo bar' }; - if ($@) { - dbmclose(%sessiondb); - eval "use NDBM_File"; - dbmopen(%sessiondb, $config{'sessiondb'}, 0700); - } - } - -# Run the main loop -$SIG{'HUP'} = 'miniserv::trigger_restart'; -$SIG{'TERM'} = 'miniserv::term_handler'; -$SIG{'PIPE'} = 'IGNORE'; -@deny = &to_ipaddress(split(/\s+/, $config{"deny"})); -@allow = &to_ipaddress(split(/\s+/, $config{"allow"})); -$p = 0; -while(1) { - # wait for a new connection, or a message from a child process - undef($rmask); - vec($rmask, fileno(MAIN), 1) = 1; - if ($config{'passdelay'} || $config{'session'}) { - for($i=0; $i<@passin; $i++) { - vec($rmask, fileno($passin[$i]), 1) = 1; - } - } - vec($rmask, fileno(LISTEN), 1) = 1 if ($config{'listen'}); - - local $sel = select($rmask, undef, undef, 10); - if ($need_restart) { &restart_miniserv(); } - local $time_now = time(); - - # Clean up finished processes - local($pid); - do { $pid = waitpid(-1, WNOHANG); - @childpids = grep { $_ != $pid } @childpids; - } while($pid > 0); - - # run the unblocking procedure to check if enough time has passed to - # unblock hosts that heve been blocked because of password failures - if ($config{'blockhost_failures'}) { - $i = 0; - while ($i <= $#deny) { - if ($blockhosttime{$deny[$i]} && $config{'blockhost_time'} != 0 && - ($time_now - $blockhosttime{$deny[$i]}) >= $config{'blockhost_time'}) { - # the host can be unblocked now - $hostfail{$deny[$i]} = 0; - splice(@deny, $i, 1); - } - $i++; - } - } - - if ($config{'session'}) { - # Remove sessions with more than 7 days of inactivity - foreach $s (keys %sessiondb) { - local ($user, $ltime) = split(/\s+/, $sessiondb{$s}); - if ($time_now - $ltime > 7*24*60*60) { - delete($sessiondb{$s}); - } - } - } - next if ($sel <= 0); - if (vec($rmask, fileno(MAIN), 1)) { - # got new connection - $acptaddr = accept(SOCK, MAIN); - if (!$acptaddr) { next; } - - # create pipes - if ($config{'passdelay'} || $config{'session'}) { - $PASSINr = "PASSINr$p"; $PASSINw = "PASSINw$p"; - $PASSOUTr = "PASSOUTr$p"; $PASSOUTw = "PASSOUTw$p"; - $p++; - pipe($PASSINr, $PASSINw); - pipe($PASSOUTr, $PASSOUTw); - select($PASSINw); $| = 1; select($PASSINr); $| = 1; - select($PASSOUTw); $| = 1; select($PASSOUTw); $| = 1; - } - select(STDOUT); - - # Check username of connecting user - local ($peerp, $peera) = unpack_sockaddr_in($acptaddr); - $localauth_user = undef; - if ($config{'localauth'} && inet_ntoa($peera) eq "127.0.0.1") { - if (open(TCP, "/proc/net/tcp")) { - # Get the info direct from the kernel - while(<TCP>) { - s/^\s+//; - local @t = split(/[\s:]+/, $_); - if ($t[1] eq '0100007F' && - $t[2] eq sprintf("%4.4X", $peerp)) { - $localauth_user = getpwuid($t[11]); - last; - } - } - close(TCP); - } - else { - # Call lsof for the info - local $lsofpid = open(LSOF, - "$config{'localauth'} -i TCP\@127.0.0.1:$peerp |"); - while(<LSOF>) { - if (/^(\S+)\s+(\d+)\s+(\S+)/ && - $2 != $$ && $2 != $lsofpid) { - $localauth_user = $3; - } - } - close(LSOF); - } - } - - # fork the subprocess - if (!($handpid = fork())) { - # setup signal handlers - $SIG{'TERM'} = 'DEFAULT'; - $SIG{'PIPE'} = 'DEFAULT'; - #$SIG{'CHLD'} = 'IGNORE'; - $SIG{'HUP'} = 'IGNORE'; - - # Initialize SSL for this connection - if ($use_ssl) { - $ssl_con = Net::SSLeay::new($ssl_ctx); - Net::SSLeay::set_fd($ssl_con, fileno(SOCK)); - #Net::SSLeay::use_RSAPrivateKey_file( - # $ssl_con, $config{'keyfile'}, - # &Net::SSLeay::FILETYPE_PEM); - #Net::SSLeay::use_certificate_file( - # $ssl_con, $config{'keyfile'}, - # &Net::SSLeay::FILETYPE_PEM); - Net::SSLeay::accept($ssl_con) || exit; - } - - # close useless pipes - if ($config{'passdelay'} || $config{'session'}) { - foreach $p (@passin) { close($p); } - foreach $p (@passout) { close($p); } - close($PASSINr); close($PASSOUTw); - } - close(MAIN); - - # Work out the hostname for this web server - if (!$config{'host'}) { - ($myport, $myaddr) = - unpack_sockaddr_in(getsockname(SOCK)); - $myname = gethostbyaddr($myaddr, AF_INET); - if ($myname eq "") { - $myname = inet_ntoa($myaddr); - } - $host = $myname; - } - else { $host = $config{'host'}; } - $port = $config{'port'}; - - local $switched = 0; - if ($config{'remoteuser'} && $localauth_user && !$<) { - # Switch to the UID of the remote user - local @u = getpwnam($localauth_user); - if (@u) { - $( = $u[3]; $) = "$u[3] $u[3]"; - $< = $> = $u[2]; - $switched = 1; - } - } - if ($config{'switchuser'} && !$< && !$switched) { - # Switch to the UID of server user - local @u = getpwnam($config{'switchuser'}); - if (@u) { - $( = $u[3]; $) = "$u[3] $u[3]"; - $< = $> = $u[2]; - } - } - - while(&handle_request($acptaddr, getsockname(SOCK))) { } - shutdown(SOCK, 1); - close(SOCK); - close($PASSINw); close($PASSOUTw); - exit; - } - push(@childpids, $handpid); - if ($config{'passdelay'} || $config{'session'}) { - close($PASSINw); close($PASSOUTr); - push(@passin, $PASSINr); push(@passout, $PASSOUTw); - } - close(SOCK); - } - - if ($config{'listen'} && vec($rmask, fileno(LISTEN), 1)) { - # Got UDP packet from another miniserv server - local $rcvbuf; - local $from = recv(LISTEN, $rcvbuf, 1024, 0); - next if (!$from); - local $fromip = inet_ntoa((unpack_sockaddr_in($from))[1]); - local $toip = inet_ntoa((unpack_sockaddr_in( - getsockname(LISTEN)))[1]); - if ((!@deny || !&ip_match($fromip, $toip, @deny)) && - (!@allow || &ip_match($fromip, $toip, @allow))) { - send(LISTEN, "$config{'host'}:$config{'port'}:". - "$use_ssl", 0, $from); - } - } - - # check for password-timeout messages from subprocesses - for($i=0; $i<@passin; $i++) { - if (vec($rmask, fileno($passin[$i]), 1)) { - # this sub-process is asking about a password - $infd = $passin[$i]; $outfd = $passout[$i]; - $inline = <$infd>; - if ($inline =~ /^delay\s+(\S+)\s+(\S+)\s+(\d+)/) { - # Got a delay request from a subprocess.. for - # valid logins, there is no delay (to prevent - # denial of service attacks), but for invalid - # logins the delay increases with each failed - # attempt. - if ($3) { - # login OK.. no delay - print $outfd "0 0\n"; - $hostfail{$2} = 0; - } - else { - # login failed.. - $hostfail{$2}++; - # add the host to the block list if necessary - if ($config{'blockhost_failures'} && - $hostfail{$2} >= $config{'blockhost_failures'}) { - push(@deny, $2); - $blockhosttime{$2} = $time_now; - $blocked = 1; - if ($use_syslog) { - local $logtext = "Security alert: Host $2 ". - "blocked after $config{'blockhost_failures'} ". - "failed logins for user $1"; - syslog("crit", $logtext); - } - } - else { - $blocked = 0; - } - $dl = $userdlay{$1} - - int(($time_now - $userlast{$1})/50); - $dl = $dl < 0 ? 0 : $dl+1; - print $outfd "$dl $blocked\n"; - $userdlay{$1} = $dl; - } - $userlast{$1} = $time_now; - } - elsif ($inline =~ /^verify\s+(\S+)/) { - # Verifying a session ID - local $session_id = $1; - if (!defined($sessiondb{$session_id})) { - print $outfd "0 0\n"; - } - else { - local ($user, $ltime) = split(/\s+/, $sessiondb{$session_id}); - if ($config{'logouttime'} && - $time_now - $ltime > $config{'logouttime'}*60) { - print $outfd "1 ",$time_now - $ltime,"\n"; - delete($sessiondb{$session_id}); - } - else { - print $outfd "2 $user\n"; - $sessiondb{$session_id} = "$user $time_now"; - } - } - } - elsif ($inline =~ /^new\s+(\S+)\s+(\S+)/) { - # Creating a new session - $sessiondb{$1} = "$2 $time_now"; - } - elsif ($inline =~ /^delete\s+(\S+)/) { - # Logging out a session - print $outfd $sessiondb{$1} ? 1 : 0,"\n"; - delete($sessiondb{$1}); - } - else { - # close pipe - close($infd); close($outfd); - $passin[$i] = $passout[$i] = undef; - } - } - } - @passin = grep { defined($_) } @passin; - @passout = grep { defined($_) } @passout; - } - -# handle_request(remoteaddress, localaddress) -# Where the real work is done -sub handle_request -{ -$acptip = inet_ntoa((unpack_sockaddr_in($_[0]))[1]); -$localip = $_[1] ? inet_ntoa((unpack_sockaddr_in($_[1]))[1]) : undef; -if ($config{'loghost'}) { - $acpthost = gethostbyaddr(inet_aton($acptip), AF_INET); - $acpthost = $acptip if (!$acpthost); - } -else { - $acpthost = $acptip; - } -$datestr = &http_date(time()); -$ok_code = 200; -$ok_message = "Document follows"; - -# Wait at most 60 secs for start of headers (but only for the first time) -if (!$checked_timeout) { - local $rmask; - vec($rmask, fileno(SOCK), 1) = 1; - local $sel = select($rmask, undef, undef, 60); - $sel || &http_error(400, "Timeout"); - $checked_timeout++; - } - -# Read the HTTP request and headers -($reqline = &read_line()) =~ s/\r|\n//g; -if (!($reqline =~ /^(GET|POST|HEAD)\s+(.*)\s+HTTP\/1\..$/)) { - &http_error(400, "Bad Request"); - } -$method = $1; $request_uri = $page = $2; -%header = (); -local $lastheader; -while(1) { - ($headline = &read_line()) =~ s/\r|\n//g; - last if ($headline eq ""); - if ($headline =~ /^(\S+):\s+(.*)$/) { - $header{$lastheader = lc($1)} = $2; - } - elsif ($headline =~ /^\s+(.*)$/) { - $header{$lastheader} .= $headline; - } - else { - &http_error(400, "Bad Header $headline"); - } - } -if (defined($header{'host'})) { - if ($header{'host'} =~ /^([^:]+):([0-9]+)$/) { $host = $1; $port = $2; } - else { $host = $header{'host'}; } - } -undef(%in); -if ($page =~ /^([^\?]+)\?(.*)$/) { - # There is some query string information - $page = $1; - $querystring = $2; - if ($querystring !~ /=/) { - $queryargs = $querystring; - $queryargs =~ s/\+/ /g; - $queryargs =~ s/%(..)/pack("c",hex($1))/ge; - $querystring = ""; - } - else { - # Parse query-string parameters - local @in = split(/\&/, $querystring); - foreach $i (@in) { - local ($k, $v) = split(/=/, $i, 2); - $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge; - $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge; - $in{$k} = $v; - } - } - } -$posted_data = undef; -if ($method eq 'POST' && - $header{'content-type'} eq 'application/x-www-form-urlencoded') { - # Read in posted query string information - $clen = $header{"content-length"}; - while(length($posted_data) < $clen) { - $buf = &read_data($clen - length($posted_data)); - if (!length($buf)) { - &http_error(500, "Failed to read POST request"); - } - $posted_data .= $buf; - } - local @in = split(/\&/, $posted_data); - foreach $i (@in) { - local ($k, $v) = split(/=/, $i, 2); - $k =~ s/\+/ /g; $k =~ s/%(..)/pack("c",hex($1))/ge; - $v =~ s/\+/ /g; $v =~ s/%(..)/pack("c",hex($1))/ge; - $in{$k} = $v; - } - } - -# replace %XX sequences in page -$page =~ s/%(..)/pack("c",hex($1))/ge; - -# check address against access list -if (@deny && &ip_match($acptip, $localip, @deny) || - @allow && !&ip_match($acptip, $localip, @allow)) { - &http_error(403, "Access denied for $acptip"); - return 0; - } - -if ($use_libwrap) { - # Check address with TCP-wrappers - if (!hosts_ctl("miniserv", STRING_UNKNOWN, $acptip, STRING_UNKNOWN)) { - &http_error(403, "Access denied for $acptip"); - return 0; - } - } - -# check for the logout flag file, and if existant deny authentication -if ($config{'logout'} && -r $config{'logout'}.$in{'miniserv_logout_id'}) { - $deny_authentication++; - open(LOGOUT, $config{'logout'}.$in{'miniserv_logout_id'}); - chop($count = <LOGOUT>); - close(LOGOUT); - $count--; - if ($count > 0) { - open(LOGOUT, ">$config{'logout'}$in{'miniserv_logout_id'}"); - print LOGOUT "$count\n"; - close(LOGOUT); - } - else { - unlink($config{'logout'}.$in{'miniserv_logout_id'}); - } - } - -# Check for password if needed -if (%users) { - $validated = 0; - $blocked = 0; - - # Session authentication is never used for connections by - # another miniserv server - if ($header{'user-agent'} =~ /miniserv/i) { - $config{'session'} = 0; - } - - # check for SSL authentication - if ($use_ssl && $verified_client) { - $peername = Net::SSLeay::X509_NAME_oneline( - Net::SSLeay::X509_get_subject_name( - Net::SSLeay::get_peer_certificate( - $ssl_con))); - foreach $u (keys %certs) { - if ($certs{$u} eq $peername) { - $authuser = $u; - $validated = 2; - last; - } - } - } - - # Check for normal HTTP authentication - if (!$validated && !$deny_authentication && !$config{'session'} && - $header{authorization} =~ /^basic\s+(\S+)$/i) { - # authorization given.. - ($authuser, $authpass) = split(/:/, &b64decode($1)); - $validated = &validate_user($authuser, $authpass); - - if ($config{'passdelay'} && !$config{'inetd'}) { - # check with main process for delay - print $PASSINw "delay $authuser $acptip $validated\n"; - <$PASSOUTr> =~ /(\d+) (\d+)/; - $blocked = $2; - sleep($1); - } - } - - # Check for new session validation - if ($config{'session'} && !$deny_authentication && $page eq $config{'session_login'}) { - local $ok = &validate_user($in{'user'}, $in{'pass'}); - - # check if the test cookie is set - if ($header{'cookie'} !~ /testing=1/ && $in{'user'}) { - &http_error(500, "No cookies", - "Your browser does not support cookies, ". - "which are required for Webmin to work in ". - "session authentication mode"); - } - - # check with main process for delay - if ($config{'passdelay'} && $in{'user'}) { - print $PASSINw "delay $in{'user'} $acptip $ok\n"; - <$PASSOUTr> =~ /(\d+) (\d+)/; - $blocked = $2; - sleep($1); - } - - if ($ok) { - # Logged in OK! Tell the main process about the new SID - local $sid = time(); - local $mul = 1; - foreach $c (split(//, crypt($in{'pass'}, substr($$, -2)))) { - $sid += ord($c) * $mul; - $mul *= 3; - } - print $PASSINw "new $sid $in{'user'}\n"; - - # Set cookie and redirect - &write_data("HTTP/1.0 302 Moved Temporarily\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{'server'}\r\n"); - $portstr = $port == 80 && !$use_ssl ? "" : - $port == 443 && $use_ssl ? "" : ":$port"; - $prot = $use_ssl ? "https" : "http"; - if ($in{'save'}) { - &write_data("Set-Cookie: sid=$sid; path=/; expires=\"Fri, 1-Jan-2038 00:00:01\"\r\n"); - } - else { - &write_data("Set-Cookie: sid=$sid; path=/\r\n"); - } - &write_data("Location: $prot://$host$portstr$in{'page'}\r\n"); - &write_keep_alive(0); - &write_data("\r\n"); - &log_request($acpthost, $authuser, $reqline, 302, 0); - return 0; - } - elsif ($in{'logout'} && $header{'cookie'} =~ /sid=(\d+)/) { - # Logout clicked .. remove the session - print $PASSINw "delete $1\n"; - local $dummy = <$PASSINr>; - $logout = 1; - $already_session_id = undef; - } - else { - # Login failed .. display the form again - $failed_user = $in{'user'}; - $request_uri = $in{'page'}; - $already_session_id = undef; - } - } - - # Check for an existing session - if ($config{'session'} && !$validated) { - if ($already_session_id) { - $session_id = $already_session_id; - $authuser = $already_authuser; - $validated = 1; - } - elsif (!$deny_authentication && $header{'cookie'} =~ /sid=(\d+)/) { - $session_id = $1; - print $PASSINw "verify $session_id\n"; - <$PASSOUTr> =~ /(\d+)\s+(\S+)/; - if ($1 == 2) { - # Valid session continuation - $validated = 1; - $authuser = $2; - $already_session_id = $session_id; - $already_authuser = $authuser; - } - elsif ($1 == 1) { - # Session timed out - $timed_out = $2; - } - else { - # Invalid session ID .. don't set verified - } - } - } - - # Check for local authentication - if ($localauth_user) { - if (defined($users{$localauth_user})) { - $validated = 1; - $authuser = $localauth_user; - } - else { - $localauth_user = undef; - } - } - - if (!$validated) { - if ($blocked == 0) { - # No password given.. ask - if ($config{'session'}) { - # Force CGI for session login - $validated = 1; - if ($logout) { - $querystring .= "&logout=1&page=/"; - } - else { - $querystring = "page=".&urlize($request_uri); - } - $querystring .= "&failed=$failed_user" if ($failed_user); - $querystring .= "&timed_out=$timed_out" if ($timed_out); - $queryargs = ""; - $page = $config{'session_login'}; - } - else { - # Ask for login with HTTP authentication - &write_data("HTTP/1.0 401 Unauthorized\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{'server'}\r\n"); - &write_data("WWW-authenticate: Basic ". - "realm=\"$config{'realm'}\"\r\n"); - &write_keep_alive(0); - &write_data("Content-type: text/html\r\n"); - &write_data("\r\n"); - &reset_byte_count(); - &write_data("<html>\n"); - &write_data("<head><title>Unauthorized</title></head>\n"); - &write_data("<body><h1>Unauthorized</h1>\n"); - &write_data("A password is required to access this\n"); - &write_data("web server. Please try again. <p>\n"); - &write_data("</body></html>\n"); - &log_request($acpthost, undef, $reqline, 401, &byte_count()); - return 0; - } - } - else { - # when the host has been blocked, give it an error message - &http_error(403, "Access denied for $acptip. The host has been blocked " - ."because of too many authentication failures."); - } - } - - # Check per-user IP access control - if ($deny{$authuser} && &ip_match($acptip, $localip, @{$deny{$authuser}}) || - $allow{$authuser} && !&ip_match($acptip, $localip, @{$allow{$authuser}})) { - &http_error(403, "Access denied for $acptip"); - return 0; - } - } - -# Figure out what kind of page was requested -rerun: -$simple = &simplify_path($page, $bogus); -$simple =~ s/[\000-\037]//g; -if ($bogus) { - &http_error(400, "Invalid path"); - } -undef($full); -if ($config{'preroot'}) { - # Look in the template root directory first - $is_directory = 1; - $sofar = ""; - $full = $config{"preroot"} . $sofar; - $scriptname = $simple; - foreach $b (split(/\//, $simple)) { - if ($b ne "") { $sofar .= "/$b"; } - $full = $config{"preroot"} . $sofar; - @st = stat($full); - if (!@st) { undef($full); last; } - - # Check if this is a directory - if (-d $full) { - # It is.. go on parsing - $is_directory = 1; - next; - } - else { $is_directory = 0; } - - # Check if this is a CGI program - if (&get_type($full) eq "internal/cgi") { - $pathinfo = substr($simple, length($sofar)); - $pathinfo .= "/" if ($page =~ /\/$/); - $scriptname = $sofar; - last; - } - } - if ($full) { - if ($sofar eq '') { - $cgi_pwd = $config{'root'}; - } - else { - "$config{'root'}$sofar" =~ /^(.*\/)[^\/]+$/; - $cgi_pwd = $1; - } - if ($is_directory) { - # Check for index files in the directory - foreach $idx (split(/\s+/, $config{"index_docs"})) { - $idxfull = "$full/$idx"; - if (-r $idxfull && !(-d $idxfull)) { - $full = $idxfull; - $is_directory = 0; - $scriptname .= "/" - if ($scriptname ne "/"); - last; - } - } - } - } - } -if (!$full || $is_directory) { - $sofar = ""; - $full = $config{"root"} . $sofar; - $scriptname = $simple; - foreach $b (split(/\//, $simple)) { - if ($b ne "") { $sofar .= "/$b"; } - $full = $config{"root"} . $sofar; - @st = stat($full); - if (!@st) { &http_error(404, "File not found"); } - - # Check if this is a directory - if (-d $full) { - # It is.. go on parsing - next; - } - - # Check if this is a CGI program - if (&get_type($full) eq "internal/cgi") { - $pathinfo = substr($simple, length($sofar)); - $pathinfo .= "/" if ($page =~ /\/$/); - $scriptname = $sofar; - last; - } - } - $full =~ /^(.*\/)[^\/]+$/; $cgi_pwd = $1; - } - -# check filename against denyfile regexp -local $denyfile = $config{'denyfile'}; -if ($denyfile && $full =~ /$denyfile/) { - &http_error(403, "Access denied to $page"); - return 0; - } - -# Reached the end of the path OK.. see what we've got -if (-d $full) { - # See if the URL ends with a / as it should - if ($page !~ /\/$/) { - # It doesn't.. redirect - &write_data("HTTP/1.0 302 Moved Temporarily\r\n"); - $portstr = $port == 80 && !$use_ssl ? "" : - $port == 443 && $use_ssl ? "" : ":$port"; - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - $prot = $use_ssl ? "https" : "http"; - &write_data("Location: $prot://$host$portstr$page/\r\n"); - &write_keep_alive(0); - &write_data("\r\n"); - &log_request($acpthost, $authuser, $reqline, 302, 0); - return 0; - } - # A directory.. check for index files - foreach $idx (split(/\s+/, $config{"index_docs"})) { - $idxfull = "$full/$idx"; - if (-r $idxfull && !(-d $idxfull)) { - $cgi_pwd = $full; - $full = $idxfull; - $scriptname .= "/" if ($scriptname ne "/"); - last; - } - } - } -if (-d $full) { - # This is definately a directory.. list it - &write_data("HTTP/1.0 $ok_code $ok_message\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_data("Content-type: text/html\r\n"); - &write_keep_alive(0); - &write_data("\r\n"); - &reset_byte_count(); - &write_data("<h1>Index of $simple</h1>\n"); - &write_data("<pre>\n"); - &write_data(sprintf "%-35.35s %-20.20s %-10.10s\n", - "Name", "Last Modified", "Size"); - &write_data("<hr>\n"); - opendir(DIR, $full); - while($df = readdir(DIR)) { - if ($df =~ /^\./) { next; } - (@stbuf = stat("$full/$df")) || next; - if (-d "$full/$df") { $df .= "/"; } - @tm = localtime($stbuf[9]); - $fdate = sprintf "%2.2d/%2.2d/%4.4d %2.2d:%2.2d:%2.2d", - $tm[3],$tm[4]+1,$tm[5]+1900, - $tm[0],$tm[1],$tm[2]; - $len = length($df); $rest = " "x(35-$len); - &write_data(sprintf - "<a href=\"%s\">%-${len}.${len}s</a>$rest %-20.20s %-10.10s\n", - $df, $df, $fdate, $stbuf[7]); - } - closedir(DIR); - &log_request($acpthost, $authuser, $reqline, $ok_code, &byte_count()); - return 0; - } - -# CGI or normal file -local $rv; -if (&get_type($full) eq "internal/cgi") { - # A CGI program to execute - $envtz = $ENV{"TZ"}; - $envuser = $ENV{"USER"}; - $envpath = $ENV{"PATH"}; - foreach (keys %ENV) { delete($ENV{$_}); } - $ENV{"PATH"} = $envpath if ($envpath); - $ENV{"TZ"} = $envtz if ($envtz); - $ENV{"USER"} = $envuser if ($envuser); - $ENV{"HOME"} = $user_homedir; - $ENV{"SERVER_SOFTWARE"} = $config{"server"}; - $ENV{"SERVER_NAME"} = $host; - $ENV{"SERVER_ADMIN"} = $config{"email"}; - $ENV{"SERVER_ROOT"} = $config{"root"}; - $ENV{"SERVER_PORT"} = $port; - $ENV{"REMOTE_HOST"} = $acpthost; - $ENV{"REMOTE_ADDR"} = $acptip; - $ENV{"REMOTE_USER"} = $authuser if (defined($authuser)); - $ENV{"SSL_USER"} = $peername if ($validated == 2); - $ENV{"DOCUMENT_ROOT"} = $config{"root"}; - $ENV{"GATEWAY_INTERFACE"} = "CGI/1.1"; - $ENV{"SERVER_PROTOCOL"} = "HTTP/1.0"; - $ENV{"REQUEST_METHOD"} = $method; - $ENV{"SCRIPT_NAME"} = $scriptname; - $ENV{"REQUEST_URI"} = $request_uri; - $ENV{"PATH_INFO"} = $pathinfo; - $ENV{"PATH_TRANSLATED"} = "$config{root}/$pathinfo"; - $ENV{"QUERY_STRING"} = $querystring; - $ENV{"MINISERV_CONFIG"} = $conf; - $ENV{"HTTPS"} = "ON" if ($use_ssl); - $ENV{"SESSION_ID"} = $session_id if ($session_id); - $ENV{"LOCAL_USER"} = $localauth_user if ($localauth_user); - if (defined($header{"content-length"})) { - $ENV{"CONTENT_LENGTH"} = $header{"content-length"}; - } - if (defined($header{"content-type"})) { - $ENV{"CONTENT_TYPE"} = $header{"content-type"}; - } - foreach $h (keys %header) { - ($hname = $h) =~ tr/a-z/A-Z/; - $hname =~ s/\-/_/g; - $ENV{"HTTP_$hname"} = $header{$h}; - } - $ENV{"PWD"} = $cgi_pwd; - foreach $k (keys %config) { - if ($k =~ /^env_(\S+)$/) { - $ENV{$1} = $config{$k}; - } - } - delete($ENV{'HTTP_AUTHORIZATION'}); - $ENV{'HTTP_COOKIE'} =~ s/;?\s*sid=(\d+)//; - - # Check if the CGI can be handled internally - open(CGI, $full); - local $first = <CGI>; - close(CGI); - $first =~ s/[#!\r\n]//g; - $nph_script = ($full =~ /\/nph-([^\/]+)$/); - if (!$config{'forkcgis'} && $first eq $perl_path && $] >= 5.004) { - # setup environment for eval - chdir($ENV{"PWD"}); - @ARGV = split(/\s+/, $queryargs); - $0 = $full; - if ($posted_data) { - # Already read the post input - $postinput = $posted_data; - } - elsif ($method eq "POST") { - $clen = $header{"content-length"}; - while(length($postinput) < $clen) { - $buf = &read_data($clen - length($postinput)); - if (!length($buf)) { - &http_error(500, "Failed to read ". - "POST request"); - } - $postinput .= $buf; - } - } - $SIG{'CHLD'} = 'DEFAULT'; - eval { - # Have SOCK closed if the perl exec's something - use Fcntl; - fcntl(SOCK, F_SETFD, FD_CLOEXEC); - }; - shutdown(SOCK, 0); - - if ($config{'log'}) { - open(MINISERVLOG, ">>$config{'logfile'}"); - chmod(0600, $config{'logfile'}); - } - $doing_eval = 1; - eval { - package main; - tie(*STDOUT, 'miniserv'); - tie(*STDIN, 'miniserv'); - do $miniserv::full; - die $@ if ($@); - }; - $doing_eval = 0; - if ($@) { - # Error in perl! - &http_error(500, "Perl execution failed", $@); - } - elsif (!$doneheaders && !$nph_script) { - &http_error(500, "Missing Headers"); - } - #close(SOCK); - $rv = 0; - } - else { - # fork the process that actually executes the CGI - pipe(CGIINr, CGIINw); - pipe(CGIOUTr, CGIOUTw); - pipe(CGIERRr, CGIERRw); - if (!($cgipid = fork())) { - chdir($ENV{"PWD"}); - close(SOCK); - open(STDIN, "<&CGIINr"); - open(STDOUT, ">&CGIOUTw"); - open(STDERR, ">&CGIERRw"); - close(CGIINw); close(CGIOUTr); close(CGIERRr); - exec($full, split(/\s+/, $queryargs)); - print STDERR "Failed to exec $full : $!\n"; - exit; - } - close(CGIINr); close(CGIOUTw); close(CGIERRw); - - # send post data - if ($posted_data) { - # already read the posted data - print CGIINw $posted_data; - } - elsif ($method eq "POST") { - $got = 0; $clen = $header{"content-length"}; - while($got < $clen) { - $buf = &read_data($clen-$got); - if (!length($buf)) { - kill('TERM', $cgipid); - &http_error(500, "Failed to read ". - "POST request"); - } - $got += length($buf); - print CGIINw $buf; - } - } - close(CGIINw); - shutdown(SOCK, 0); - - if (!$nph_script) { - # read back cgi headers - select(CGIOUTr); $|=1; select(STDOUT); - $got_blank = 0; - while(1) { - $line = <CGIOUTr>; - $line =~ s/\r|\n//g; - if ($line eq "") { - if ($got_blank || %cgiheader) { last; } - $got_blank++; - next; - } - ($line =~ /^(\S+):\s+(.*)$/) || - &http_error(500, "Bad Header", - &read_errors(CGIERRr)); - $cgiheader{lc($1)} = $2; - } - if ($cgiheader{"location"}) { - &write_data("HTTP/1.0 302 Moved Temporarily\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{'server'}\r\n"); - &write_keep_alive(0); - # ignore the rest of the output. This is a hack, but - # is necessary for IE in some cases :( - close(CGIOUTr); close(CGIERRr); - } - elsif ($cgiheader{"content-type"} eq "") { - &http_error(500, "Missing Content-Type Header", - &read_errors(CGIERRr)); - } - else { - &write_data("HTTP/1.0 $ok_code $ok_message\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{'server'}\r\n"); - &write_keep_alive(0); - } - foreach $h (keys %cgiheader) { - &write_data("$h: $cgiheader{$h}\r\n"); - } - &write_data("\r\n"); - } - &reset_byte_count(); - while($line = <CGIOUTr>) { - &write_data($line); - } - close(CGIOUTr); close(CGIERRr); - $rv = 0; - } - } -else { - # A file to output - local @st = stat($full); - open(FILE, $full) || &http_error(404, "Failed to open file"); - &write_data("HTTP/1.0 $ok_code $ok_message\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_data("Content-type: ".&get_type($full)."\r\n"); - &write_data("Content-length: $st[7]\r\n"); - &write_data("Last-Modified: ".&http_date($st[9])."\r\n"); - &write_keep_alive(); - &write_data("\r\n"); - &reset_byte_count(); - while(read(FILE, $buf, 1024) > 0) { - &write_data($buf); - } - close(FILE); - $rv = &check_keep_alive(); - } - -# log the request -&log_request($acpthost, $authuser, $reqline, - $cgiheader{"location"} ? "302" : $ok_code, &byte_count()); -return $rv; -} - -# http_error(code, message, body, [dontexit]) -sub http_error -{ -close(CGIOUT); -local $eh = $error_handler_recurse ? undef : - $config{"error_handler_$_[0]"} ? $config{"error_handler_$_[0]"} : - $config{'error_handler'} ? $config{'error_handler'} : undef; -if ($eh) { - # Call a CGI program for the error - $page = "/$eh"; - $querystring = "code=$_[0]&message=".&urlize($_[1]). - "&body=".&urlize($_[2]); - $error_handler_recurse++; - $ok_code = $_[0]; - $ok_message = $_[1]; - goto rerun; - } -else { - # Use the standard error message display - &write_data("HTTP/1.0 $_[0] $_[1]\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Content-type: text/html\r\n"); - &write_keep_alive(0); - &write_data("\r\n"); - &reset_byte_count(); - &write_data("<h1>Error - $_[1]</h1>\n"); - if ($_[2]) { - &write_data("<pre>$_[2]</pre>\n"); - } - } -&log_request($acpthost, $authuser, $reqline, $_[0], &byte_count()) - if ($reqline); -shutdown(SOCK, 1); -exit if (!$_[3]); -} - -sub get_type -{ -if ($_[0] =~ /\.([A-z0-9]+)$/) { - $t = $mime{$1}; - if ($t ne "") { - return $t; - } - } -return "text/plain"; -} - -# simplify_path(path, bogus) -# Given a path, maybe containing stuff like ".." and "." convert it to a -# clean, absolute form. -sub simplify_path -{ -local($dir, @bits, @fixedbits, $b); -$dir = $_[0]; -$dir =~ s/^\/+//g; -$dir =~ s/\/+$//g; -@bits = split(/\/+/, $dir); -@fixedbits = (); -$_[1] = 0; -foreach $b (@bits) { - if ($b eq ".") { - # Do nothing.. - } - elsif ($b eq "..") { - # Remove last dir - if (scalar(@fixedbits) == 0) { - $_[1] = 1; - return "/"; - } - pop(@fixedbits); - } - else { - # Add dir to list - push(@fixedbits, $b); - } - } -return "/" . join('/', @fixedbits); -} - -# b64decode(string) -# Converts a string from base64 format to normal -sub b64decode -{ - local($str) = $_[0]; - local($res); - $str =~ tr|A-Za-z0-9+=/||cd; - $str =~ s/=+$//; - $str =~ tr|A-Za-z0-9+/| -_|; - while ($str =~ /(.{1,60})/gs) { - my $len = chr(32 + length($1)*3/4); - $res .= unpack("u", $len . $1 ); - } - return $res; -} - -# ip_match(remoteip, localip, [match]+) -# Checks an IP address against a list of IPs, networks and networks/masks -sub ip_match -{ -local(@io, @mo, @ms, $i, $j); -@io = split(/\./, $_[0]); -local $hn; -if (!defined($hn = $ip_match_cache{$_[0]})) { - $hn = gethostbyaddr(inet_aton($_[0]), AF_INET); - $hn = "" if ((&to_ipaddress($hn))[0] ne $_[0]); - $ip_match_cache{$_[0]} = $hn; - } -for($i=2; $i<@_; $i++) { - local $mismatch = 0; - if ($_[$i] =~ /^(\S+)\/(\S+)$/) { - # Compare with network/mask - @mo = split(/\./, $1); @ms = split(/\./, $2); - for($j=0; $j<4; $j++) { - if ((int($io[$j]) & int($ms[$j])) != int($mo[$j])) { - $mismatch = 1; - } - } - } - elsif ($_[$i] =~ /^\*(\S+)$/) { - # Compare with hostname regexp - $mismatch = 1 if ($hn !~ /$1$/); - } - elsif ($_[$i] eq 'LOCAL') { - # Compare with local network - local @lo = split(/\./, $_[1]); - if ($lo[0] < 128) { - $mismatch = 1 if ($lo[0] != $io[0]); - } - elsif ($lo[0] < 192) { - $mismatch = 1 if ($lo[0] != $io[0] || - $lo[1] != $io[1]); - } - else { - $mismatch = 1 if ($lo[0] != $io[0] || - $lo[1] != $io[1] || - $lo[2] != $io[2]); - } - } - else { - # Compare with IP or network - @mo = split(/\./, $_[$i]); - while(@mo && !$mo[$#mo]) { pop(@mo); } - for($j=0; $j<@mo; $j++) { - if ($mo[$j] != $io[$j]) { - $mismatch = 1; - } - } - } - return 1 if (!$mismatch); - } -return 0; -} - -# restart_miniserv() -# Called when a SIGHUP is received to restart the web server. This is done -# by exec()ing perl with the same command line as was originally used -sub restart_miniserv -{ -close(SOCK); close(MAIN); -foreach $p (@passin) { close($p); } -foreach $p (@passout) { close($p); } -if ($logclearer) { kill('TERM', $logclearer); } -exec($perl_path, $miniserv_path, @miniserv_argv); -die "Failed to restart miniserv with $perl_path $miniserv_path"; -} - -sub trigger_restart -{ -$need_restart = 1; -} - -sub to_ipaddress -{ -local (@rv, $i); -foreach $i (@_) { - if ($i =~ /(\S+)\/(\S+)/ || $i =~ /^\*\S+$/ || - $i eq 'LOCAL') { push(@rv, $i); } - else { push(@rv, join('.', unpack("CCCC", inet_aton($i)))); } - } -return @rv; -} - -# read_line() -# Reads one line from SOCK or SSL -sub read_line -{ -local($idx, $more, $rv); -if ($use_ssl) { - while(($idx = index($read_buffer, "\n")) < 0) { - # need to read more.. - if (!($more = Net::SSLeay::read($ssl_con))) { - # end of the data - $rv = $read_buffer; - undef($read_buffer); - return $rv; - } - $read_buffer .= $more; - } - $rv = substr($read_buffer, 0, $idx+1); - $read_buffer = substr($read_buffer, $idx+1); - return $rv; - } -else { return <SOCK>; } -} - -# read_data(length) -# Reads up to some amount of data from SOCK or the SSL connection -sub read_data -{ -if ($use_ssl) { - local($rv); - if (length($read_buffer)) { - $rv = $read_buffer; - undef($read_buffer); - return $rv; - } - else { - return Net::SSLeay::read($ssl_con, $_[0]); - } - } -else { - local $buf; - read(SOCK, $buf, $_[0]) || return undef; - return $buf; - } -} - -# write_data(data) -# Writes a string to SOCK or the SSL connection -sub write_data -{ -if ($use_ssl) { - Net::SSLeay::write($ssl_con, $_[0]); - } -else { - syswrite(SOCK, $_[0], length($_[0])); - } -$write_data_count += length($_[0]); -} - -# reset_byte_count() -sub reset_byte_count { $write_data_count = 0; } - -# byte_count() -sub byte_count { return $write_data_count; } - -# log_request(hostname, user, request, code, bytes) -sub log_request -{ -if ($config{'log'}) { - local(@tm, $dstr, $user, $ident, $headers); - if ($config{'logident'}) { - # add support for rfc1413 identity checking here - } - else { $ident = "-"; } - @tm = localtime(time()); - $dstr = sprintf "%2.2d/%s/%4.4d:%2.2d:%2.2d:%2.2d %s", - $tm[3], $make_date_marr[$tm[4]], $tm[5]+1900, - $tm[2], $tm[1], $tm[0], $timezone; - $user = $_[1] ? $_[1] : "-"; - if (fileno(MINISERVLOG)) { - seek(MINISERVLOG, 0, 2); - } - else { - open(MINISERVLOG, ">>$config{'logfile'}"); - chmod(0600, $config{'logfile'}); - } - foreach $h (split(/\s+/, $config{'logheaders'})) { - $headers .= " $h=\"$header{$h}\""; - } - print MINISERVLOG "$_[0] $ident $user [$dstr] \"$_[2]\" ", - "$_[3] $_[4]$headers\n"; - close(MINISERVLOG); - } -} - -# read_errors(handle) -# Read and return all input from some filehandle -sub read_errors -{ -local($fh, $_, $rv); -$fh = $_[0]; -while(<$fh>) { $rv .= $_; } -return $rv; -} - -sub write_keep_alive -{ -local $mode; -if (@_) { $mode = $_[0]; } -else { $mode = &check_keep_alive(); } -&write_data("Connection: ".($mode ? "Keep-Alive" : "close")."\r\n"); -} - -sub check_keep_alive -{ -return $header{'connection'} =~ /keep-alive/i; -} - -sub term_handler -{ -if (@childpids) { - kill('TERM', @childpids); - } -exit(1); -} - -sub http_date -{ -local @tm = gmtime($_[0]); -return sprintf "%s, %d %s %d %2.2d:%2.2d:%2.2d GMT", - $weekday[$tm[6]], $tm[3], $month[$tm[4]], $tm[5]+1900, - $tm[2], $tm[1], $tm[0]; -} - -sub TIEHANDLE -{ -my $i; bless \$i, shift; -} - -sub WRITE -{ -$r = shift; -my($buf,$len,$offset) = @_; -&write_to_sock(substr($buf, $offset, $len)); -} - -sub PRINT -{ -$r = shift; -$$r++; -&write_to_sock(@_); -} - -sub PRINTF -{ -shift; -my $fmt = shift; -&write_to_sock(sprintf $fmt, @_); -} - -sub READ -{ -$r = shift; -substr($_[0], $_[2], $_[1]) = substr($postinput, $postpos, $_[1]); -$postpos += $_[1]; -} - -sub OPEN -{ -print STDERR "open() called - should never happen!\n"; -} - -sub READLINE -{ -if ($postpos >= length($postinput)) { - return undef; - } -local $idx = index($postinput, "\n", $postpos); -if ($idx < 0) { - local $rv = substr($postinput, $postpos); - $postpos = length($postinput); - return $rv; - } -else { - local $rv = substr($postinput, $postpos, $idx-$postpos+1); - $postpos = $idx+1; - return $rv; - } -} - -sub GETC -{ -return $postpos >= length($postinput) ? undef - : substr($postinput, $postpos++, 1); -} - -sub CLOSE { } - -sub DESTROY { } - -# write_to_sock(data, ...) -sub write_to_sock -{ -foreach $d (@_) { - if ($doneheaders || $miniserv::nph_script) { - &write_data($d); - } - else { - $headers .= $d; - while(!$doneheaders && $headers =~ s/^(.*)(\r)?\n//) { - if ($1 =~ /^(\S+):\s+(.*)$/) { - $cgiheader{lc($1)} = $2; - } - elsif ($1 !~ /\S/) { - $doneheaders++; - } - else { - &http_error(500, "Bad Header"); - } - } - if ($doneheaders) { - if ($cgiheader{"location"}) { - &write_data( - "HTTP/1.0 302 Moved Temporarily\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_keep_alive(0); - } - elsif ($cgiheader{"content-type"} eq "") { - &http_error(500, "Missing Content-Type Header"); - } - else { - &write_data("HTTP/1.0 $ok_code $ok_message\r\n"); - &write_data("Date: $datestr\r\n"); - &write_data("Server: $config{server}\r\n"); - &write_keep_alive(0); - } - foreach $h (keys %cgiheader) { - &write_data("$h: $cgiheader{$h}\r\n"); - } - &write_data("\r\n"); - &reset_byte_count(); - &write_data($headers); - } - } - } -} - -sub verify_client -{ -local $cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($_[1]); -if ($cert) { - local $errnum = Net::SSLeay::X509_STORE_CTX_get_error($_[1]); - $verified_client = 1 if (!$errnum); - } -return 1; -} - -sub END -{ -if ($doing_eval) { - # A CGI program called exit! This is a horrible hack to - # finish up before really exiting - close(SOCK); - &log_request($acpthost, $authuser, $reqline, - $cgiheader{"location"} ? "302" : $ok_code, &byte_count()); - } -} - -# urlize -# Convert a string to a form ok for putting in a URL -sub urlize { - local($tmp, $tmp2, $c); - $tmp = $_[0]; - $tmp2 = ""; - while(($c = chop($tmp)) ne "") { - if ($c !~ /[A-z0-9]/) { - $c = sprintf("%%%2.2X", ord($c)); - } - $tmp2 = $c . $tmp2; - } - return $tmp2; -} - -# validate_user(username, password) -sub validate_user -{ -return 0 if (!$_[0] || !$users{$_[0]}); -if ($users{$_[0]} eq 'x' && $use_pam) { - $pam_username = $_[0]; - $pam_password = $_[1]; - local $pamh = new Authen::PAM("miniserv", $pam_username, \&pam_conv_func); - if (!ref($pamh)) { - print STDERR "PAM init failed : $pamh\n"; - return 0; - } - local $pam_ret = $pamh->pam_authenticate(); - return $pam_ret == PAM_SUCCESS ? 1 : 0; - } -else { - return $users{$_[0]} eq crypt($_[1], $users{$_[0]}) ? 1 : 0; - } -} - -# the PAM conversation function for interactive logins -sub pam_conv_func -{ -my @res; -while ( @_ ) { - my $code = shift; - my $msg = shift; - my $ans = ""; - - $ans = $pam_username if ($code == PAM_PROMPT_ECHO_ON() ); - $ans = $pam_password if ($code == PAM_PROMPT_ECHO_OFF() ); - - push @res, PAM_SUCCESS(); - push @res, $ans; - } -push @res, PAM_SUCCESS(); -return @res; -} - diff --git a/perl-install/standalone/interactive_http/miniserv.users b/perl-install/standalone/interactive_http/miniserv.users deleted file mode 100644 index f7338497a..000000000 --- a/perl-install/standalone/interactive_http/miniserv.users +++ /dev/null @@ -1 +0,0 @@ -root:x:0 diff --git a/perl-install/standalone/keyboarddrake b/perl-install/standalone/keyboarddrake deleted file mode 100755 index a6c415c7e..000000000 --- a/perl-install/standalone/keyboarddrake +++ /dev/null @@ -1,72 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - - -use interactive; -use keyboard; -use standalone; -use Xconfigurator_consts; -use common; -use c; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -local $_ = join '', @ARGV; - -/-h/ and die _("usage: keyboarddrake [--expert] [keyboard]\n"); - -$::expert = /-expert/; - -print "[$::expert]\n"; -my $keyboard=''; -if ($::expert) { ($keyboard) = grep { !/^-/ } @ARGV;} -print "[$keyboard]\n"; -my $in = 'interactive'->vnew('su', 'keyboard'); - -begin: -$::isEmbedded and kill USR2, $::CCPID; -$keyboard ||= $in->ask_from_listf_(_("Keyboard"), - _("Please, choose your keyboard layout."), - \&keyboard::keyboard2text, - [ keyboard::keyboards() ], - keyboard::read()); -if ($keyboard) { - keyboard::keyboard2text($keyboard) or die "bad keyboard $keyboard\n"; - - my $isNotDelete = $::expert && !$in->ask_yesorno("BackSpace", _("Do you want the BackSpace to return Delete in console?"), 1); - - my $kmap = keyboard::keyboard2kmap($keyboard); - system('loadkeys', $kmap); - - my $xkb = keyboard::keyboard2xkb($keyboard); - system('setxkbmap', $xkb); - - my $f = "/etc/X11/XF86Config"; - my $g = "/etc/X11/XF86Config-4"; - - substInFile { - if (/^Section\s+"Keyboard"/ .. /^EndSection/) { - s|^(\s*XkbLayout\s+).*|$1"$xkb"| - and $_ .= join '', map { " $_\n" } @{$Xconfigurator::xkb_options{$xkb} || []}; - $_ = '' if m,^(\s*(XkbVariant|XkbOptions)\s+),; # remove existing one - } - } $f if -e $f && !$::testing; - - substInFile { - if (/Identifier\s+"Keyboard1"/ .. /^EndSection/) { - s|^(\s*Option\s+"XkbLayout"\s+).*|$1"$xkb"| - and $_ .= join '', map { /(\S+)(.*)/; qq( Option "$1" $2\n) } @{$Xconfigurator::xkb_options{$xkb} || []}; - $_ = '' if m,^(\s*Option\s+"(XkbVariant|XkbOptions)"\s+),; # remove existing one - } - } $g if -e $g && !$::testing; - - keyboard::write('', $keyboard, $isNotDelete); -} - -if ($::isEmbedded) { - kill(USR1, $::CCPID); - $keyboard = ''; - goto begin; -} else { - $in->exit(0); -} diff --git a/perl-install/standalone/livedrake b/perl-install/standalone/livedrake deleted file mode 100755 index bb689996f..000000000 --- a/perl-install/standalone/livedrake +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use common; -use interactive; -use standalone; -use run_program; -use c; - -local $_ = join '', @ARGV; - -/-h/ and die "usage: livedrake [--testing]\n"; - -$::testing = /-testing/; - -my $in = 'interactive'->vnew('su', 'default'); - -my $cd_mntpoint = "/mnt/cdrom"; - -while (! -x "$cd_mntpoint/Mandrake/mdkinst/usr/bin/perl-install/live_install") { - ejectCdrom(); - $in->ask_okcancel(_("Change Cd-Rom"), -_("Please insert the Installation Cd-Rom in your drive and press Ok when done. -If you don't have it, press Cancel to avoid live upgrade."), 1) or $in->exit(0); - run_program::run("mount", "/mnt/cdrom"); -} - -if (-x "$cd_mntpoint/Mandrake/mdkinst/usr/bin/perl-install/live_install") { - chdir "/$cd_mntpoint/Mandrake/mdkinst/usr/bin/perl-install/"; - $::testing or exec "./live_install"; -} - -$in->ask_warn('', _("Unable to start live upgrade !!!\n")); -$in->exit(1); - -sub ejectCdrom { - my ($cdrom) = @_; - $cdrom or cat_("/proc/mounts") =~ m|(/dev/\S+)\s+/mnt/cdrom\s| and $cdrom = $1; - $cdrom or cat_("/etc/fstab") =~ m|(/dev/\S+)\s+/mnt/cdrom\s| and $cdrom = $1; - my $f = eval { $cdrom && detect_devices::tryOpen($cdrom) } or return; - run_program::run("umount", "/mnt/cdrom"); - ioctl $f, c::CDROM_LOCKDOOR(), 0; - ioctl $f, c::CDROMEJECT(), 1; -} diff --git a/perl-install/standalone/localedrake b/perl-install/standalone/localedrake deleted file mode 100644 index cc9b68260..000000000 --- a/perl-install/standalone/localedrake +++ /dev/null @@ -1,17 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use interactive; -use lang; -use any; - -my $in = 'interactive'->vnew('su'); - -my ($lang, $langs) = lang::read(); -if ($lang = any::selectLanguage($in, $lang, $langs)) { - lang::write('', $lang); - lang::write_langs('', $langs); -} - -$in->exit(0); diff --git a/perl-install/standalone/lsnetdrake b/perl-install/standalone/lsnetdrake deleted file mode 100755 index 1b2885092..000000000 --- a/perl-install/standalone/lsnetdrake +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); -use network::smb; -use network::nfs; - -"@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}"; - -if ($nfs) { - my @servers = network::nfs::find_servers(); - foreach my $server (sort_names(@servers)) { - my $server_name = $server->{name} || $server->{ip}; - foreach (sort_names(network::nfs::find_exports($server))) { - print "$server_name:$_->{name}", $_->{comment} && " ($_->{comment})", "\n"; - } - } -} -if ($smb) { - my @servers = network::smb::find_servers(); - foreach my $server (sort_names(@servers)) { - my $server_name = $server->{name} || $server->{ip}; - foreach (sort_names(network::smb::find_exports($server))) { - print "//$server_name/$_->{name}", $_->{comment} && " ($_->{comment})", "\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 f3609b936..000000000 --- a/perl-install/standalone/mousedrake +++ /dev/null @@ -1,76 +0,0 @@ -#!/usr/bin/perl - -use lib qw(/usr/lib/libDrakX); - -use common; -use interactive; -use standalone; -use modules; -use detect_devices; -use Xconfig; -use mouse; -use c; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -local $_ = join '', @ARGV; - -/-h/ and die "usage: mousedrake [--auto] [--testing]\n"; - -$::auto = /-auto/; -$::testing = /-testing/; - -my $in = 'interactive'->vnew('su', 'mouse'); - --r '/etc/modules.conf' and modules::mergein_conf('/etc/modules.conf'); - -undef $::Plug; -begin: -my ($curr_env) = Xconfig::getinfoFromXF86Config(''); -my ($mouse) = mouse::detect() unless $::noauto; -my $time_tag2; - -#- now try to merge $curr_env->{mouse} with $mouse. -$mouse->{XMOUSETYPE} eq $curr_env->{mouse}{XMOUSETYPE} || - $mouse->{XMOUSETYPE} eq 'PS/2' && ($curr_env->{mouse}{XMOUSETYPE} =~ m|PS/2| || - $curr_env->{mouse}{auxmouse}{XMOUSETYPE} =~ m|PS/2|) and $mouse = $curr_env->{mouse}; - -$::isEmbedded and kill USR2, $::CCPID; -if (!$mouse || !$::auto) { - $mouse ||= mouse::fullname2mouse("serial|Generic 2 Button Mouse"); - if ($::isEmbedded && $in->isa('interactive_gtk')) { - require my_gtk; - my $time_tag = Gtk->timeout_add(100, sub { - defined $::Plug && defined $::Plug->child or return 1; - mouse::test_mouse_standalone($mouse,$::Plug->child); - 0; - }); - } - my $name = $in->ask_from_treelistf('mousedrake', _("Please, choose the type of your mouse."), '|', - sub { join '|', map { translate($_) } split '\|', $_[0] }, - [ mouse::fullnames ], - $mouse->{type} . '|' . $mouse->{name}); - Gtk->timeout_remove($time_tag2) if $::isEmbedded && $in->isa('interactive_gtk'); - $name or $::isEmbedded ? do { kill(USR1, $::CCPID); goto begin } : $in->exit(0); - my $mouse_chosen = mouse::fullname2mouse($name); - $mouse->{type} eq $mouse_chosen->{type} && $mouse->{name} eq $mouse_chosen->{name} or $mouse = $mouse_chosen; - - if ($mouse->{device} eq "usbmouse") { - my ($c) = grep { $_->{driver} =~ /usb-[ou]hci/ } detect_devices::pci_probe(0) or die _("no serial_usb found\n"); - eval { modules::load($c->{driver}, "serial_usb") }; - } - - $mouse->{XEMU3} = 'yes' if $mouse->{nbuttons} < 3 && (!$::noauto || $in->ask_yesorno('', _("Emulate third button?"), 1)); - - $mouse->{device} = $in->ask_from_listf(_("Mouse Port"), - _("Please choose on which serial port your mouse is connected to."), - \&mouse::serial_port2text, - [ mouse::serial_ports ], - $mouse->{device}, - ) || goto begin if $mouse->{type} eq 'serial'; -} - -mouse::write_conf($mouse); --e "/var/lock/subsys/gpm" and system "service", "gpm", "restart"; - -$::isEmbedded ? kill(USR1, $::CCPID) : $in->exit(0); -goto begin; diff --git a/perl-install/standalone/net_monitor b/perl-install/standalone/net_monitor deleted file mode 100755 index 2c503a860..000000000 --- a/perl-install/standalone/net_monitor +++ /dev/null @@ -1,519 +0,0 @@ -#!/usr/bin/perl - -# Monitor - -# Copyright (C) 1999 MandrakeSoft (damien@mandrakesoft.com) -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use Gtk; -use lib qw(/usr/lib/libDrakX); -use interactive; -use standalone; -use my_gtk qw(:helpers :wrappers); -#-use Data::Dumper; -use common; -use strict; -use network::netconnect; -use network::tools; -use MDK::Common::Globals "network", qw($in $prefix $connect_file $disconnect_file $connect_prog); - -if ("@ARGV" =~ /--help|-h/) { - print q(Network & Internet connection and monitoring application - ---defaultintf interface : show this interface by default ---connect : connect to internet if not already connected ---disconnect : disconnect to internet if already connected ---force : used with (dis)connect : force (dis)connection. ---status : returns 1 if connected 0 otherwise, then exit. ---quiet : don't be interactive. To be used with (dis)connect. -); - exit(0); -} - -if ("@ARGV" =~ /--status/) { print connected(); exit(0) } -my $force = "@ARGV" =~ /--force/; -my $quiet = "@ARGV" =~ /--quiet/; -my $connect = "@ARGV" =~ /--connect/; -my $disconnect = "@ARGV" =~ /--disconnect/; -my ($default_intf) = "@ARGV" =~ /--defaultintf (\w+)/; - -if ($force) { - $connect and system("/etc/sysconfig/network-scripts/net_cnx_up &"); - $disconnect and system("/etc/sysconfig/network-scripts/net_cnx_down &"); - $connect = $disconnect = 0; -} -$quiet and exit(0); -init Gtk; -my $in = 'interactive'->vnew('su', 'default'); -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; - - -my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel; -$window1->signal_connect ( delete_event => sub { Gtk->exit(0); }); -$window1->set_position(1); -$window1->set_title(_("Network Monitoring")); -$window1->set_policy(1, 1, 1); -$window1->set_border_width(5); -#$::isEmbedded or $window1->set_usize(580, 320); - -my $colorr = my_gtk::gtkcolor(50400, 655, 20000); -my $colort = my_gtk::gtkcolor(55400, 55400, 655); -my $colora = my_gtk::gtkcolor(655, 50400, 655); -my $isconnected=-1; -my @interfaces; -my $monitor = {}; -my $netcnx = {}; -my $netc = {}; -my $intf = {}; -my $c_time = 0; -my $ct_tag; -my $style= new Gtk::Style; -$style->font(Gtk::Gdk::Font->fontset_load("-adobe-times-medium-r-normal-*-12-*-75-75-p-*-iso8859-*,*-r-*")); - -network::netconnect::load_conf($netcnx, $netc, $intf); -network::netconnect::read_net_conf('', $netcnx, $netc); -my $combo1 = new Gtk::Combo; -$combo1->set_popdown_strings (network::netconnect::get_profiles() ); -$combo1->entry->set_text($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default"); -$combo1->entry->set_editable(0); -MDK::Common::Globals::init( - in => $in, - prefix => '', - connect_file => "/etc/sysconfig/network-scripts/net_cnx_up", - disconnect_file => "/etc/sysconfig/network-scripts/net_cnx_down", - connect_prog => "/etc/sysconfig/network-scripts/net_cnx_pg" ); - -gtkadd($window1, - gtkpack_(new Gtk::VBox(0,5), - 0, _("Network Monitoring"), - 1, gtkpack_(new Gtk::HBox(0,5), - 1, my $notebook = new Gtk::Notebook, - 0, gtkpack_(new Gtk::VBox(0,5), - 0, gtkadd(gtkset_shadow_type(new Gtk::Frame(_("Settings")), 'etched_out'), - gtkpack__(gtkset_border_width(new Gtk::VBox(0,5),5), - gtkpack__(new Gtk::HBox(0,0), - _("Connection type: "), my $label_cnx_type = new Gtk::Label("")), - gtkpack__(new Gtk::HBox(0,0), - _("Profile "), $combo1) - ) - ), - 1, gtkadd(gtkset_shadow_type(new Gtk::Frame(_("Statistics")), 'etched_out'), - gtkpack__(new Gtk::VBox(0,0), - create_packtable({ col_spacings => 1, row_spacings => 1}, - [ "", "instantaneous" , "average"], - [ _("Sending Speed:"), my $label_st = new Gtk::Label(""), my $label_sta=new Gtk::Label("na")], - [ _("Receiving Speed:"),my $label_sr= new Gtk::Label(""), my $label_sra=new Gtk::Label("na")], - ), - gtkpack__(new Gtk::HBox(0,0), " "._("Connection Time: "), my $label_ct = new Gtk::Label("")), - ) - ), - 0, gtkpack_(new Gtk::HBox(0,5), - 1, gtksignal_connect(my $button_connect = gtkset_sensitive(new Gtk::Button(), 0), clicked => \&connection), - 0, new Gtk::VSeparator, - 0, gtkpack(new Gtk::VBox(0,5), - gtksignal_connect(new Gtk::Button(_("Logs")), clicked => sub { - -e "/usr/sbin/logdrake" - ? system('/usr/sbin/logdrake --file=/var/log/messages &') - : system('/usr/X11R6/bin/xvt -e "tail -f /var/log/messages " &') - }), - gtksignal_connect(my $button_close = new Gtk::Button(_("Close")), clicked => sub { Gtk->exit(0) }), - ) - ) - ) - ), - 0, my $statusbar = new Gtk::Statusbar - ) - ); -$window1->show_all; -$window1->realize; -$combo1->entry->signal_connect( 'changed', sub { - network::netconnect::set_profile($netcnx, $combo1->entry->get_text()); - network::netconnect::load_conf($netcnx, $netc, $intf); - network::netconnect::set_net_conf($netcnx, $netc, $intf); - network::netconnect::read_net_conf('', $netcnx, $netc); - }); -my $gct = new Gtk::Gdk::GC($window1->window); -$gct->set_foreground($colort); -my $gcr = new Gtk::Gdk::GC($window1->window); -$gcr->set_foreground($colorr); -my $gca = new Gtk::Gdk::GC($window1->window); -$gca->set_foreground($colora); -my ($pix_c_map, $pix_c_mask) = gtkcreate_png("net_c.png"); -my ($pix_d_map, $pix_d_mask) = gtkcreate_png("net_d.png"); -my ($pix_u_map, $pix_u_mask) = gtkcreate_png("net_u.png"); -$button_connect->add(gtkpack__(new Gtk::VBox(0,3), - my $pix_c = new Gtk::Pixmap($pix_u_map, $pix_u_mask), - my $label_c = new Gtk::Label(_("Wait please")) - )); -$statusbar->push(1, _("Wait please, testing your connection...")); -$window1->show_all(); -#$window1->set_policy (1, 1, 1); -my $time_tag = Gtk->timeout_add(1000, \&rescan); -my $time_tag2 = Gtk->timeout_add(5000, \&update); - -update(); -rescan(); -while ($isconnected == -1) { - Gtk->main_iteration while Gtk->events_pending; -} -connection() if ($connect && !$isconnected || $disconnect && $isconnected); -Gtk->main; -Gtk->exit(0); - -my $during_connection; -sub connection { - $during_connection = 1; - my $isconnected2 = $isconnected; - $button_connect->set_sensitive(0); - $button_close->set_sensitive(0); - $statusbar->pop(1); - $statusbar->push(1, $isconnected2 ? _("Disconnecting from Internet ") : _("Connecting to Internet ")); - if(!$isconnected2) { - $c_time = time(); - $ct_tag = Gtk->timeout_add(1000, sub { - my ($sec,$min,$hour) = gmtime(time() - $c_time); - my $e = sprintf ("%02d:%02d:%02d", $hour, $min, $sec); - $label_ct->set($e); 1; }); - } else { Gtk->timeout_remove($ct_tag) } - my $nb_point=1; - my $tag = Gtk->timeout_add(100, sub { - $statusbar->pop(1); - $statusbar->push(1, ($isconnected2 ? _("Disconnecting from Internet ") : _("Connecting to Internet ")) - . join('', map { "." } (1..$nb_point))); - $nb_point++; - 1; - }); - my $netc = {}; - my $tag2 = Gtk->timeout_add(10000, sub { - Gtk->timeout_remove($tag); - $statusbar->pop(1); - $statusbar->push(1, $isconnected2 ? ( $isconnected ? - _("Disconnection from Internet failed.") : - _("Disconnection from Internet complete.")) : - ( $isconnected ? - _("Connection complete.") : - _("Connection failed.\nVerify your configuration in the Mandrake Control Center.")) - ); - my $tag3 = Gtk->timeout_add(10000, sub { - $statusbar->pop(1); - $statusbar->push(1, $isconnected ? _("Connected") : _("Not connected")); - 0; - }); - $button_connect->set_sensitive(1); - $button_close->set_sensitive(1); - undef $during_connection; - 0; - }); - Gtk->main_iteration while Gtk->events_pending; - $tag2 = Gtk->timeout_add(1000, sub { system( $isconnected2 ? "/etc/sysconfig/network-scripts/net_cnx_down &" : "/etc/sysconfig/network-scripts/net_cnx_up &"); 0; }); -} - -sub rescan { - get_val(); - foreach(@interfaces) { - my $intf = $_; - my $recv = $monitor->{$intf}{val}->[0]; - my $transmit = $monitor->{$intf}{val}->[8]; - my $refr = $monitor->{$intf}{referencer}; - my $reft = $monitor->{$intf}{referencet}; - $monitor->{sr} += $recv - $refr; - $monitor->{st} += $transmit - $reft; - - $monitor->{$intf}{recva} += $recv - $refr; - $monitor->{$intf}{recvan}++; - if ($monitor->{$intf}{recvan} > 9) { - push(@{$monitor->{$intf}{stack_ra}}, $monitor->{$intf}{recva}/10); - $monitor->{$intf}{recva} = $monitor->{$intf}{recvan} = 0; - } else { push(@{$monitor->{$intf}{stack_ra}}, -1) } - shift @{$monitor->{$intf}{stack_ra}} if @{$monitor->{$intf}{stack_ra}} > 250; - - push(@{$monitor->{$intf}{stack_r}}, $recv - $refr); - shift @{$monitor->{$intf}{stack_r}} if @{$monitor->{$intf}{stack_r}} > 250; - $monitor->{$intf}{labelr}->set(formatXiB($recv - $monitor->{$intf}{initialr})); - $monitor->{$intf}{referencer} = $recv; - - $monitor->{$intf}{transmita} += $transmit - $reft; - $monitor->{$intf}{transmitan}++; - if ($monitor->{$intf}{transmitan} > 9) { - push(@{$monitor->{$intf}{stack_ta}}, $monitor->{$intf}{transmita}/10); - $monitor->{$intf}{transmita} = $monitor->{$intf}{transmitan} = 0; - } else { push(@{$monitor->{$intf}{stack_ta}}, -1) } - shift @{$monitor->{$intf}{stack_ta}} if @{$monitor->{$intf}{stack_ta}} > 250; - - push(@{$monitor->{$intf}{stack_t}}, $transmit - $reft); - shift @{$monitor->{$intf}{stack_t}} if @{$monitor->{$intf}{stack_t}} > 250; - $monitor->{$intf}{labelt}->set(formatXiB($transmit - $monitor->{$intf}{initialt})); - $monitor->{$intf}{referencet} = $transmit; - - draw_monitor($monitor->{$intf}); - } - $label_sr->set(formatXiB($monitor->{sr}) . "/s"); - $label_st->set(formatXiB($monitor->{st}) . "/s"); - $monitor->{sra} += $monitor->{sr}; - $monitor->{sta} += $monitor->{st}; - $monitor->{nba} ++; - if($monitor->{nba} > 9) { - $label_sra->set(formatXiB($monitor->{sra}/10) . "/s"); - $label_sta->set(formatXiB($monitor->{sta}/10) . "/s"); - $monitor->{sra} = 0; - $monitor->{sta} = 0; - $monitor->{nba} = 0; - } - $label_cnx_type->set($netcnx->{type}); - $monitor->{$_} = 0 foreach ('sr', 'st'); - 1; -} - -sub get_val { - my @ret; - my $a = cat_("/proc/net/dev"); - $a =~ s/^.*?\n.*?\n//; - $a =~ s/^\s*lo:.*?\n//; - my @line = split(/\n/, $a); - foreach(@line) { - s/\s*(\w*)://; - my $intf=$1; - push (@ret,$intf); - $monitor->{$intf}{val} = [split()]; - $monitor->{$intf}{intf} = $intf; - } - @ret; -} - -sub change_color { - my ($color) = @_; - my $window = new Gtk::Window -toplevel; - my $doit; - $window->signal_connect ( delete_event => sub { Gtk->main_quit() }); - $window->set_position(1); - $window->set_title(_("Color configuration")); - $window->set_border_width(5); - gtkadd(gtkset_modal($window,1), - gtkpack_(new Gtk::VBox(0,5), - 1, my $colorsel = new Gtk::ColorSelection, - 0, gtkadd(gtkset_layout(new Gtk::HButtonBox, -end), - gtksignal_connect(new Gtk::Button(_("OK")), clicked => sub { $doit=1; Gtk->main_quit() }), - gtksignal_connect(new Gtk::Button(_("Cancel")), clicked => sub { Gtk->main_quit() }), - ) - ) - ); - $colorsel->set_color($color->red()/65535, $color->green()/65535, $color->blue()/65535, $color->pixel()); - $window->show_all(); - Gtk->main; - $window->destroy(); - $doit or return $color; - my (@color) = $colorsel->get_color(); - my_gtk::gtkcolor($color[0]*65535, $color[1]*65535, $color[2]*65535); -} - -my $scale; -sub update { - connected_bg(\$isconnected); - my @intfs = get_val(); - if($combo1->entry->get_text ne ($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default")) { - $combo1->entry->set_text($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default"); - } - foreach(@intfs) { - my $intf = $_; - if(!member($intf,@interfaces)) { - $default_intf = $intf; - $monitor->{$intf}{initialr} = $monitor->{$intf}{val}->[0]; - $monitor->{$intf}{initialt} = $monitor->{$intf}{val}->[8]; - $monitor->{$intf}{darea} = new Gtk::DrawingArea(); - $monitor->{$intf}{darea}->set_events(["pointer_motion_mask"]); - $notebook->append_page(gtkshow(my $page = gtkpack_(new Gtk::VBox(0,0), - 0, gtkpack__(gtkset_border_width(new Gtk::HBox(0,0), 5), - gtksize($monitor->{$intf}{darea},300, 150)), - 0, gtkpack_(new Gtk::HBox(0,0), - 1, gtkpack__(new Gtk::VBox(0,0), - gtkpack__(gtkset_border_width(new Gtk::HBox(0,5), 5), - gtksignal_connect(my $button_t = gtkset_relief(new Gtk::Button(), 'none'), clicked => sub { - $colort = change_color($colort); - $gct->set_foreground($colort); - $_[0]->draw(undef); - }), - _("sent: "), $monitor->{$intf}{labelt} = new Gtk::Label("0")), - gtkpack__(gtkset_border_width(new Gtk::HBox(0,5), 5), - gtksignal_connect(my $button_r = gtkset_relief(new Gtk::Button(), 'none'), clicked => sub { - $colorr = change_color($colorr); - $gcr->set_foreground($colorr); - $_[0]->draw(undef); - }), - _("received: "), $monitor->{$intf}{labelr} = new Gtk::Label("0")), - gtkpack__(gtkset_border_width(new Gtk::HBox(0,5), 5), - gtksignal_connect(my $button_a = gtkset_relief(new Gtk::Button(), 'none'), clicked => sub { - $colora = change_color($colora); - $gca->set_foreground($colora); - $_[0]->draw(undef); - }), - _("average")) - ), - 0, gtkpack__(gtkset_border_width(new Gtk::VBox(0,0), 5), - gtkadd(gtkset_shadow_type(new Gtk::Frame(_("Local measure")), 'etched_out'), - gtkpack__(gtkset_border_width(new Gtk::VBox(0,0), 5), - gtkpack__(new Gtk::HBox(0,0), - _('sent: '), - my $measure_t = new Gtk::Label("0") - ), - gtkpack__(new Gtk::HBox(0,0), - _('received: '), - my $measure_r = new Gtk::Label("0") - ) - ) - ) - ) - ) - )), - new Gtk::Label($intf)); - foreach my $i ([$button_t, $gct],[$button_r, $gcr],[$button_a, $gca]) { - $i->[0]->add(gtksignal_connect(gtkshow(gtksize(gtkset_usize(new Gtk::DrawingArea(), 10, 10), 10, 10)), expose_event => sub{ $_[0]->window->draw_rectangle ($i->[1], 1, 0, 0, 10, 10)} )); - } - $notebook->set_page($notebook->page_num($page)); - $monitor->{$intf}{page}=($notebook->page_num($page)); - $monitor->{$intf}{pixmap_db} = new Gtk::Gdk::Pixmap($monitor->{$intf}{darea}->window, 300, 150); - $monitor->{$intf}{referencer} = $monitor->{$intf}{val}->[0]; - $monitor->{$intf}{referencet} = $monitor->{$intf}{val}->[8]; - $monitor->{$intf}{pixmap_db}->draw_rectangle ($monitor->{$intf}{darea}->style->black_gc, 1, 0, 0, 300, 150); - $monitor->{$intf}{darea}->signal_connect( motion_notify_event => - sub { my ($w, $e) = @_; - my $x = $e->{'x'} - 50; - my $y = $e->{'y'}; - my $received = $x >= 0 ? $monitor->{$intf}{stack_r}[$x] : 0; - my $transmitted = $x >= 0 ? $monitor->{$intf}{stack_t}[$x] : 0; - my $type; - $y * $scale / 150 < $transmitted and $type = _('transmitted'); - (150 - $y) * $scale / 150 < $received and $type = _('received'); - $measure_r->set(formatXiB($received)); - $measure_t->set(formatXiB($transmitted)); - }); - $monitor->{$intf}{darea}->signal_connect( expose_event => sub { - $monitor->{$intf}{darea}->window->draw_pixmap ($monitor->{$intf}{darea}->style->bg_gc('normal'), - $monitor->{$intf}{pixmap_db}, 0, 0, 0, 0, 300, 150); - }); - } - } - foreach(@interfaces) { - my $intf = $_; - if(!member($intf,@intfs)) { - $notebook->remove_page($monitor->{$intf}{page}); - } - } - @interfaces = @intfs; - my $netc={}; - if ($isconnected != -1 && !$during_connection) { - $button_connect->set_sensitive(1); - $label_c->set($isconnected ? _("Disconnect") : _("Connect")); - $statusbar->pop(1); - $statusbar->push(1, $isconnected ? _("Connected") : _("Not connected")); - $isconnected ? $pix_c->set($pix_c_map, $pix_c_mask) : $pix_c->set($pix_d_map, $pix_d_mask); - } - if (!(-e $connect_file && -e $disconnect_file)) { - $button_connect->set_sensitive(0); - $label_c->set("No internet connection configured"); - } - 1; -} - -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 0a339adf6..000000000 --- a/perl-install/standalone/printerdrake +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl - -# printerdrake -# Copyright (C) 1999 MandrakeSoft (fpons@mandrakesoft.com) -# Original version for printer configuration from pad. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use lib qw(/usr/lib/libDrakX); - -use interactive; -use standalone; -use printerdrake; -use printer; -use c; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -local $_ = join '', @ARGV; - -/-h/ and die "usage: printerdrake [--beginner] [--expert] [--auto] [--noauto] [--skiptest] [--testing] [--cups] [--lprng] [--lpd] [--pdq]\n"; - -$::beginner = /-beginner/; -$::expert = /-expert/; -$::auto = /-auto/; -$::noauto = /-noauto/; -$::skiptest = /-skiptest/; -$::testing = /-testing/; - -my $printer; - -my $in = 'interactive'->vnew('su', 'printer'); - -my $commandline = $_; - -{ -my $w = $in->wait_message('', _("Reading printer data ...")); -# Get what was installed before -eval { $printer = printer::getinfo('') }; -# Choose the spooler by command line options -$commandline =~ /-cups/ and - $printer->{SPOOLER} = 'cups' and printer::read_configured_queues($printer); -$commandline =~ /-lpr/ and - $printer->{SPOOLER} = 'lpd' and printer::read_configured_queues($printer); -$commandline =~ /-lpd/ and - $printer->{SPOOLER} = 'lpd' and printer::read_configured_queues($printer); -$commandline =~ /-lprng/ and - $printer->{SPOOLER} ='lprng' and printer::read_configured_queues($printer); -$commandline =~ /-pdq/ and - $printer->{SPOOLER} = 'pdq' and printer::read_configured_queues($printer); --r '/etc/modules.conf' and modules::mergein_conf('/etc/modules.conf'); -} - -begin: -$::isEmbedded and kill USR2, $::CCPID; - -printerdrake::main($printer, $in, 1); - -$::isEmbedded ? kill(USR1, $::CCPID) : $in->exit(0); -goto begin; diff --git a/perl-install/standalone/scannerdrake b/perl-install/standalone/scannerdrake deleted file mode 100755 index ffb61727a..000000000 --- a/perl-install/standalone/scannerdrake +++ /dev/null @@ -1,103 +0,0 @@ -#!/usr/bin/perl - -# scannerdrake $Id$ -# Yves Duret <yduret at mandrakesoft.com> -# Copyright (C) 2001 MandrakeSoft -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use lib qw(/usr/lib/libDrakX); -use interactive; -use common; -use standalone; -use scanner; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -for (@ARGV) { - /^--version$/ and die 'version: $Id$ '."\n"; - /^--help$/ and die 'logdrake [--version] [--help] [--manual] [--device=dev] [--update-sane=sane_desc_dir] [--update-usbtable] [--dynamic=dev]'; - /^--update-usbtable$/ and do {scanner::updateScannerDBfromUsbtable(); exit;}; - /^--update-sane=(.*)$/ and do {scanner::updateScannerDBfromSane($1); exit;}; - /^--manual$/ and $::Manual=1; - /^--dynamic=(.*)$/ and do { dynamic($1); exit;}; -} - -$in = 'interactive'->vnew('su', 'default'); -$in->do_pkgs->install('sane-backends', 'xsane', if_($in->do_pkgs->is_installed('gimp'),'xsane-gimp')); -if ($::Manual) {manual(); quit();} -my $wait = $in->wait_message(_("Test ports"), _("Detecting devices ...")); -@f = scanner::findScannerUsbport(); -$wait=undef; -(@f) ? auto() : manual(); -quit(); - -sub auto { - foreach (@f) { - if (member($_->{val}{DESCRIPTION}), keys %$scanner::scannerDB) { - my $name = $_->{val}{DESCRIPTION}; - $name =~ s/\s$//; #some HP entry have a trailing space, i will correct usbtable asap - $in->ask_yesorno('scannerdrake',_("%s found on %s, configuring it ?",$name,$_->{port}),1) or manual(); - tryConfScanner($name, $_->{port}); - } - } -} - -sub manual { - my $s = $in->ask_from_treelist('scannerdrake', _("Select a scanner"), '|', [keys %$scanner::scannerDB]) or return; - # DRIVER usb or scsi - #print "$s\n"; - tryConfScanner($s); -} - -sub dynamic { - @f = scanner::findScannerUsbport(); - foreach (@f) { - if (member($_->{val}{DESCRIPTION}), keys %$scanner::scannerDB) { - my $name = $_->{val}{DESCRIPTION}; - $name =~ s/\s$//; #some HP entry have a trailing space, i will correct usbtable asap - scanner::confScanner($name, $_->{port}) unless($scanner::scannerDB->{$model}{flags}{unsupported}); - } - } -} - -sub tryConfScanner { - # take care if interactive ouptut is needed (unsupported, parallel..) - my ($model, $port) = @_; - if ($scanner::scannerDB->{$model}{flags}{unsupported}) { - $in->ask_warn('scannerdrake', _("This %s scanner is unsupported", $model)); - return; - } - if ($scanner::scannerDB->{$model}{driver} =~ /Parport/) { - $in->ask_warn('scannerdrake', _("This %s scanner uses parallel port, which is unsupported for the moment", $model)); - return; - } - scanner::confScanner($model,$port); -} - -sub quit { - $::isEmbedded ? kill(USR1, $::CCPID) : $in->exit(0); -} - -#----------------------------------------------- -# $Log$ -# Revision 1.4 2001/11/19 17:39:03 pablo -# Corrected English errors -# -# Revision 1.3 2001/11/19 10:50:37 yduret -# added dynamic support -# -# Revision 1.2 2001/11/12 15:19:54 yduret -# update -# diff --git a/perl-install/standalone/tinyfirewall b/perl-install/standalone/tinyfirewall deleted file mode 100755 index df01e76e9..000000000 --- a/perl-install/standalone/tinyfirewall +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl - -# DrakNet - -# Copyright (C) 1999 MandrakeSoft (damien@mandrakesoft.com) -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - -use lib qw(/usr/lib/libDrakX); -use interactive; -use standalone; -use tinyfirewall; - -$::isEmbedded = ($::XID, $::CCPID) = "@ARGV" =~ /--embedded (\w+) (\w+)/; -$::isWizard = "@ARGV" =~ /--wizard/; -$::Wizard_pix_up = "wiz_firewall.png"; -$::Wizard_title = _("Firewalling Configuration"); - -local $_ = join '', @ARGV; - -my $in = 'interactive'->vnew('su', 'default'); - -$::isEmbedded && $in->isa('interactive_gtk') or goto dd; -require Gtk; -init Gtk; - -my $window1 = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window -toplevel; -$window1->signal_connect ( delete_event => sub { Gtk->exit(0); }); -$window1->set_position(1); -$window1->set_title(_("Firewalling configuration")); -$window1->border_width(10); -$::isEmbedded or $window1->set_usize(500, 400); -my $vbox1 = new Gtk::VBox(0,0); -$window1->add($vbox1); -my $hbox1 = new Gtk::HBox(0,0); -$vbox1->pack_start($hbox1,1,1,0); -my $label1 = new Gtk::Label(""); -$hbox1->pack_start($label1,1,1,0); -my $hbox2 = new Gtk::HBox(0,0); -$vbox1->pack_start($hbox2,1,1,0); - -my $bbox1 = new Gtk::HButtonBox; -$vbox1->pack_start($bbox1,0,0,0); -$bbox1->set_layout(-end); -my $button_conf = new Gtk::Button _("Configure"); -$button_conf->signal_connect ( clicked => sub { - system("/usr/sbin/tinyfirewall --wizard"); - update(); - }); -$bbox1->add($button_conf); -my $button_ok = new Gtk::Button _("Cancel"); -$button_ok->signal_connect ( clicked => sub { - quit_global(); - }); -$bbox1->add($button_ok); -$window1->show_all(); -update(); -Gtk->main_iteration while Gtk->events_pending; -$::isEmbedded and kill USR2, $::CCPID; -Gtk->main; -Gtk->exit(0); - -sub update { -$label1->set(-e "/etc/rc.d/rc3.d/S05bastille-firewall" ? - _("Firewalling - -You already have set up a firewall. -Click on Configure to change or remove the firewall"): - _("Firewalling - -Click on Configure to set up a standard firewall")); -} - -sub quit_global { - $::isEmbedded ? kill(USR1, $::CCPID) : Gtk->exit(0); -} - -dd: -tinyfirewall::main($in); |