bugfix

author: pad <pad@mandriva.com> 1999-09-06 20:33:18 +0000
committer: pad <pad@mandriva.com> 1999-09-06 20:33:18 +0000
commit: 115b4b1145f86d90f20c0404a54fa907f06c30b0 (patch)
tree: 046cd13affb85df1028bcc687e1c8853fc576cd7 /perl-install
parent: a6096f902a2df839b7e89c084d629840bf52a3a1 (diff)
download: drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.tar
drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.tar.gz
drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.tar.bz2
drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.tar.xz
drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.zip
11 files changed, 354 insertions, 216 deletions
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 3d90b1679..5dfae42b1 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -12,16 +12,16 @@ use common qw(:common :file :system :functional);
 use install_any qw(:all);
 use log;
 use network;
+use lang;
 use keyboard;
 use fs;
 use fsedit;
-use modules;
 use partition_table qw(:types);
-use detect_devices;
 use pkgs;
-use smp;
-use lang;
 use printer;
+use modules;
+use detect_devices;
+use smp;
 use run_program;
 use install_steps_graphical;
 
@@ -203,7 +203,7 @@ for (my $i = 0; $i < @installSteps; $i += 2) {
     push @orderedInstallSteps, $installSteps[$i];
 }
 
-#TOSEE bug avec
+#TOSEE bug with
 #%installSteps = 
 #      map_tab_hash {
 #	   my ($i, $h)   = @_; 
@@ -298,8 +298,8 @@ $o = $::o = {
 
                  DEVICE    => "/dev/dev1",
 
-                 REMOTEHOST => "padhost",
-                 REMOTEQUEUE => "padqueue",
+                 REMOTEHOST => "",
+                 REMOTEQUEUE => "",
 
                  NCPHOST   => "printerservername",
                  NCPQUEUE  => "queuename",
@@ -321,7 +321,7 @@ $o = $::o = {
     steps        => \%installSteps,        
     orderedSteps => \@orderedInstallSteps, 
 
-    installClass => "beginner",
+    installClass => "expert",
 
     base => [ qw(basesystem initscripts console-tools mkbootdisk anacron rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup filesystem SysVinit bdflush crontabs dev e2fsprogs etcskel fileutils findutils getty_ps grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which cpio) ],
 # for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm
@@ -606,3 +606,8 @@ sub killCardServices {
     my $pid = chop_(cat_("/tmp/cardmgr.pid"));
     $pid and kill(15, $pid); # send SIGTERM
 }
+
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
+1; # 
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 6e8bff2e9..6cd107081 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -81,8 +81,12 @@ sub errorInStep($$) {}
 #------------------------------------------------------------------------------
 sub selectLanguage {
     my ($o) = @_;
-    $o->{keyboard} ||= keyboard::lang2keyboard($o->{lang});
-    selectKeyboard($o);
+    lang::set($o->{lang});
+
+    unless ($o->{keyboard_force}) {
+	$o->{keyboard} = keyboard::lang2keyboard($o->{lang});
+	selectKeyboard($o);
+    }
 }
 #------------------------------------------------------------------------------
 sub selectKeyboard { 
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index f81008943..8696dfba0 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -41,7 +41,7 @@ sub selectLanguage($) {
     my ($o) = @_;
     $o->{lang} =
       lang::text2lang($o->ask_from_list("Language",
-					__("Which language do you want?"), 
+					_("Which language do you want?"), 
 					# the translation may be used for the help
 					[ lang::list() ], 
 					lang::lang2text($o->{lang})));
@@ -147,13 +147,17 @@ sub configureNetwork($) {
 	    add2hash($intf, $last);
 	    add2hash($intf, { NETMASK => '255.255.255.0' });
 	    $o->configureNetworkIntf($intf);
+
+	    $o->{netc} ||= {};
+	    delete $o->{netc}{dnsServer};
+	    delete $o->{netc}{GATEWAY};
 	    $last = $intf;
 	}
 	#	 { 
 	#	     my $wait = $o->wait_message(_("Hostname"), _("Determining host name and domain..."));
 	#	     network::guessHostname($o->{prefix}, $o->{netc}, $o->{intf});
 	#	 }
-	$o->configureNetworkNet($o->{netc} ||= {}, @l);
+	$o->configureNetworkNet($o->{netc}, $last ||= {}, @l);
     }
     install_steps::configureNetwork($o);
 }
@@ -177,13 +181,19 @@ notation (for example, 1.2.3.4)."),
 				     }
 				     return 0;
 				 }
+			     },
+			     focus_out => sub {
+				 $intf->{NETMASK} = network::netmask($intf->{IPADDR}) unless $_[0]
 			     }
+
 			    );
 }
 
 sub configureNetworkNet {
-    my ($o, $netc, @devices) = @_;
-
+    my ($o, $netc, $intf, @devices) = @_;
+    $netc->{dnsServer} ||= network::dns($intf->{IPADDR});
+    $netc->{GATEWAY}   ||= network::gateway($intf->{IPADDR});
+    
     $o->ask_from_entries_ref(_("Configuring network"),
 _("Please enter your host name.
 Your host name should be a fully-qualified host name,
@@ -225,7 +235,7 @@ name (often lp) and a spool directory associated with it. What
 name and directory should be used for this queue?"),
 				 [_("Name of queue:"), _("Spool directory:")],
 				 [\$o->{printer}{QUEUE}, \$o->{printer}{SPOOLDIR}],
-				 focus_out => sub 
+				 changed => sub 
 				 { 
 				     $o->{printer}{SPOOLDIR} 
 				       = "$printer::spooldir/$o->{printer}{QUEUE}" unless $_[0];
@@ -274,30 +284,39 @@ on that server which jobs should be placed in."),
 					   );
 	
     } elsif ($o->{printer}{TYPE} eq "SMB") {
-	return if !$o->ask_from_entries_ref(_("SMB/Windows 95/NT Printer Options"),
-					    _("To print to a SMB printer, you need to provide the 
+	return if !$o->ask_from_entries_ref(
+	    _("SMB/Windows 95/NT Printer Options"),
+	    _("To print to a SMB printer, you need to provide the 
 SMB host name (this is not always the same as the machines 
 TCP/IP hostname) and possibly the IP address of the print server, as 
 well as the share name for the printer you wish to access and any 
 applicable user name, password, and workgroup information."),
-					    [_("SMB server host:"), _("SMB server IP:"),
-					     _("Share name:"), _("User name:"), _("Password:"),
-					     _("Workgroup:")],
-					    [\$o->{printer}{SMBHOST}, \$o->{printer}{SMBHOSTIP},
-					     \$o->{printer}{SMBSHARE}, \$o->{printer}{SMBUSER},
-					     \$o->{printer}{SMBPASSWD}, \$o->{printer}{SMBWORKGROUP}
-					    ]
+	    [_("SMB server host:"), _("SMB server IP:"),
+	     _("Share name:"), _("User name:"), _("Password:"),
+	     _("Workgroup:")],
+	    [\$o->{printer}{SMBHOST}, \$o->{printer}{SMBHOSTIP},
+	     \$o->{printer}{SMBSHARE}, \$o->{printer}{SMBUSER},
+	     {val => \$o->{printer}{SMBPASSWD}, hidden => 1}, \$o->{printer}{SMBWORKGROUP}
+	    ],
+	     complete => sub {
+		 unless (network::is_ip($o->{printer}{SMBHOSTIP})) {
+		     $o->ask_warn('', _("IP address should be in format 1.2.3.4"));
+		     return (1,1);
+		 }
+		 return 0;
+	     },
+					    
 					   );
     } else {#($o->{printer}{TYPE} eq "NCP") {
 	return if !$o->ask_from_entries_ref(_("NetWare Printer Options"),
-					    _("To print to a NetWare printer, you need to provide the 
+	    _("To print to a NetWare printer, you need to provide the 
 NetWare print server name (this is not always the same as the machines 
 TCP/IP hostname) as well as the print queue name for the printer you 
 wish to access and any applicable user name and password."),
-					    [_("Printer Server:"), _("Print Queue Name:"), 
-					     _("User name:"), _("Password:")],
-					    [\$o->{printer}{NCPHOST}, \$o->{printer}{NCPQUEUE},
-					     \$o->{printer}{NCPUSER}, \$o->{printer}{NCPPASSWD}],
+	    [_("Printer Server:"), _("Print Queue Name:"), 
+	     _("User name:"), _("Password:")],
+	    [\$o->{printer}{NCPHOST}, \$o->{printer}{NCPQUEUE},
+	     \$o->{printer}{NCPUSER}, {val => \$o->{printer}{NCPPASSWD}, hidden => 1}],
 					   );
     }
     
@@ -394,15 +413,16 @@ wish to access and any applicable user name and password."),
 sub setRootPassword($) {
     my ($o) = @_;
     $o->{superuser}{password2} ||= $o->{user}{password} ||= "";
-    my %sup = %{$o->{superuser}};
+    my $sup = $o->{superuser};
 
     $o->ask_from_entries_ref(_("Set root password"),
 			 _("Set root password"),
 			 [_("Password"), _("Password (again)")],
-			 [\$sup{password}, \$sup{password2}],
+			 [{ val => \$sup->{password},  hidden => 1}, 
+			  { val => \$sup->{password2}, hidden => 1}],
 			 complete => sub {
-			     $sup{password} eq $sup{password2} or $o->ask_warn('', [ _("You must enter the same password"), _("Please try again") ]), return (1,1);
-			     (length $sup{password} < 6) and $o->ask_warn('', _("This password is too simple")), return (1,0);
+			     $sup->{password} eq $sup->{password2} or $o->ask_warn('', [ _("You must enter the same password"), _("Please try again") ]), return (1,1);
+			     (length $sup->{password} < 6) and $o->ask_warn('', _("This password is too simple")), return (1,0);
 			     return 0
 			 }
 			);
@@ -415,7 +435,7 @@ sub setRootPassword($) {
 sub addUser($) {
     my ($o) = @_;
     $o->{user}{password2} ||= $o->{user}{password} ||= "";
-    my %u = %{$o->{user}};
+    my $u = $o->{user};
     my @fields = qw(realname name password password2);
     my @shells = install_any::shells($o);
 
@@ -423,20 +443,21 @@ sub addUser($) {
         _("Add user"),
         _("Enter a user"),
         [ _("Real name"), _("User name"), _("Password"), _("Password (again)"), _("Shell") ],
-        [ (map { \$u{$_}} @fields), 
-	  {val => \$u{shell}, list => \@shells, not_edit => !$::expert},
+        [ \$u->{realname}, \$u->{name}, 
+	  {val => \$u->{password}, hidden => 1}, {val => \$u->{password2}, hidden => 1},
+	  {val => \$u->{shell}, list => \@shells, not_edit => !$::expert},
         ],
         focus_out => sub {
 	    $u{name} = lc first($u{realname} =~ /(\w+)/) if $_[0] eq 0;
 	},
         complete => sub {
-	    $u{password} eq $u{password2} or $o->ask_warn('', [ _("You must enter the same password"), _("Please try again") ]), return (1,2);
-	    (length $u{password} < 6) and $o->ask_warn('', _("This password is too simple")), return (1,1);
-	    $u{name} or $o->ask_warn('', _("Please give a user name")), return (1,0);
-	    $u{name} =~ /^[a-z0-9_-]+$/ or $o->ask_warn('', _("The user name must contain only lower cased letters, numbers, `-' and `_'")), return (1,0);
+	    $u->{password} eq $u->{password2} or $o->ask_warn('', [ _("You must enter the same password"), _("Please try again") ]), return (1,3);
+	    (length $u->{password} < 6) and $o->ask_warn('', _("This password is too simple")), return (1,2);
+	    $u->{name} or $o->ask_warn('', _("Please give a user name")), return (1,0);
+	    $u->{name} =~ /^[a-z0-9_-]+$/ or $o->ask_warn('', _("The user name must contain only lower cased letters, numbers, `-' and `_'")), return (1,0);
 	    return 0;
 	},
-    );
+    ) or return;
     install_steps::addUser($o);
     $o->{user} = {};
     goto &addUser if $::expert;
@@ -553,7 +574,6 @@ sub load_thiskind {
 sub setup_thiskind {
     my ($o, $type, $auto, $at_least_one) = @_;
     my @l = $o->load_thiskind($type);
-
     return if $auto && (@l || !$at_least_one);
     while (1) {
 	@l ?
@@ -561,12 +581,13 @@ sub setup_thiskind {
 			  [ _("Found %s %s interfaces", join(", ", map { $_->[0] } @l), $type),
 			    _("Do you have another one?") ], "No") :
 			      $o->ask_yesorno('', _("Do you have an %s interface?", $type), "No") or return;
-
+	    
 	my @r = $o->loadModule($type) or return;
 	push @l, \@r;
-    }
+	}
 }
 
+
 #-######################################################################################
 #- Wonderful perl :(
 #-######################################################################################
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index dc846f42b..2f3fb4c15 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -1,10 +1,11 @@
-
-
 package interactive;
 
 use diagnostics;
 use strict;
 
+#-######################################################################################
+#- misc imports
+#-######################################################################################
 use common qw(:common :functional);
 
 # heritate from this class and you'll get all made interactivity for same steps.
@@ -27,9 +28,10 @@ use common qw(:common :functional);
 # ask_from_listW should handle differently small lists and big ones.
 
 
-1;
-
 
+#-######################################################################################
+#- OO Stuff
+#-######################################################################################
 sub new($) {
     my ($type) = @_;
 
@@ -37,6 +39,9 @@ sub new($) {
 }
 
 
+#-######################################################################################
+#- Interactive functions
+#-######################################################################################
 sub ask_warn($$$) {
     my ($o, $title, $message) = @_;
     ask_from_list($o, $title, $message, [ _("Ok") ]);
@@ -100,7 +105,9 @@ sub ask_from_entries($$$$;$%) {
       [ map { $$_ } @$val ] : undef;
 
 }
-
+# can get a hash of callback: focus_out changed and complete
+# moreove if you pass a hash with a field list -> combo
+# if you pass a hash with a field hidden -> emulate stty -echo
 sub ask_from_entries_ref($$$$;$%) {
     my ($o, $title, $message, $l, $val, %callback) = @_;
     
@@ -109,8 +116,8 @@ sub ask_from_entries_ref($$$$;$%) {
 		     { if ((ref $_) eq "SCALAR") {
 			 { val => $_ }
 		     } else {
-			 @{$_->{list}} ?
-			   { (%{$_}, type => "list")} : {(%{$_})}
+			 ($_->{list} && @{$_->{list}}) ?
+			   { %{$_}, type => "list"} : $_
 		       }
 		   } @{$val} ];
 
@@ -138,3 +145,8 @@ sub kill {
     }
     $o->{before_killing} = @interactive::objects;
 }
+
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
+1; # 
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index c0582ea51..53528aac1 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -94,6 +94,7 @@ sub ask_from_entries_refW {
 	}
     } @{$val};
     my $ok      = $w->create_okcancel;
+
     sub comb_entry {
 	my ($entry, $ref) = @_;
 	($ref->{type} eq "list" && @{$ref->{list}}) ? $entry->entry : $entry
@@ -113,9 +114,8 @@ sub ask_from_entries_refW {
 
     for (my $i = 0; $i < $num_fields; $i++) {
 	my $ind = $i; #cos lexical bindings pb !!
-	my $entry = $entries[$i];
-	#changed callback
-	my $callback = sub {
+	my $entry = comb_entry($entries[$i], $val->[$i]);
+	my $changed_callback = sub {
 	    return if $ignore; #handle recursive deadlock
 	    &{$updates[$ind]};
 	    if ($hcallback{changed}) {
@@ -127,7 +127,7 @@ sub ask_from_entries_refW {
 	    };
 	};
 	if ($hcallback{focus_out}) {
-	    my $callfocusout = sub {
+	    my $focusout_callback = sub {
 		return if $ignore;
 		&{$hcallback{focus_out}}($ind);
 		#update all the value
@@ -135,16 +135,26 @@ sub ask_from_entries_refW {
 		foreach (@updates_inv) { &{$_};}
 		$ignore = 0;
 	    };
-	    comb_entry($entry,$val->[$i])->signal_connect(focus_out_event => $callfocusout);
+	    $entry->signal_connect(focus_out_event => $focusout_callback);
 	}
-	comb_entry($entry,$val->[$i])->signal_connect(changed => $callback);
-	comb_entry($entry,$val->[$i])->signal_connect(activate => sub {
-				   ($ind == ($num_fields -1)) ?
-				     ($w->{ok}->grab_focus(), ) : (comb_entry($entries[$ind+1],$val->[$ind+1])->grab_focus(),$_[0]->signal_emit_stop("activate")) ;
-			       });
-	comb_entry($entry,$val->[$i])->set_text(${$val->[$i]{val}})  if ${$val->[$i]{val}};
-	comb_entry($entry,$val->[$i])->set_visibility(0) if $l->[$i] =~ /password/i;
-#	&{$updates[$i]};
+	$entry->signal_connect(changed => $changed_callback);
+	my $go_to_next = sub {
+	    if ($ind == ($num_fields -1)) {
+		$w->{ok}->grab_focus();
+	    } else {
+		comb_entry($entries[$ind+1],$val->[$ind+1])->grab_focus();
+	    }
+	};
+	$entry->signal_connect(activate => $go_to_next);
+	$entry->signal_connect(key_press_event => sub {
+	   my ($w, $e) = @_;
+	   my $c = chr $e->{keyval};
+	   &$go_to_next if $c eq "\x8d";
+	   });
+	
+	$entry->set_text(${$val->[$i]{val}})  if ${$val->[$i]{val}};
+	$entry->set_visibility(0) if $val->[$i]{hidden};
+	&{$updates[$i]};
     }
 
     my @entry_list = mapn { [($_[0], $_[1])]} $l, \@entries;
@@ -155,7 +165,6 @@ sub ask_from_entries_refW {
 		   create_packtable({}, @entry_list),
 		   $ok
 		   ));
-
     comb_entry($entries[0],$val->[0])->grab_focus();
     if ($hcallback{complete}) {
 	my $callback = sub {
@@ -175,8 +184,6 @@ sub ask_from_entries_refW {
     } else {
 	$w->main();
     }
-
-
 }
 
 
diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
index fad61f667..8bd75bbf3 100644
--- a/perl-install/keyboard.pm
+++ b/perl-install/keyboard.pm
@@ -1,14 +1,21 @@
+
 package keyboard;
 
 use diagnostics;
 use strict;
 
+#-######################################################################################
+#- misc imports
+#-######################################################################################
 use common qw(:common :system :file);
 use run_program;
 use log;
 use c;
 
 
+#-######################################################################################
+#- Globals
+#-######################################################################################
 my $KMAP_MAGIC = 0x8B39C07F;
 
 my %lang2keyboard =
@@ -16,9 +23,6 @@ my %lang2keyboard =
   "en" => "us",
 );
 
-1;
-
-
 # [1] = name for loadkeys, [2] = extension for Xmodmap
 my %keyboards = (
 # armenian xmodmap have to be checked...
@@ -60,6 +64,9 @@ my %keyboards = (
  "yu" => [ __("Yugoslavian (latin layout)"), "yu-latin2", "yu" ],
 );
 
+#-######################################################################################
+#- Functions
+#-######################################################################################
 sub list { map { $_->[0] } values %keyboards }
 sub xmodmaps { map { $_->[2] } values %keyboards }
 sub keyboard2text { $keyboards{$_[0]} && $keyboards{$_[0]}[0] }
@@ -142,3 +149,8 @@ sub read($) {
     }
     die "empty keyboard configuration file";
 }
+
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
+1; # 
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index 1fd767a02..d7a5c1eb8 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -3,10 +3,16 @@
 use diagnostics;
 use strict;
 
+#-######################################################################################
+#- misc imports
+#-######################################################################################
 use common qw(:file);
 use commands;
 use log;
 
+#-######################################################################################
+#- Globals
+#-######################################################################################
 # key (to be used in $LC_ALL), [0] = english name, [1] = charset encoding,
 # [2] = value for $LANG, [3] = value for LANGUAGE (a list of possible
 # languages, carefully choosen)
@@ -88,7 +94,9 @@ my %charsets = (
 	"*-helvetica-medium-r-normal--14-*-*-*-*-viscii1.1-1" ],
 );
 
-1;
+#-######################################################################################
+#- Functions
+#-######################################################################################
 
 sub list { map { $_->[0] } values %languages }
 sub lang2text { $languages{$_[0]} && $languages{$_[0]}[0] }
@@ -164,3 +172,8 @@ sub load_font {
     log::l("fontset: " . $fontSet);
 #    Gtk::Gdk::Font::fontset_load("*",$fontSet);
 }
+
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
+1; # 
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 5222e72dc..6124c11b0 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -353,19 +353,22 @@ sub get_stage1_conf {
 
 sub load_thiskind($;&) {
     my ($type, $f) = @_;
-
-    my @devs = pci_probing::main::probe($type);
-    log::l("pci probe found " . scalar @devs . " $type devices");
-
-    my %devs; foreach (@devs) {
-	my ($text, $mod) = @$_;
-	$devs{$mod}++ and log::l("multiple $mod devices found"), next;
-	$drivers{$mod} or log::l("module $mod not in install table"), next;
-	log::l("found driver for $mod");
-	&$f($text, $mod) if $f; 
-	load($mod, $type);
+    unless ($::testing) {
+	my @devs = pci_probing::main::probe($type);
+	log::l("pci probe found " . scalar @devs . " $type devices");
+	
+	my %devs; foreach (@devs) {
+	    my ($text, $mod) = @$_;
+	    $devs{$mod}++ and log::l("multiple $mod devices found"), next;
+	    $drivers{$mod} or log::l("module $mod not in install table"), next;
+	    log::l("found driver for $mod");
+	    &$f($text, $mod) if $f; 
+	    load($mod, $type);
+	}
+	@devs;
+    } else {
+	();
     }
-    @devs;
 }
 
 # This assumes only one of each driver type is loaded
diff --git a/perl-install/network.pm b/perl-install/network.pm
index 1234dcce2..cc5c74fa6 100644
--- a/perl-install/network.pm
+++ b/perl-install/network.pm
@@ -3,15 +3,18 @@ package network;
 use diagnostics;
 use strict;
 
+#-######################################################################################
+#- misc imports
+#-######################################################################################
 use Socket;
 
 use common qw(:common :file :system :functional);
 use detect_devices;
 use log;
 
-1;
-
-
+#-######################################################################################
+#- Functions
+#-######################################################################################
 sub read_conf {
     my ($file) = @_;
     my %netc = getVarsFromSh($file);
@@ -138,7 +141,61 @@ sub findIntf {
     push @$intf, $l = { DEVICE => $device } unless $l;
     $l;
 }
-
+#PAD \s* a la fin
+my $ip_regexp = qr/(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
 sub is_ip {
-    $_[0] =~ /^(\d{1,3}\.){3}\d{1,3}$/;
+    my ($ip) = @_;
+    return 0 unless $ip =~ $ip_regexp;
+    my @fields = ($1, $2, $3, $4);
+    foreach (@fields) {
+	return 0 if $_ < 0 || $_ > 255;
+    }
+    return 1;
+}
+
+sub netmask {
+    my ($ip) = @_;
+    return "255.255.255.0" unless is_ip($ip);
+    $ip =~ $ip_regexp;
+    if ($1 >= 1 && $1 < 127) {
+	return "255.0.0.0";    #1.0.0.0 to 127.0.0.0
+    } elsif ($1  >= 128 && $1 <= 191 ){
+	return "255.255.0.0";  #128.0.0.0 to 191.255.0.0
+    } elsif ($1 >= 192 && $1 <= 223) {
+	return "255.255.255.0";
+    } else {
+	return "255.255.255.255"; #experimental classes
+    }
 }
+
+sub masked_ip {
+    my ($ip) = @_;
+    return "" unless is_ip($ip);
+    my @mask = netmask($ip) =~ $ip_regexp;
+    my @ip   = $ip          =~ $ip_regexp;
+    for (my $i = 0; $i < @ip; $i++) {
+	$ip[$i] &= int $mask[$i];
+    }
+    join(".", @ip);
+}
+
+sub dns {
+    my ($ip) = @_;
+    my $mask = masked_ip($ip);
+    my @masked = masked_ip($ip) =~ $ip_regexp;
+    $masked[3]  = 12;
+    join (".", @masked);
+    
+}
+sub gateway {
+    my ($ip) = @_;
+    my @masked = masked_ip($ip) =~ $ip_regexp;
+    $masked[3]  = 1;
+    join (".", @masked);
+    
+}
+
+#-######################################################################################
+#- Wonderful perl :(
+#-######################################################################################
+1; # 
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index 2ea70fe8e..37f0d61c3 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -460,17 +460,17 @@ sub configure_queue($) {
 
     if ($entry->{TYPE} eq "SMB") {
 	#- simple config file required if SMB printer
-	my $config_file = "$prefix$queue_path.config";
+	my $config_file = "$prefix$queue_path/.config";
 	local *F;
 	open F, ">$config_file" or die "Can't create $config_file $!";
 	print F "share='\\\\$entry->{SMBHOST}\\$entry->{SMBSHARE}'\n";
-	print F "hostip='$entry->{SMBHOSTIP}'\n";
+	print F "hostip=$entry->{SMBHOSTIP}\n";
 	print F "user='$entry->{SMBUSER}'\n";
 	print F "password='$entry->{SMBPASSWD}'\n";
 	print F "workgroup='$entry->{SMBWORKGROUP}'\n";
     } elsif ($entry->{TYPE} eq "NCP") {
 	#- same for NCP printer
-	my $config_file = "$prefix$queue_path.config";
+	my $config_file = "$prefix$queue_path/.config";
 	local *F;
 	open F, ">$config_file" or die "Can't create $config_file $!";
 	print F "server=$entry->{NCPHOST}\n";
diff --git a/perl-install/share/po/no.po b/perl-install/share/po/no.po
index b2fbc6a6c..27a354697 100644
--- a/perl-install/share/po/no.po
+++ b/perl-install/share/po/no.po
author	pad <pad@mandriva.com>	1999-09-06 20:33:18 +0000
committer	pad <pad@mandriva.com>	1999-09-06 20:33:18 +0000
commit	115b4b1145f86d90f20c0404a54fa907f06c30b0 (patch)
tree	046cd13affb85df1028bcc687e1c8853fc576cd7 /perl-install
parent	a6096f902a2df839b7e89c084d629840bf52a3a1 (diff)
download	drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.tar drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.tar.gz drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.tar.bz2 drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.tar.xz drakx-115b4b1145f86d90f20c0404a54fa907f06c30b0.zip