summaryrefslogtreecommitdiffstats
path: root/perl-install/scanner.pm
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/scanner.pm')
-rw-r--r--[-rwxr-xr-x]perl-install/scanner.pm178
1 files changed, 95 insertions, 83 deletions
diff --git a/perl-install/scanner.pm b/perl-install/scanner.pm
index c73057d91..777f7192f 100755..100644
--- a/perl-install/scanner.pm
+++ b/perl-install/scanner.pm
@@ -1,8 +1,7 @@
package scanner;
-# scanner.pm $Id$
-# Yves Duret <yduret at mandrakesoft.com>
-# Till Kamppeter <till at mandrakesoft.com>
-# Copyright (C) 2001-2004 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
@@ -20,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)
@@ -36,7 +34,7 @@ our $scannerDB = readScannerDB("$scannerDBdir/ScannerDB");
sub confScanner {
my ($model, $port, $vendor, $product, $firmware) = @_;
- $port ||= detect_devices::dev_is_devfs() ? "$::prefix/dev/usb/scanner0" : "$::prefix/dev/scanner";
+ $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");
@@ -87,38 +85,51 @@ sub setfirmware {
sub installfirmware {
# Install the firmware file in /usr/share/sane/firmware
- my ($firmware) = @_;
+ my ($firmware, $backend) = @_;
return "" if !$firmware;
+ $in ||= interactive->vnew;
# Install firmware
run_program::rooted($::prefix, "mkdir", "-p",
- "/usr/share/sane/firmware") || do {
- $in->ask_warn('Scannerdrake',
+ "/usr/share/sane/firmware") or do {
+ $in->ask_warn(N("Error"),
N("Could not create directory /usr/share/sane/firmware!"));
return "";
};
- run_program::rooted($::prefix, "cp", "-f", "$firmware",
- "/usr/share/sane/firmware") || do {
- $in->ask_warn('Scannerdrake',
+ # 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) || do {
- $in->ask_warn('Scannerdrake',
+ $firmware) or do {
+ $in->ask_warn(N("Error"),
N("Could not set permissions of firmware file %s!", $firmware));
return "";
};
return $firmware;
}
-sub configured() {
+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;
@@ -131,8 +142,8 @@ sub configured() {
$parportscannerfound = 1;
}
# Determine which SANE backend the scanner in question uses
- $port =~ /^([^:]+):/;
- my $backend = $1;
+ my $backend;
+ $backend = $1 if $port =~ /^([^:]+):/;
# Does the scanner need a firmware file
my $firmwareline = firmwareline($backend);
# Store collected data
@@ -140,23 +151,23 @@ sub configured() {
port => $port,
val => {
DESCRIPTION => $description,
- ($backend ? ( BACKEND => $backend ) : ()),
- ($firmwareline ?
- ( FIRMWARELINE => $firmwareline ) : ()),
+ 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);
+ 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, esporting the scanner to
+ # 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.
@@ -164,11 +175,11 @@ sub nonroot_access_for_parport {
# 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) = @_;
+ my ($enable, $in) = @_;
# Is saned running?
- my $sanedrunning = services::starts_on_boot("saned");
+ my $sanedrunning = services::starts_on_boot("saned.socket");
# Is the "net" SANE backend active
- my $netbackendactive = grep { /^\s*net\s*$/ }
+ 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
@@ -180,11 +191,9 @@ sub nonroot_access_for_parport {
# Install/start saned
if (!$sanedrunning) {
- # Make sure saned and xinetd is installed and
- # running
- if (!files_exist('/usr/sbin/xinetd',
- '/usr/sbin/saned')) {
- if (!$in->do_pkgs->install('xinetd', 'saned')) {
+ # 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."));
@@ -193,12 +202,6 @@ sub nonroot_access_for_parport {
}
}
- # Modify /etc/xinetd.d/saned to let saned run as root
- my @sanedxinetdconf = cat_("/etc/xinetd.d/saned");
- ( s/(user\s*=\s*).*$/$1root/ ) foreach @sanedxinetdconf;
- ( s/(group\s*=\s*).*$/$1root/ ) foreach @sanedxinetdconf;
- output("/etc/xinetd.d/saned", @sanedxinetdconf);
-
# 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
@@ -219,22 +222,7 @@ sub nonroot_access_for_parport {
# (Re)start saned and make sure that it gets started on
# every boot
- services::start_service_on_boot("saned");
- services::start_service_on_boot("xinetd");
- services::restart("xinetd");
-
- } else {
- # Disable non-root access
-
- if (-r "/etc/xinetd.d/saned") {
- # Modify /etc/xinetd.d/saned to let saned run as saned
- my @sanedxinetdconf = cat_("/etc/xinetd.d/saned");
- ( s/(user\s*=\s*).*$/$1saned/ ) foreach @sanedxinetdconf;
- ( s/(group\s*=\s*).*$/$1saned/ ) foreach @sanedxinetdconf;
- output("/etc/xinetd.d/saned", @sanedxinetdconf);
- # Restart xinetd
- services::restart("xinetd") if $sanedrunning;
- }
+ services::enable("saned.socket");
}
return 1;
@@ -245,10 +233,13 @@ sub detect {
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\[]+[^\[]*\[([^\[\]]+)\]/) {
@@ -264,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 =~ /^([^\|]+)\|(.*)$/) {
@@ -281,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";
@@ -324,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) {
@@ -346,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 {
@@ -364,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!^(.*)/[^/]+$!) {
@@ -380,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
@@ -437,7 +440,8 @@ sub readScannerDB {
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" },
@@ -461,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 {},
};
@@ -484,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;
}
@@ -510,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",
@@ -532,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"
@@ -559,7 +570,8 @@ 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/;
+ my $i;
+ $i = $1 if $line =~ /^\s*(\S*?)LINE/;
if (!$i || $i eq "FIRMWARE" ||
$intf =~ /$i/i) {
$to_add .= "$line\n";
@@ -581,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 ($_)");
}
generated by cgit v1.2.1 (git 2.21.0) at 2025-10-23 20:14:03 +0000