Let command line tools for network scanning run under "chroot $refix", otherwise they take ages during installation.

Moved network scanning functions from "detect_devices.pm" to "printer.pm" so that they have access to the "$prefix" variable.

3 files changed, 251 insertions, 245 deletions

diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 5f20432a2..634b4fe6c 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -584,256 +584,13 @@ sub whatUsbport() {
     @res;
 }
 
-sub getSNMPModel {
-
-    my ($host) = @_;
-    my $manufacturer = "";
-    my $model = "";
-    my $description = "";
-    my $serialnumber = "";
-    
-    # SNMP request to auto-detect model
-    local *F;
-    open F, "scli -1 -c \"show printer info\" $host |" ||
-	return { CLASS => 'PRINTER',
-		 MODEL => _("Unknown Model"),
-		 MANUFACTURER => "",
-		 DESCRIPTION => "",
-		 SERIALNUMBER => ""
-		 };
-    while (my $l = <F>) {
-	chomp $l;
-	if (($l =~ /^\s*Manufacturer:\s*(\S.*)$/i) &&
-	    ($l =~ /^\s*Vendor:\s*(\S.*)$/i)) {
-	    $manufacturer = $1;
-	    $manufacturer =~ s/Hewlett[-\s_]Packard/HP/;
-	    $manufacturer =~ s/HEWLETT[-\s_]PACKARD/HP/;
-	} elsif ($l =~ /^\s*Model:\s*(\S.*)$/i) {
-	    $model = $1;
-	} elsif ($l =~ /^\s*Description:\s*(\S.*)$/i) {
-	    $description = $1;
-	    $description =~ s/Hewlett[-\s_]Packard/HP/;
-	    $description =~ s/HEWLETT[-\s_]PACKARD/HP/;
-	} elsif ($l =~ /^\s*Serial\s*Number:\s*(\S.*)$/i) {
-	    $serialnumber = $1;
-	}
-    }
-    close F;
-
-    # Was there a manufacturer and a model in the output?
-    # If not, get them from the description
-    if (($manufacturer eq "") || ($model eq "")) {
-	if ($description =~ /^\s*(\S*)\s+(\S.*)$/) {
-	    if ($manufacturer eq "") {
-		$manufacturer = $1;
-	    }
-	    if ($model eq "") {
-		$model = $2;
-	    }
-	}
-	# No description field? Make one out of manufacturer and model.
-    } elsif ($description eq "") {
-	$description = "$manufacturer $model";
-    }
-    
-    # We couldn't determine a model
-    if ($model eq "") {
-	$model = _("Unknown Model");
-    }
-    
-    # Remove trailing spaces
-    $manufacturer =~ s/(\S+)\s+$/$1/;
-    $model =~ s/(\S+)\s+$/$1/;
-    $description =~ s/(\S+)\s+$/$1/;
-    $serialnumber =~ s/(\S+)\s+$/$1/;
-
-    # Now we have all info for one printer
-    # Store this auto-detection result in the data structure
-    return  { CLASS => 'PRINTER',
-	      MODEL => $model,
-	      MANUFACTURER => $manufacturer,
-	      DESCRIPTION => $description,
-	      SERIALNUMBER => $serialnumber
-	      };
-}
-
-sub getSMBPrinterShares {
-
-    my ($host) = @_;
-    
-    # SMB request to auto-detect shares
-    local *F;
-    open F, "export LC_ALL=\"C\"; smbclient -N -L $host |" || return ();
-    my $insharelist = 0;
-    my @shares;
-    while (my $l = <F>) {
-	chomp $l;
-	if ($l =~ /^\s*Sharename\s+Type\s+Comment\s*$/i) {
-	    $insharelist = 1;
-	} elsif ($l =~ /^\s*Server\s+Comment\s*$/i) {
-	    $insharelist = 0;
-	} elsif (($l =~ /^\s*(\S+)\s+Printer\s*(.*)$/i) &&
-		 ($insharelist)) {
-	    my $name = $1;
-	    my $description = $2;
-	    $description =~ s/^(\s*)//;
-	    push (@shares, { name => $name, description => $description });
-	}
-    }
-    close F;
-
-    return @shares;
-}
-
-sub getIPsInLocalNetworks {
-
-    # subroutine determines the list of all hosts reachable in the local
-    # networks by means of pinging the broadcast addresses.
-    
-    # Read the output of "ifconfig" to determine the broadcast addresses of
-    # the local networks
-    my $dev_is_localnet = 0;
-    my @local_bcasts;
-    my $current_bcast = "";
-	
-    local *IFCONFIG_OUT;
-    open IFCONFIG_OUT, "export LC_ALL=C; ifconfig |" or return ();
-    while (my $readline = <IFCONFIG_OUT>) {
-	# New entry ...
-	if ($readline =~ /^(\S+)\s/) {
-	    my $dev = $1;
-	    # ... for a local network (eth = ethernet, 
-	    #     vmnet = VMWare,
-	    #     ethernet card connected to ISP excluded)?
-	    $dev_is_localnet = (($dev =~ /^eth/) || ($dev =~ /^vmnet/));
-	    # delete previous address
-	    $current_bcast = "";
-	}
-	# Are we in the important line now?
-	if ($readline =~ /\sBcast:([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\s/) {
-	    # Rip out the broadcast IP address
-	    $current_bcast = $1;
-	    
-	    # Are we in an entry for a local network?
-	    if ($dev_is_localnet == 1) {
-		# Store current IP address
-		push @local_bcasts, $current_bcast;
-	    }
-	}
-    }
-    close(IFCONFIG_OUT);
-
-    my @addresses;
-    # Now ping all broadcast addresses 
-    for my $bcast (@local_bcasts) {
-	local *F;
-	open F, "export LC_ALL=C; ping -w 1 -b -n $bcast | cut -f 4 -d \" \" | sed s/:// | egrep \"^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\" | uniq |" or next;
-	while (<F>) { chomp; push @addresses, $_ }
-	close F;
-    }
-
-    @addresses;
-}
-
-sub whatNetPrinter {
-
-    my ($network, $smb) = @_;
-
-    my $i; 
-    my @res;
-
-    # Which ports should be scanned?
-    my @portstoscan;
-    if ($smb) {
-	push @portstoscan, "139";
-    }
-    if ($network) {
-	push @portstoscan, "4010", "4020", "4030", "5503", "9100-9104";
-    }
-    return () if $#portstoscan < 0;
-    my $portlist = join (",", @portstoscan);
-    
-    # Which hosts should be scanned?
-    # (Applying nmap to a whole network is very time-consuming, because nmap
-    #  waits for a certain timeout period on non-existing hosts, so we get a 
-    #  lists of existing hosts by pinging the broadcast addresses for existing
-    #  hosts and then scanning only them, which is much faster)
-    my @hostips = getIPsInLocalNetworks();
-    return () if $#hostips < 0;
-    my $hostlist = join (" ", @hostips);
-
-    # Scan network for printers
-    local *F;
-    open F, "export LC_ALL=\"C\"; nmap -p $portlist $hostlist |" ||
-	return @res;
-    my $host = "";
-    my $ip = "";
-    my $port = "";
-    my $modelinfo = "";
-    while (my $line = <F>) {
-	chomp $line;
-
-	# head line of the report of a host with the ports in question open
-	#if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\(([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\)\s*:\s*$/i) {
-	if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\((\S+)\)\s*:\s*$/i) {
-	    $host = $1;
-	    $ip = $2;
-	    if ($host eq "") {
-		$host = $ip;
-	    }
-	    $port = "";
-
-	    undef $modelinfo;
-
-	} elsif ($line =~ m/^\s*(\d+)\/\S+\s+open\s+/i) {
-	    next if ($ip eq "");
-	    $port = $1;
-	    
-	    # Now we have all info for one printer
-	    # Store this auto-detection result in the data structure
-
-	    # Determine the protocol by the port number
-
-	    # SMB/Windows
-	    if ($port eq "139") {
-		my @shares = getSMBPrinterShares($ip);
-		for my $share (@shares) {
-		    push @res, { port => "smb://$host/$share->{name}",
-				 val => { CLASS => 'PRINTER',
-					  MODEL => _("Unknown Model"),
-					  MANUFACTURER => "",
-					  DESCRIPTION =>
-					      "$share->{description}",
-					  SERIALNUMBER => ""
-				      }
-			     };
-		}
-	    } else {
-		if (!defined($modelinfo)) {
-		    # SNMP request to auto-detect model
-		    $modelinfo = getSNMPModel ($ip);
-		}
-		if (defined($modelinfo)) {
-		    push @res, { port => "socket://$host:$port",
-				 val => $modelinfo
-				 };
-		}
-	    }
-	}
-    }
-    close F;
-    @res;
-}
-
 #-CLASS:PRINTER;
 #-MODEL:HP LaserJet 1100;
 #-MANUFACTURER:Hewlett-Packard;
 #-DESCRIPTION:HP LaserJet 1100 Printer;
 #-COMMAND SET:MLC,PCL,PJL;
 sub whatPrinter {
-    my ($local, $network, $smb) = @_;
-    my @res = (($local ? (whatParport(), whatUsbport()) : ()), 
-	       ($network || $smb ? whatNetPrinter($network,$smb) : ()));
+    my @res = (whatParport(), whatUsbport());
     grep { $_->{val}{CLASS} eq "PRINTER"} @res;
 }
 
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index 2f77b70db..622c85bbc 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -308,6 +308,253 @@ sub network_running {
     return 0;
 }
 
+sub getSNMPModel {
+
+    my ($host) = @_;
+    my $manufacturer = "";
+    my $model = "";
+    my $description = "";
+    my $serialnumber = "";
+    
+    # SNMP request to auto-detect model
+    local *F;
+    open F, ($::testing ? $prefix : "chroot $prefix/ ") .
+	"/bin/sh -c \"scli -1 -c 'show printer info' $host\" |" ||
+	return { CLASS => 'PRINTER',
+		 MODEL => _("Unknown Model"),
+		 MANUFACTURER => "",
+		 DESCRIPTION => "",
+		 SERIALNUMBER => ""
+		 };
+    while (my $l = <F>) {
+	chomp $l;
+	if (($l =~ /^\s*Manufacturer:\s*(\S.*)$/i) &&
+	    ($l =~ /^\s*Vendor:\s*(\S.*)$/i)) {
+	    $manufacturer = $1;
+	    $manufacturer =~ s/Hewlett[-\s_]Packard/HP/;
+	    $manufacturer =~ s/HEWLETT[-\s_]PACKARD/HP/;
+	} elsif ($l =~ /^\s*Model:\s*(\S.*)$/i) {
+	    $model = $1;
+	} elsif ($l =~ /^\s*Description:\s*(\S.*)$/i) {
+	    $description = $1;
+	    $description =~ s/Hewlett[-\s_]Packard/HP/;
+	    $description =~ s/HEWLETT[-\s_]PACKARD/HP/;
+	} elsif ($l =~ /^\s*Serial\s*Number:\s*(\S.*)$/i) {
+	    $serialnumber = $1;
+	}
+    }
+    close F;
+
+    # Was there a manufacturer and a model in the output?
+    # If not, get them from the description
+    if (($manufacturer eq "") || ($model eq "")) {
+	if ($description =~ /^\s*(\S*)\s+(\S.*)$/) {
+	    if ($manufacturer eq "") {
+		$manufacturer = $1;
+	    }
+	    if ($model eq "") {
+		$model = $2;
+	    }
+	}
+	# No description field? Make one out of manufacturer and model.
+    } elsif ($description eq "") {
+	$description = "$manufacturer $model";
+    }
+    
+    # We couldn't determine a model
+    if ($model eq "") {
+	$model = _("Unknown Model");
+    }
+    
+    # Remove trailing spaces
+    $manufacturer =~ s/(\S+)\s+$/$1/;
+    $model =~ s/(\S+)\s+$/$1/;
+    $description =~ s/(\S+)\s+$/$1/;
+    $serialnumber =~ s/(\S+)\s+$/$1/;
+
+    # Now we have all info for one printer
+    # Store this auto-detection result in the data structure
+    return  { CLASS => 'PRINTER',
+	      MODEL => $model,
+	      MANUFACTURER => $manufacturer,
+	      DESCRIPTION => $description,
+	      SERIALNUMBER => $serialnumber
+	      };
+}
+
+sub getSMBPrinterShares {
+
+    my ($host) = @_;
+    
+    # SMB request to auto-detect shares
+    local *F;
+    open F, ($::testing ? "" : "chroot $prefix/ ") .
+	"/bin/sh -c \"export LC_ALL=C; smbclient -N -L $host\" |" || return ();
+    my $insharelist = 0;
+    my @shares;
+    while (my $l = <F>) {
+	chomp $l;
+	if ($l =~ /^\s*Sharename\s+Type\s+Comment\s*$/i) {
+	    $insharelist = 1;
+	} elsif ($l =~ /^\s*Server\s+Comment\s*$/i) {
+	    $insharelist = 0;
+	} elsif (($l =~ /^\s*(\S+)\s+Printer\s*(.*)$/i) &&
+		 ($insharelist)) {
+	    my $name = $1;
+	    my $description = $2;
+	    $description =~ s/^(\s*)//;
+	    push (@shares, { name => $name, description => $description });
+	}
+    }
+    close F;
+
+    return @shares;
+}
+
+sub getIPsInLocalNetworks {
+
+    # subroutine determines the list of all hosts reachable in the local
+    # networks by means of pinging the broadcast addresses.
+    
+    # Read the output of "ifconfig" to determine the broadcast addresses of
+    # the local networks
+    my $dev_is_localnet = 0;
+    my @local_bcasts;
+    my $current_bcast = "";
+	
+    local *IFCONFIG_OUT;
+    open IFCONFIG_OUT, ($::testing ? "" : "chroot $prefix/ ") .
+	"/bin/sh -c \"export LC_ALL=C; ifconfig\" |" or return ();
+    while (my $readline = <IFCONFIG_OUT>) {
+	# New entry ...
+	if ($readline =~ /^(\S+)\s/) {
+	    my $dev = $1;
+	    # ... for a local network (eth = ethernet, 
+	    #     vmnet = VMWare,
+	    #     ethernet card connected to ISP excluded)?
+	    $dev_is_localnet = (($dev =~ /^eth/) || ($dev =~ /^vmnet/));
+	    # delete previous address
+	    $current_bcast = "";
+	}
+	# Are we in the important line now?
+	if ($readline =~ /\sBcast:([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\s/) {
+	    # Rip out the broadcast IP address
+	    $current_bcast = $1;
+	    
+	    # Are we in an entry for a local network?
+	    if ($dev_is_localnet == 1) {
+		# Store current IP address
+		push @local_bcasts, $current_bcast;
+	    }
+	}
+    }
+    close(IFCONFIG_OUT);
+
+    my @addresses;
+    # Now ping all broadcast addresses 
+    for my $bcast (@local_bcasts) {
+	local *F;
+	open F, ($::testing ? "" : "chroot $prefix/ ") . 
+	    "/bin/sh -c \"export LC_ALL=C; ping -w 1 -b -n $bcast | cut -f 4 -d ' ' | sed s/:// | egrep '^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+' | uniq\" |" 
+	    or next;
+	while (<F>) { chomp; push @addresses, $_ }
+	close F;
+    }
+
+    @addresses;
+}
+
+sub whatNetPrinter {
+
+    my ($network, $smb) = @_;
+
+    my $i; 
+    my @res;
+
+    # Which ports should be scanned?
+    my @portstoscan;
+    if ($smb) {
+	push @portstoscan, "139";
+    }
+    if ($network) {
+	push @portstoscan, "4010", "4020", "4030", "5503", "9100-9104";
+    }
+    return () if $#portstoscan < 0;
+    my $portlist = join (",", @portstoscan);
+    
+    # Which hosts should be scanned?
+    # (Applying nmap to a whole network is very time-consuming, because nmap
+    #  waits for a certain timeout period on non-existing hosts, so we get a 
+    #  lists of existing hosts by pinging the broadcast addresses for existing
+    #  hosts and then scanning only them, which is much faster)
+    my @hostips = getIPsInLocalNetworks();
+    return () if $#hostips < 0;
+    my $hostlist = join (" ", @hostips);
+
+    # Scan network for printers
+    local *F;
+    open F, ($::testing ? "" : "chroot $prefix/ ") .
+	"/bin/sh -c \"export LC_ALL=C; nmap -r -P0 -p $portlist $hostlist\" |"
+	|| return @res;
+    my $host = "";
+    my $ip = "";
+    my $port = "";
+    my $modelinfo = "";
+    while (my $line = <F>) {
+	chomp $line;
+
+	# head line of the report of a host with the ports in question open
+	#if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\(([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\)\s*:\s*$/i) {
+	if ($line =~ m/^\s*Interesting\s+ports\s+on\s+(\S*)\s*\((\S+)\)\s*:\s*$/i) {
+	    $host = $1;
+	    $ip = $2;
+	    if ($host eq "") {
+		$host = $ip;
+	    }
+	    $port = "";
+
+	    undef $modelinfo;
+
+	} elsif ($line =~ m/^\s*(\d+)\/\S+\s+open\s+/i) {
+	    next if ($ip eq "");
+	    $port = $1;
+	    
+	    # Now we have all info for one printer
+	    # Store this auto-detection result in the data structure
+
+	    # Determine the protocol by the port number
+
+	    # SMB/Windows
+	    if ($port eq "139") {
+		my @shares = getSMBPrinterShares($ip);
+		for my $share (@shares) {
+		    push @res, { port => "smb://$host/$share->{name}",
+				 val => { CLASS => 'PRINTER',
+					  MODEL => _("Unknown Model"),
+					  MANUFACTURER => "",
+					  DESCRIPTION =>
+					      "$share->{description}",
+					  SERIALNUMBER => ""
+				      }
+			     };
+		}
+	    } else {
+		if (!defined($modelinfo)) {
+		    # SNMP request to auto-detect model
+		    $modelinfo = getSNMPModel ($ip);
+		}
+		if (defined($modelinfo)) {
+		    push @res, { port => "socket://$host:$port",
+				 val => $modelinfo
+				 };
+		}
+	    }
+	}
+    }
+    close F;
+    @res;
+}
+
 sub spooler_in_security_level {
     # Was the current spooler already added to the current security level?
     my ($spooler, $level) = @_;
diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm
index 95a64750b..00b4bbab7 100644
--- a/perl-install/printerdrake.pm
+++ b/perl-install/printerdrake.pm
@@ -164,7 +164,9 @@ sub auto_detect {
     }
     my $b = before_leaving { eval { modules::unload("parport_probe") } }
     if $local;
-    detect_devices::whatPrinter($local, $network, $smb);
+    my @res = (($local ? detect_devices::whatPrinter() : ()), 
+	       ($network || $smb ? printer::whatNetPrinter($network,$smb) : ()));
+    @res;
 }
 
 sub wizard_welcome {