1 files changed, 224 insertions, 52 deletions

diff --git a/perl-install/scanner.pm b/perl-install/scanner.pm
index e192ac42a..777f7192f 100755..100644
--- a/perl-install/scanner.pm
+++ b/perl-install/scanner.pm
@@ -1,7 +1,7 @@
 package scanner;
-# scanner.pm $Id$
-# Yves Duret <yduret at mandrakesoft.com>
-# Copyright (C) 2001-2002 MandrakeSoft
+# Yves Duret <yduret at mandriva.com>
+# Till Kamppeter <till at mandriva.com>
+# Copyright (C) 2001-2008 Mandriva
 #
 # 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
@@ -19,7 +19,6 @@ package scanner;
 #
 # pbs/TODO:
 # - scsi mis-configuration (should work better now)
-# - devfs use dev_is_devfs()
 # - with 2 scanners same manufacturer -> will overwrite previous conf -> only 1 conf !! (should work now)
 # - lp: see printerdrake
 # - install: prefix --> done (partially)
@@ -34,8 +33,8 @@ my $scannerDBdir = "$::prefix$ENV{SHARE_PATH}/ldetect-lst";
 our $scannerDB = readScannerDB("$scannerDBdir/ScannerDB");
 
 sub confScanner {
-    my ($model, $port, $vendor, $product) = @_;
-    $port ||= detect_devices::dev_is_devfs() ? "$::prefix/dev/usb/scanner0" : "$::prefix/dev/scanner";
+    my ($model, $port, $vendor, $product, $firmware) = @_;
+    $port ||= "/dev/scanner";
     my $a = $scannerDB->{$model}{server};
     #print "file:[$a]\t[$model]\t[$port]\n| ", (join "\n| ", @{$scannerDB->{$model}{lines}}),"\n";
     my @driverconf = cat_("$sanedir/$a.conf");
@@ -47,11 +46,13 @@ sub confScanner {
 	next if $line =~ /\$VENDOR/;
 	$line =~ s/\$PRODUCT/$product/g if $product;
 	next if $line =~ /\$PRODUCT/;
+	$line =~ s/\$FIRMWARE/$firmware/g if $firmware;
+	next if $line =~ /\$FIRMWARE/;
 	my $linetype;
 	if ($line =~ /^(\S*)LINE\s+(.*?)$/) {
-         $linetype = $1;
-         $line = $2;
-     }
+	    $linetype = $1;
+	    $line = $2;
+	}
 	next if !$line;
 	if (!$linetype ||
 	    ($linetype eq "USB" && ($port =~ /usb/i || $vendor)) ||
@@ -60,6 +61,8 @@ sub confScanner {
 	    ($linetype eq "SCSI" && !$vendor &&
 	     $port =~ m!(/sg|scsi|/scanner)!i)) {
 	    handle_configs::set_directive(\@driverconf, $line, 1);
+	} elsif ($linetype eq "FIRMWARE" && $firmware) {
+	    handle_configs::set_directive(\@driverconf, $line, 0);
 	}
     }
     output("$sanedir/$a.conf", @driverconf);
@@ -73,12 +76,60 @@ sub add2dll {
     output("$sanedir/dll.conf", @dllconf);
 }
 
-sub configured() {
+sub setfirmware {
+    my ($backend, $firmwareline) = @_;
+    my @driverconf = cat_("$sanedir/$backend.conf");
+    handle_configs::set_directive(\@driverconf, $firmwareline, 0);
+    output("$sanedir/$backend.conf", @driverconf);
+}
+
+sub installfirmware {
+    # Install the firmware file in /usr/share/sane/firmware
+    my ($firmware, $backend) = @_;
+    return "" if !$firmware;
+    $in ||= interactive->vnew;
+    # Install firmware
+    run_program::rooted($::prefix, "mkdir", "-p",
+			"/usr/share/sane/firmware") or do {
+			    $in->ask_warn(N("Error"),
+					  N("Could not create directory /usr/share/sane/firmware!"));
+			    return "";
+			};
+    # Link /usr/share/sane/firmware to /usr/share/sane/<backend name> as
+    # some backends ignore the supplied absolute path to the firmware file
+    # and always search their own directory
+    if ($backend) {
+	run_program::rooted($::prefix, "ln", "-sf",
+			    "/usr/share/sane/firmware",
+			    "/usr/share/sane/$backend") or do {
+				$in->ask_warn(N("Error"),
+					      N("Could not create link /usr/share/sane/%s!", $backend));
+				return "";
+			    };
+    }
+    run_program::rooted($::prefix, "cp", "-f", $firmware,
+			"/usr/share/sane/firmware") or do {
+			    $in->ask_warn(N("Error"),
+					  N("Could not copy firmware file %s to /usr/share/sane/firmware!", $firmware));
+			    return "";
+			};
+    $firmware =~ s!^(.*)(/[^/]+)$!/usr/share/sane/firmware$2!;
+    run_program::rooted($::prefix, "chmod", "644",
+			$firmware) or do {
+			    $in->ask_warn(N("Error"),
+					  N("Could not set permissions of firmware file %s!", $firmware));
+			    return "";
+			};
+    return $firmware;
+}
+
+sub configured {
+    my ($in) = @_;
     my @res;
+    my $parportscannerfound = 0;
     # Run "scanimage -L", to find the scanners which are already working
-    local *LIST;
-    open LIST, "LC_ALL=C scanimage -L |";
-    while (my $line = <LIST>) {
+    open my $LIST, "LC_ALL=C scanimage -L |";
+    while (my $line = <$LIST>) {
 	if ($line =~ /^\s*device\s*`([^`']+)'\s+is\s+a\s+(\S.*)$/) {
 	    # Extract port and description
 	    my $port = $1;
@@ -86,28 +137,109 @@ sub configured() {
 	    # Remove duplicate scanners appearing through saned and the
 	    # "net" backend
 	    next if $port =~ /^net:(localhost|127.0.0.1):/;
+	    # Is the scanner hooked to a parallel or serial port?
+	    if ($port =~ /(parport|pt_drv|parallel|ttys)/i) {
+		$parportscannerfound = 1;
+	    }
+	    # Determine which SANE backend the scanner in question uses
+	    my $backend;
+            $backend = $1 if $port =~ /^([^:]+):/;
+	    # Does the scanner need a firmware file
+	    my $firmwareline = firmwareline($backend);
 	    # Store collected data
 	    push @res, { 
 		port => $port, 
 		val => { 
 		    DESCRIPTION => $description,
-		} 
+		    if_($backend, BACKEND => $backend),
+		    if_($firmwareline,
+		     FIRMWARELINE => $firmwareline),
+		}
 	    };
 	}
     }
-    close LIST;
+    close $LIST;
+    # We have a parallel port scanner, make it working for non-root users
+    nonroot_access_for_parport($parportscannerfound, $in);
     return @res;
 }
 
+sub nonroot_access_for_parport {
+
+    # This function configures a non-root access for parallel port
+    # scanners by running saned as root, exporting the scanner to
+    # localhost and letting the user's frontend use the "net" backend
+    # to access the scanner through the loopback network device.
+
+    # See also
+    # http://www.linuxprinting.org/download/digitalimage/Scanning-as-Normal-User-on-Wierd-Scanner-Mini-HOWTO.txt
+
+    # Desired state of this facility: 1: Enable, 0: Disable
+    my ($enable, $in) = @_;
+    # Is saned running?
+    my $sanedrunning = services::starts_on_boot("saned.socket");
+    # Is the "net" SANE backend active
+    my $netbackendactive = find { /^\s*net\s*$/ }
+      cat_("/etc/sane.d/dll.conf");
+    # Set this to 1 to tell the caller that the list of locally available
+    # scanners has changed (Here if the SANE client configuration has
+    # changed)
+    my $changed = 0;
+    my $importschanged = 0;
+    if ($enable) {
+	# Enable non-root access
+	
+	# Install/start saned
+	if (!$sanedrunning) {
+	    # Make sure saned is installed and running
+	    if (!files_exist('/usr/sbin/saned')) {
+		if (!$in->do_pkgs->install('saned')) {
+		    $in->ask_warn(N("Scannerdrake"),
+				  N("Could not install the packages needed to share your scanner(s).") . " " .
+				  N("Your scanner(s) will not be available for non-root users."));
+		}
+		return 0;
+	    }
+	}
+
+	# Read list of hosts to where to export the local scanners
+	my @exports = cat_("/etc/sane.d/saned.conf");
+	# Read list of hosts from where to import scanners
+	my @imports = cat_("/etc/sane.d/net.conf");
+	# Add "localhost" to the machines which saned exports
+	handle_configs::set_directive(\@exports, "localhost")
+	    if !member("localhost\n", @exports);
+	# Add "localhost" to the machines which "net" imports
+	handle_configs::set_directive(\@imports, "localhost")
+	    if !member("localhost\n", @imports);
+	# Write /etc/sane.d/saned.conf
+	output("/etc/sane.d/saned.conf", @exports);
+	# Write /etc/sane.d/net.conf
+	output("/etc/sane.d/net.conf", @imports);
+
+	# Make sure that the "net" backend is active
+	scanner::add2dll("net");
+	
+	# (Re)start saned and make sure that it gets started on
+	# every boot
+	services::enable("saned.socket");
+    }
+
+    return 1;
+}
+
 sub detect {
     my @configured = @_;
     my @res;
     # Run "sane-find-scanner", this also detects USB scanners which only
     # work with libusb.
-    local *DETECT;
-    open DETECT, "LC_ALL=C sane-find-scanner -q |";
-    while (my $line = <DETECT>) {
-	my ($vendorid, $productid, $make, $model, $description, $port);
+
+    my @devices = detect_devices::probeall();
+
+    open my $DETECT, "LC_ALL=C sane-find-scanner -q |";
+    while (my $line = <$DETECT>) {
+	my ($vendorid, $productid, $make, $model, $description, $port, $driver);
+	my $real_device;
 	if ($line =~ /^\s*found\s+USB\s+scanner/i) {
 	    # Found an USB scanner
 	    if ($line =~ /vendor=(0x[0-9a-f]+)[^0-9a-f\[]+[^\[]*\[([^\[\]]+)\].*prod(|uct)=(0x[0-9a-f]+)[^0-9a-f\[]+[^\[]*\[([^\[\]]+)\]/) {
@@ -123,11 +255,22 @@ sub detect {
 		$productid = $3;
 	    }
 	    if ($vendorid && $productid) {
+		my ($vendor) = $vendorid =~ /0x([0-9a-f]+)/;
+		my ($id) = $productid =~ /0x([0-9a-f]+)/;
+		my ($device) = grep { sprintf("%04x", $_->{vendor}) eq $vendor && sprintf("%04x", $_->{id}) eq $id } @devices;
+
+		if ($device) {
+		    $driver = $device->{driver};
+		    $real_device = $device;
+		} else {
+		    #warn "Failed to lookup $vendorid and $productid!\n";
+		}
+                 
 		# We have vendor and product ID, look up the scanner in
 		# the usbtable
-		foreach my $entry (cat_("$scannerDBdir/usbtable")) {
+		foreach my $entry (common::catMaybeCompressed("$scannerDBdir/usbtable")) {
 		    if ($entry =~ 
-			/^\s*$vendorid\s+$productid\s+.*\"([^\"]+)\"\s*$/) {
+			/^\s*$vendorid\s+$productid\s+.*"([^"]+)"\s*$/) {
 			$description = $1;
 			$description =~ s/Seiko\s+Epson/Epson/i;
 			if ($description =~ /^([^\|]+)\|(.*)$/) {
@@ -140,7 +283,7 @@ sub detect {
 	    }
 	} elsif ($line =~ /^\s*found\s+SCSI/i) {
 	    # SCSI scanner
-	    if ($line =~ /\"([^\"\s]+)\s+([^\"]+?)\s+([^\"\s]+)\"/) {
+	    if ($line =~ /"([^"\s]+)\s+([^"]+?)\s+([^"\s]+)"/) {
 		$make = $1;
 		$model = $2;
 		$description = "$make|$model";
@@ -183,10 +326,12 @@ sub detect {
 		DESCRIPTION => $description,
 		id => $productid,
 		vendor => $vendorid,
+		driver => $driver,
+		drakx_device => $real_device,
 	    } 
 	};
     }
-    close DETECT;
+    close $DETECT;
     if (@configured) {
 	# Remove scanners which are already working
 	foreach my $d (@res) {
@@ -205,7 +350,8 @@ sub detect {
 	}
 	@res = grep { ! $_->{configured} } @res;
     }
-    return @res;
+    # blacklist device that have a driver b/c of buggy sane-find-scanner:
+    return grep { member($_->{val}{driver}, qw(scanner unknown usbcore)) } @res;
 }
 
 sub resolve_symlinks {
@@ -223,7 +369,7 @@ sub resolve_symlinks {
 	return $file;
     }
     while (1) {
-	my $ls = `ls -l $file`;
+	my $ls = `ls -l $file 2> /dev/null`;
 	if ($ls =~ m!\s($file)\s*\->\s*(\S+)\s*$!) {
 	    my $target = $2;
 	    if ($target !~ m!^/! && $file =~ m!^(.*)/[^/]+$!) {
@@ -239,21 +385,19 @@ sub resolve_symlinks {
 
 sub get_usb_ids_for_port {
     my ($port) = @_;
-    local *DETECT;
     if ($port =~ /^\s*libusb:(\d+):(\d+)\s*$/) {
 	# Use "lsusb" to find the USB IDs
-	open DETECT, "LC_ALL=C lsusb -s $1:$2 |";
-	while (my $line = <DETECT>) {
+	open my $DETECT, "LC_ALL=C lsusb -s $1:$2 |";
+	while (my $line = <$DETECT>) {
 	    if ($line =~ /ID\s+([0-9a-f]+):(0x[0-9a-f]+)($|\s+)/) {
 		# Scanner connected via scanner.o kernel module
 		return "0x$1", "0x$2";
-		last;
 	    }
 	}
     } else {
 	# Run "sane-find-scanner" on the port
-	open DETECT, "LC_ALL=C sane-find-scanner -q $port |";
-	while (my $line = <DETECT>) {
+	open my $DETECT, "LC_ALL=C sane-find-scanner -q $port |";
+	while (my $line = <$DETECT>) {
 	    if ($line =~ /^\s*found\s+USB\s+scanner/i) {
 		if ($line =~ /vendor=(0x[0-9a-f]+)[^0-9a-f]+.*prod(|uct)=(0x[0-9a-f]+)[^0-9a-f]+/) {
 		    # Scanner connected via scanner.o kernel module
@@ -264,18 +408,46 @@ sub get_usb_ids_for_port {
     }
 }
 
+sub readconfiglinetemplates {
+    # Read templates for configuration file lines
+    my %configlines;
+    my $backend;
+    foreach my $line (cat_("$scannerDBdir/scannerconfigs")) {
+	chomp $line;
+	if ($line =~ /^\s*SERVER\s+(\S+)\s*$/) {
+	    $backend = $1;
+	} elsif ($backend) {
+	    push @{$configlines{$backend}}, $line;
+	}
+    }
+    return \%configlines;
+}
+
+sub firmwareline {
+    # Determine whether the given SANE backend supports a firmware file
+    # and return the line needed in the config file
+    my ($backend) = @_;
+    # Read templates for configuration file lines
+    my %configlines = %{readconfiglinetemplates()};
+    # Does the backend support a line for the firmware?
+    my @firmwarelines = (grep { s/^FIRMWARELINE // } @{$configlines{$backend}});
+    return join("\n", @firmwarelines);
+}
+
 sub readScannerDB {
     my ($file) = @_;
     my ($card, %cards);
 
     my $F = common::openFileMaybeCompressed($file);
 
-    my ($lineno, $cmd, $val) = 0;
+    my ($cmd, $val);
+    my $lineno = 0;
     my $fs = {
         LINE => sub { push @{$card->{lines}}, "LINE $val" },
         SCSILINE => sub { push @{$card->{lines}}, "SCSILINE $val" },
         USBLINE => sub { push @{$card->{lines}}, "USBLINE $val" },
         PARPORTLINE => sub { push @{$card->{lines}}, "PARPORTLINE $val" },
+        FIRMWARELINE => sub { push @{$card->{lines}}, "FIRMWARELINE $val" },
 	NAME => sub {
 	    #$cards{$card->{type}} = $card if ($card and !$card->{flags}{unsupported});
 	    $cards{$card->{type}} = $card if $card;
@@ -293,7 +465,13 @@ sub readScannerDB {
 	ASK => sub { $card->{ask} = $val },
 	SERVER => sub { $card->{server} = $val },
 	DRIVER => sub { $card->{driver} = $val },
+	KERNEL => sub { push(@{$card->{kernel}}, $val) },
+	SCSIKERNEL => sub { push(@{$card->{scsikernel}}, $val) },
+	USBKERNEL => sub { push(@{$card->{usbkernel}}, $val) },
+	PARPORTKERNEL => sub { push(@{$card->{parportkernel}}, $val) },
 	UNSUPPORTED => sub { $card->{flags}{unsupported} = 1 },
+	MANUAL => sub { $card->{flags}{manual} = 1 },
+	MANUALREQUIRED => sub { $card->{flags}{manual} = 2 },
 	COMMENT => sub {},
     };
 
@@ -316,8 +494,8 @@ sub updateScannerDBfromUsbtable() {
     foreach (cat_("$ENV{SHARE_PATH}/ldetect-lst/usbtable")) {
 	my ($vendor_id, $product_id, $mod, $name) = chomp_(split /\s/,$_,4);
 	next if $mod ne '"scanner"';
-	$name =~ s/\"(.*)\"$/$1/;
-	if (member($name, keys %$scanner::scannerDB)) {
+	$name =~ s/"(.*)"$/$1/;
+	if ($scanner::scannerDB->{$name}) {
 	    print "#[$name] already in ScannerDB!\n";
 	    next;
 	}
@@ -342,6 +520,7 @@ sub updateScannerDBfromSane {
 		   "Fujitsu Computer Products of America" => "Fujitsu",
 		   "HP" => sub { $_[0] =~ s/HP\s/Hewlett-Packard|/; $_[0] =~ s/HP4200/Hewlett-Packard|ScanJet 4200C/; $_[0] },
 		   "Hewlett-Packard" => sub { $_[0] =~ s/HP 3200 C/Hewlett-Packard|ScanJet 3200C/ or $_[0] = "Hewlett-Packard|$_[0]"; $_[0] },
+		   "Hewlett Packard" => "Hewlett-Packard",
 		   "Kodak" => "Kodak Co.",
 		   "Mustek" => "Mustek Systems Inc.",
 		   "NEC" => "NEC Systems",
@@ -355,16 +534,7 @@ sub updateScannerDBfromSane {
 		  };
 
     # Read templates for configuration file lines
-    my %configlines;
-    my $backend;
-    foreach my $line (cat_("$scannerDBdir/scannerconfigs")) {
-	chomp $line;
-	if ($line =~ /^\s*SERVER\s+(\S+)\s*$/) {
-	    $backend = $1;
-	} elsif ($backend) {
-	    push @{$configlines{$backend}}, $line;
-	}
-    }
+    my %configlines = %{readconfiglinetemplates()};
 
     foreach my $ff (glob_("$sanesrcdir/doc/descriptions/*.desc"), glob_("$sanesrcdir/doc/descriptions-external/*.desc"), "UNSUPPORTED") {
 	my $f = $ff;
@@ -373,24 +543,24 @@ sub updateScannerDBfromSane {
 	next if $f =~ /unsupported.desc$/;
 	# Treat unsupported.desc in the end
 	$f = "$sanesrcdir/doc/descriptions/unsupported.desc" if
-	    ($f eq "UNSUPPORTED");
+	    $f eq "UNSUPPORTED";
 	my $F = common::openFileMaybeCompressed($f);
 	$to_add .= "\n# from $f";
-	my ($lineno, $cmd, $val) = 0;
+	my ($lineno, $cmd, $val);
 	my ($name, $intf, $comment, $mfg, $backend);
 	my $fs = {
 		  backend => sub { $backend = $val },
 		  mfg => sub { $mfg = $val; $name = undef },#bug when a new mfg comes. should called $fs->{ $name }(); but ??
 		  model => sub {
 		      unless ($name) { $name = $val; return }
-		      $name = member($mfg, keys %$sane2DB) ?
+		      $name = exists $sane2DB->{$mfg} ?
 			ref($sane2DB->{$mfg}) ? $sane2DB->{$mfg}($name) : "$sane2DB->{ $mfg }|$name" : "$mfg|$name";
 		      # When adding the unsupported scanner models, check
 		      # whether the model is not already supported. To
 		      # compare the names ignore upper/lower case.
 		      my $searchname = quotemeta($name);
-		      if (($backend =~ /unsupported/i) &&
-			  ($to_add =~ /^NAME $searchname$/im)) {
+		      if ($backend =~ /unsupported/i &&
+			  $to_add =~ /^NAME $searchname$/im) {
 			  $to_add .= "# $name already supported!\n";
 		      } else {
 			  # SANE bug: "snapscan" calls itself "SnapScan"
@@ -400,8 +570,10 @@ sub updateScannerDBfromSane {
 			  # this backend and add what is needed for the
 			  # interfaces of this scanner
 			  foreach my $line (@{$configlines{$backend}}) {
-			      my $i = $1 if $line =~ /^\s*(\S*?)LINE/;
-			      if (!$i || $intf =~ /$i/i) {
+			      my $i;
+                              $i = $1 if $line =~ /^\s*(\S*?)LINE/;
+			      if (!$i || $i eq "FIRMWARE" || 
+				  $intf =~ /$i/i) {
 				  $to_add .= "$line\n";
 			      }
 			  }
@@ -421,7 +593,7 @@ sub updateScannerDBfromSane {
 	while (<$F>) { $lineno++;
 		       s/\s+$//;
 		       /^;/ and next;
-		       ($cmd, $val) = /:(\S+)\s*\"([^;]*)\"/ or next; #log::l("bad line $lineno ($_)"), next;
+		       ($cmd, $val) = /:(\S+)\s*"([^;]*)"/ or next; #log::l("bad line $lineno ($_)"), next;
 		       my $f = $fs->{$cmd};
 		       $f ? $f->() : log::l("unknown line $lineno ($_)");
 		   }