package printer;
# $Id$
#use diagnostics;
#use strict;
use common;
use run_program;
#-if we are in an DrakX config
my $prefix = "";
#-location of the printer database in an installed system
my $PRINTER_DB_FILE = "/usr/share/foomatic/db/compiled/overview.xml";
#-configuration directory of Foomatic
my $FOOMATICCONFDIR = "/etc/foomatic";
#-location of the file containing the default spooler's name
my $FOOMATIC_DEFAULT_SPOOLER = "$FOOMATICCONFDIR/defaultspooler";
#-Did we already read the subroutines of /usr/sbin/ptal-init?
my $ptalinitread = 0;
%spooler = (
_("CUPS - Common Unix Printing System") => "cups",
_("LPRng - LPR New Generation") => "lprng",
_("LPD - Line Printer Daemon") => "lpd",
_("PDQ - Print, Don't Queue") => "pdq"
);
%spooler_inv = reverse %spooler;
%shortspooler = (
_("CUPS") => "cups",
_("LPRng") => "lprng",
_("LPD") => "lpd",
_("PDQ") => "pdq"
);
%shortspooler_inv = reverse %shortspooler;
%lprcommand = (
"cups" => "lpr-cups",
"lprng" => "lpr-lpd",
"lpd" => "lpr-lpd",
"pdq" => "lpr-pdq"
);
%printer_type = (
_("Local printer") => "LOCAL",
_("Remote printer") => "REMOTE",
_("Printer on remote CUPS server") => "CUPS",
_("Printer on remote lpd server") => "LPD",
_("Network printer (TCP/Socket)") => "SOCKET",
_("Printer on SMB/Windows 95/98/NT server") => "SMB",
_("Printer on NetWare server") => "NCP",
_("Enter a printer device URI") => "URI",
_("Pipe job into a command") => "POSTPIPE"
);
%printer_type_inv = reverse %printer_type;
#------------------------------------------------------------------------------
sub set_prefix($) { $prefix = $_[0] }
sub default_printer_type($) { "LOCAL" }
sub spooler {
# LPD is taken from the menu for the moment because the classic LPD is
# highly unsecure. Depending on how the GNU lpr development is going on
# LPD support can be reactivated by uncommenting the line which is
# commented out now.
# LPRng is taken out of the distro since Mandrake 9.0.
#return @spooler_inv{qw(cups lpd lprng pdq)};
return @spooler_inv{qw(cups pdq)};
}
sub printer_type($) {
my ($printer) = @_;
for ($printer->{SPOOLER}) {
/cups/ && return @printer_type_inv{qw(LOCAL),
qw(LPD SOCKET SMB),
$::expert ? qw(URI) : ()};
/lpd/ && return @printer_type_inv{qw(LOCAL LPD SOCKET SMB NCP),
$::expert ? qw(POSTPIPE URI) : ()};
/lprng/ && return @printer_type_inv{qw(LOCAL LPD SOCKET SMB NCP),
$::expert ? qw(POSTPIPE URI) : ()};
/pdq/ && return @printer_type_inv{qw(LOCAL LPD SOCKET),
$::expert ? qw(URI) : ()};
}
}
sub get_default_spooler () {
if (-f "$prefix$FOOMATIC_DEFAULT_SPOOLER") {
open DEFSPOOL, "< $prefix$FOOMATIC_DEFAULT_SPOOLER";
my $spool = <DEFSPOOL>;
chomp $spool;
close DEFSPOOL;
return $spool if ($spool =~ /cups|lpd|lprng|pdq/);
}
}
sub set_default_spooler ($) {
my ($printer) = @_;
# Make Foomatic config directory if it does not exist yet
mkdir "$prefix$FOOMATICCONFDIR" if (!(-d "$prefix$FOOMATICCONFDIR"));
# Mark the default driver in a file
open DEFSPOOL, "> $prefix$FOOMATIC_DEFAULT_SPOOLER" or
die "Cannot create $prefix$FOOMATIC_DEFAULT_SPOOLER!";
print DEFSPOOL $printer->{SPOOLER};
close DEFSPOOL;
}
sub set_permissions {
my ($file, $perms, $owner, $group) = @_;
# We only need to set the permissions during installation to be able to
# print test pages. After installation the devfsd daemon does the business
# automatically.
if (!$::isInstall) { return 1 }
if ($owner && $group) {
run_program::rooted($prefix, "/bin/chown", "$owner.$group", $file)
or die "Could not start chown!";
} elsif ($owner) {
run_program::rooted($prefix, "/bin/chown", $owner, $file)
or die "Could not start chown!";
} elsif ($group) {
run_program::rooted($prefix, "/bin/chgrp", $group, $file)
or die "Could not start chgrp!";
}
run_program::rooted($prefix, "/bin/chmod", $perms, $file)
or die "Could not start chmod!";
}
sub restart_service ($) {
my ($service) = @_;
# Exit silently if the service is not installed
return 1 if (!(-x "$prefix/etc/rc.d/init.d/$service"));
run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "restart");
if (($? >> 8) != 0) {
return 0;
} else {
# CUPS needs some time to come up.
wait_for_cups() if ($service eq "cups");
return 1;
}
}
sub start_service ($) {
my ($service) = @_;
# Exit silently if the service is not installed
return 1 if (!(-x "$prefix/etc/rc.d/init.d/$service"));
run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "start");
if (($? >> 8) != 0) {
return 0;
} else {
# CUPS needs some time to come up.
wait_for_cups() if ($service eq "cups");
return 1;
}
}
sub start_not_running_service ($) {
my ($service) = @_;
# Exit silently if the service is not installed
return 1 if (!(-x "$prefix/etc/rc.d/init.d/$service"));
run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "status");
# The exit status is not zero when the service is not running
if (($? >> 8) != 0) {
run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "start");
if (($? >> 8) != 0) {
return 0;
} else {
# CUPS needs some time to come up.
wait_for_cups() if ($service eq "cups");
return 1;
}
} else {
return 1;
}
}
sub stop_service ($) {
my ($service) = @_;
# Exit silently if the service is not installed
return 1 if (!(-x "$prefix/etc/rc.d/init.d/$service"));
run_program::rooted($prefix, "/etc/rc.d/init.d/$service", "stop");
if (($? >> 8) != 0) { return 0 } else { return 1 }
}
sub service_starts_on_boot ($) {
my ($service) = @_;
local *F;
open F, ($::testing ? $prefix : "chroot $prefix/ ") .
"/bin/sh -c \"export LC_ALL=C; /sbin/chkconfig --list $service 2>&1\" |" or
return 0;
while (my $line = <F>) {
chomp $line;
if ($line =~ /:on/) {
close F;
return 1;
}
}
close F;
return 0;
}
sub start_service_on_boot ($) {
my ($service) = @_;
run_program::rooted($prefix, "/sbin/chkconfig", "--add", $service)
or return 0;
return 1;
}
sub SIGHUP_daemon {
my ($service) = @_;
if ($service eq "cupsd") { $service = "cups" };
# PDQ has no daemon, exit.
if ($service eq "pdq") { return 1 };
# CUPS needs auto-correction for its configuration
run_program::rooted($prefix, "/usr/sbin/correctcupsconfig") if ($service eq "cups");
# Name of the daemon
my %daemons = (
"lpr" => "lpd",
"lpd" => "lpd",
"lprng" => "lpd",
"cups" => "cupsd",
"devfs" => "devfsd",
);
my $daemon = $daemons{$service};
$daemon = $service if (! defined $daemon);
# if ($service eq "cups") {
# # The current CUPS (1.1.13) dies on SIGHUP, do the normal restart.
# restart_service($service);
# # CUPS needs some time to come up.
# wait_for_cups();
# } else {
# Send the SIGHUP
run_program::rooted($prefix, "/usr/bin/killall", "-HUP", $daemon);
if ($service eq "cups") {
# CUPS needs some time to come up.
wait_for_cups();
}
return 1;
}
sub wait_for_cups {
# CUPS needs some time to come up. Wait up to 30 seconds, checking
# whether CUPS is ready.
my $cupsready = 0;
my $i;
for ($i = 0; $i < 30; $i++) {
run_program::rooted($prefix, "/usr/bin/lpstat", "-r");
if (($? >> 8) != 0) {
# CUPS is not ready, continue
sleep 1;
} else {
# CUPS is ready, quit
$cupsready = 1;
last;
}
}
return $cupsready;
}
sub assure_device_is_available_for_cups {
# Checks whether CUPS already "knows" a certain port, it does not
# know it usually when the appropriate kernel module is loaded
# after CUPS was started or when the printer is turned on after
# CUPS was started. CUPS 1.1.12 and newer refuses to set up queues
# on devices which it does not know, it points these queues to
# file:/dev/null instead. Restart CUPS if necessary to assure that
# CUPS knows the device.
my ($device) = @_;
local *F;
open F, ($::testing ? $prefix : "chroot $prefix/ ") .
"/bin/sh -c \"export LC_ALL=C; /usr/sbin/lpinfo -v\" |" or
die "Could not run \"lpinfo\"!";
while (my $line = <F>) {
if ($line =~ /$device/) { # Found a line containing the device name,
# so CUPS knows it.
close F;
return 1;
}
}
close F;
return SIGHUP_daemon("cups");
}
sub network_running {
# If the network is not running return 0, otherwise 1.
local *F;
open F, ($::testing ? $prefix : "chroot $prefix/ ") .
"/bin/sh -c \"export LC_ALL=C; /sbin/ifconfig\" |" or
die "Could not run \"ifconfig\"!";
while (my $line = <F>) {
if (($line !~ /^lo\s+/) && # The loopback device can have been
# started by the spooler's startup script
($line =~ /^(\S+)\s+/)) { # In this line starts an entry for a
# running network
close F;
return 1;
}
}
close F;
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\" |" or
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\" |" or 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\" |"
or 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) = @_;
my $sp;
$sp = (($spooler eq "lpr") || ($spooler eq "lprng")) ? "lpd" : $spooler;
$file = "$prefix/etc/security/msec/server.$level";
if (-f $file) {
local *F;
open F, "< $file" or return 0;
while (my $line = <F>) {
if ($line =~ /^\s*$sp\s*$/) {
close F;
return 1;
}
}
close F;
}
return 0;
}
sub add_spooler_to_security_level {
my ($spooler, $level) = @_;
my $sp;
$sp = (($spooler eq "lpr") || ($spooler eq "lprng")) ? "lpd" : $spooler;
$file = "$prefix/etc/security/msec/server.$level";
if (-f $file) {
local *F;
open F, ">> $file" or return 0;
print F "$sp\n";
close F;
}
return 1;
}
sub files_exist {
my @files = @_;
for my $file (@files) {
return 0 if (! -f "$prefix$file"),
}
return 1;
}
sub set_alternative {
my ($command, $executable) = @_;
local *F;
# Read the list of executables for the given command to find the number
# of the desired executable
open F, ($::testing ? $prefix : "chroot $prefix/ ") .
"/bin/sh -c \"export LC_ALL=C; /bin/echo | update-alternatives --config $command \" |" or
die "Could not run \"update-alternatives\"!";
my $choice = 0;
while (my $line = <F>) {
chomp $line;
if ($line =~ m/^[\* ][\+ ]\s*([0-9]+)\s+(\S+)\s*$/) { # list entry?
if ($2 eq $executable) {
$choice = $1;
last;
}
}
}
close F;
# If the executable was found, assign the command to it
if ($choice > 0) {
system(($::testing ? $prefix : "chroot $prefix/ ") .
"/bin/sh -c \"/bin/echo $choice | update-alternatives --config $command > /dev/null 2>&1\"");
}
return 1;
}
sub pdq_panic_button {
my $setting = $_[0];
if (-f "$prefix/usr/sbin/pdqpanicbutton") {
run_program::rooted($prefix, "/usr/sbin/pdqpanicbutton", "--$setting")
or die "Could not $setting PDQ panic buttons!";
}
}
sub copy_printer_params($$) {
my ($from, $to) = @_;
map { $to->{$_} = $from->{$_} } grep { $_ ne 'configured' } keys %$from;
#- avoid cycles-----------------^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
}
sub getinfo($) {
my ($prefix) = @_;
my $printer = {};
my @QUEUES;
set_prefix($prefix);
# Initialize $printer data structure
resetinfo($printer);
return $printer;
}
#------------------------------------------------------------------------------
sub resetinfo($) {
my ($printer) = @_;
$printer->{QUEUE} = "";
$printer->{OLD_QUEUE} = "";
$printer->{OLD_CHOICE} = "";
$printer->{ARGS} = "";
$printer->{DBENTRY} = "";
$printer->{DEFAULT} = "";
$printer->{currentqueue} = {};
# -check which printing system was used previously and load the information
# -about its queues
read_configured_queues($printer);
}
sub read_configured_queues($) {
my ($printer) = @_;
my @QUEUES;
# Get the default spooler choice from the config file
$printer->{SPOOLER} ||= get_default_spooler();
if (!$printer->{SPOOLER}) {
#- Find the first spooler where there are queues
my $spooler;
for $spooler (qw(cups pdq lprng lpd)) {
#- poll queue info
local *F;
open F, ($::testing ? $prefix : "chroot $prefix/ ") .
"foomatic-configure -P -q -s $spooler |" or
die "Could not run foomatic-configure";
eval (join('',(<F>)));
close F;
#- Have we found queues?
if ($#QUEUES != -1) {
$printer->{SPOOLER} = $spooler;
last;
}
}
} else {
#- Poll the queues of the current default spooler
local *F;
open F, ($::testing ? $prefix : "chroot $prefix/ ") .
"foomatic-configure -P -q -s $printer->{SPOOLER} |" or
die "Could not run foomatic-configure";
eval (join('',(<F>)));
close F;
}
$printer->{configured} = {};
my $i;
my $N = $#QUEUES + 1;
for ($i = 0; $i < $N; $i++) {
$printer->{configured}{$QUEUES[$i]{queuedata}{queue}} =
$QUEUES[$i];
if ((!$QUEUES[$i]{make}) || (!$QUEUES[$i]{model})) {
if ($printer->{SPOOLER} eq "cups") {
$printer->{OLD_QUEUE} = $QUEUES[$i]{queuedata}{queue};
my $descr = get_descr_from_ppd($printer);
$descr =~ m/^([^\|]*)\|([^\|]*)\|.*$/;
|