summaryrefslogtreecommitdiffstats
path: root/perl-install/printer.pm
diff options
context:
space:
mode:
authorThierry Vignaud <tvignaud@mandriva.org>2002-11-12 12:05:40 +0000
committerThierry Vignaud <tvignaud@mandriva.org>2002-11-12 12:05:40 +0000
commit046406ab6b13659f4be843d3d2d5639efaf425fe (patch)
tree2304d9911b495ea5262815f2b3cca305f53d83f4 /perl-install/printer.pm
parent57582cf77904240eee6c29874866b9d62e4a9951 (diff)
downloaddrakx-046406ab6b13659f4be843d3d2d5639efaf425fe.tar
drakx-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.gz
drakx-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.bz2
drakx-046406ab6b13659f4be843d3d2d5639efaf425fe.tar.xz
drakx-046406ab6b13659f4be843d3d2d5639efaf425fe.zip
printer related modules cleaning :
- create the printer/ hierarchy - split services related stuff into services.pm & printer::services, - move things that've nothing to do with printers into common.pm (alternatives, permissions, ...) - move eveything related to cups, gimp-print, detection, {star,open}office to the corresponding splited printer:: module - big consolidation of printer::office (it was obvious there were tons of duplication between staroffice and openoffice managment) - move other stuff into printer::main, printer::common, status : print.pm has been heavily splited (now one can begin to understand the little bits). printerdrake still needs to be splited/cleaned and eventually removed since printer/printerdrake modules separation is not understandable by other people till, in printer::gimp, $lprcommand is neither declared nor setted nowhere. idem in mdk9.0 ...
Diffstat (limited to 'perl-install/printer.pm')
-rw-r--r--perl-install/printer.pm3306
1 files changed, 0 insertions, 3306 deletions
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
deleted file mode 100644
index 11f451442..000000000
--- a/perl-install/printer.pm
+++ /dev/null
@@ -1,3306 +0,0 @@
-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;
-
-our %spoolers = ('ppq' => {
- 'help' => "/usr/bin/lphelp %s |",
- 'print_command' => 'lpr-pdq',
- 'long_name' =>N("PDQ - Print, Don't Queue"),
- 'short_name' => N("PDQ")
- },
- 'lpd' => {
- 'help' => "/usr/bin/pdq -h -P %s 2>&1 |",
- 'print_command' => 'lpr-cups',
- 'long_name' => N("LPD - Line Printer Daemon"),
- 'short_name' => N("LPD")
- },
- 'lprng' => {
- 'print_command' => 'lpr-lpd',
- 'long_name' => N("LPRng - LPR New Generation"),
- 'short_name' => N("LPRng")
- },
- 'cups' => {
- 'print_command' => 'lpr-cups',
- 'long_name' => N("CUPS - Common Unix Printing System"),
- 'short_name' => N("CUPS")
- }
- );
-our %spooler_inv = map { $spooler{$_}{long_name} => $_ } keys %spoolers;
-
-our %shortspooler_inv = map { $spooler{$_}{short_name} => $_ } keys %spoolers;
-
-%printer_type = (
- N("Local printer") => "LOCAL",
- N("Remote printer") => "REMOTE",
- N("Printer on remote CUPS server") => "CUPS",
- N("Printer on remote lpd server") => "LPD",
- N("Network printer (TCP/Socket)") => "SOCKET",
- N("Printer on SMB/Windows 95/98/NT server") => "SMB",
- N("Printer on NetWare server") => "NCP",
- N("Enter a printer device URI") => "URI",
- N("Pipe job into a command") => "POSTPIPE"
-);
-our %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 following line.
-
- #return @spooler_inv{qw(cups lpd lprng pdq)};
-
- # LPRng is not officially supported any more since Mandrake 9.0, so
- # show it only in the spooler menu when it was manually installed.
- my @res;
- if (files_exist((qw(/usr/lib/filters/lpf
- /usr/sbin/lpd)))) {
- foreach (qw(cups lprng pdq)) { push @res, $spooler_inv{$_}{long_name} };
-# {qw(cups lprng pdq)}{long_name};
- } else {
- foreach (qw(cups pdq)) { push @res, $spooler_inv{$_}{long_name} };
-# return spooler_inv{qw(cups pdq)}{long_name};
- }
- return @res;
-}
-
-sub printer_type($) {
- my ($printer) = @_;
- foreach ($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") {
- my $spool = cat_("$prefix$FOOMATIC_DEFAULT_SPOOLER");
- chomp $spool;
- return $spool if $spool =~ /cups|lpd|lprng|pdq/;
- }
-}
-
-sub set_default_spooler ($) {
- my ($printer) = @_;
- # Mark the default driver in a file
- output_p("$prefix$FOOMATIC_DEFAULT_SPOOLER", $printer->{SPOOLER});
-}
-
-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_running ($) {
- my ($service) = @_;
- # Exit silently if the service is not installed
- return 0 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) {
- 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) = @_;
- my $result;
- for ($i = 0; $i < 3; $i++) {
- 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;
- $result = SIGHUP_daemon("cups");
- }
- return $result;
-}
-
-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 => N("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 = N("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.
-
- # Return an empty list if no network is running
- if (!network_running()) {
- return ();
- }
-
- # 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 and additionally "nmblookup" the
- # networks (to find Windows servers which do not answer to ping)
- foreach 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 | sort\" |"
- or next;
- local $_;
- while (<F>) { chomp; push @addresses, $_ }
- close F;
- if (-x "/usr/bin/nmblookup") {
- local *F;
- open F, ($::testing ? "" : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; nmblookup -B $bcast \\* | cut -f 1 -d ' ' | egrep '^[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+' | uniq | sort\" |"
- or next;
- local $_;
- while (<F>) { chomp;
- push @addresses, $_ if !(member($_,@addresses)) }
- }
- }
-
- @addresses;
-}
-
-sub whatNetPrinter {
-
- my ($network, $smb) = @_;
-
- my $i;
- my @res;
-
- # Which ports should be scanned?
- my @portstoscan;
- push @portstoscan, "139" if $smb;
- push @portstoscan, "4010", "4020", "4030", "5503", "9100-9104" if $network;
-
- 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, the timeout settings are there to avoid
- # delays caused by machines blocking their ports with a firewall
- local *F;
- open F, ($::testing ? "" : "chroot $prefix/ ") .
- "/bin/sh -c \"export LC_ALL=C; nmap -r -P0 --host_timeout 400 --initial_rtt_timeout 200 -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);
- foreach my $share (@shares) {
- push @res, { port => "smb://$host/$share->{name}",
- val => { CLASS => 'PRINTER',
- MODEL => N("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 = @_;
- foreach 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
- foreach my $spooler (qw(cups pdq lprng lpd)) {
- #- Is the spooler's daemon running?
- my $service = $spooler;
- if ($service eq "lprng") {
- $service = "lpd";
- }
- if ($service ne "pdq") {
- if (!service_running($service)) {
- next;
- }
- # daemon is running, spooler found
- $printer->{SPOOLER} = $spooler;
- }
- #- 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;
- if ($service eq "pdq") {
- #- Have we found queues? PDQ has no damon, so we consider
- #- it in use when there are defined printer queues
- if ($#QUEUES != -1) {
- $printer->{SPOOLER} = $spooler;
- last;
- }
- } else {
- #- For other spoolers we have already found a running
- #- daemon when we have arrived here
- 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/^([^\|]*)\|([^\|]*)\|.*$/;
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{make} ||= $1;
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{model} ||= $2;
- # Read out which PPD file was originally used to set up this
- # queue
- local *F;
- if (open F, "< $prefix/etc/cups/ppd/$QUEUES[$i]{queuedata}{queue}.ppd") {
- while (my $line = <F>) {
- if ($line =~ /^\*%MDKMODELCHOICE:(.+)$/) {
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{ppd} = $1;
- }
- }
- close F;
- }
- # Mark that we have a CUPS queue but do not know the name
- # the PPD file in /usr/share/cups/model
- if (!$printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{ppd}) {
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{ppd} = '1';
- }
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{driver} = 'CUPS/PPD';
- $printer->{OLD_QUEUE} = "";
- # Read out the printer's options
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{args} = read_cups_options($QUEUES[$i]{queuedata}{queue});
- }
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{make} ||= "";
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{model} ||= N("Unknown model");
- } else {
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{make} = $QUEUES[$i]{make};
- $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{model} = $QUEUES[$i]{model};
- }
- # Fill in "options" field
- if (my $args = $printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{args}) {
- my @options;
- foreach my $arg (@{$args}) {
- push(@options, "-o");
- my $optstr = $arg->{name} . "=" . $arg->{default};
- push(@options, $optstr);
- }
- @{$printer->{configured}{$QUEUES[$i]{queuedata}{queue}}{queuedata}{options}} = @options;
- }
- # Construct an entry line for tree view in main window of
- # printerdrake
- make_menuentry($printer, $QUEUES[$i]{queuedata}{queue});
- }
-}
-
-sub make_menuentry {
- my ($printer, $queue) = @_;
- my $spooler = $shortspooler_inv{$printer->{SPOOLER}}{short_name};
- my $connect = $printer->{configured}{$queue}{queuedata}{connect};
- my $localremote;
- if (($connect =~ m!^file:!) || ($connect =~ m!^ptal:/mlc:!)) {
- $localremote = N("Local Printers");
- } else {
- $localremote = N("Remote Printers");
- }
- my $make = $printer->{configured}{$queue}{queuedata}{make};
- my $model = $printer->{configured}{$queue}{queuedata}{model};
- my $connection;
- if ($connect =~ m!^file:/dev/lp(\d+)$!) {
- my $number = $1;
- $connection = N(" on parallel port \#%s", $number);
- } elsif ($connect =~ m!^file:/dev/usb/lp(\d+)$!) {
- my $number = $1;
- $connection = N(", USB printer \#%s", $number);
- } elsif ($connect =~ m!^ptal:/(.+)$!) {
- my $ptaldevice = $1;
- if ($ptaldevice =~ /^mlc:par:(\d+)$/) {
- my $number = $1;
- $connection = N(", multi-function device on parallel port \#%s",
- $number);
- } elsif ($ptaldevice =~ /^mlc:usb:/) {
- $connection = N(", multi-function device on USB");
- } elsif ($ptaldevice =~ /^hpjd:/) {
- $connection = N(", multi-function device on HP JetDirect");
- } else {
- $connection = N(", multi-function device");
- }
- } elsif ($connect =~ m!^file:(.+)$!) {
- $connection = N(", printing to %s", $1);
- } elsif ($connect =~ m!^lpd://([^/]+)/([^/]+)/?$!) {
- $connection = N(" on LPD server \"%s\", printer \"%s\"", $2, $1);
- } elsif ($connect =~ m!^socket://([^/:]+):([^/:]+)/?$!) {
- $connection = N(", TCP/IP host \"%s\", port %s", $1, $2);
- } elsif (($connect =~ m!^smb://([^/\@]+)/([^/\@]+)/?$!) ||
- ($connect =~ m!^smb://.*/([^/\@]+)/([^/\@]+)/?$!) ||
- ($connect =~ m!^smb://.*\@([^/\@]+)/([^/\@]+)/?$!)) {
- $connection = N(" on SMB/Windows server \"%s\", share \"%s\"", $1, $2);
- } elsif (($connect =~ m!^ncp://([^/\@]+)/([^/\@]+)/?$!) ||
- ($connect =~ m!^ncp://.*/([^/\@]+)/([^/\@]+)/?$!) ||
- ($connect =~ m!^ncp://.*\@([^/\@]+)/([^/\@]+)/?$!)) {
- $connection = N(" on Novell server \"%s\", printer \"%s\"", $1, $2);
- } elsif ($connect =~ m!^postpipe:(.+)$!) {
- $connection = N(", using command %s", $1);
- } else {
- $connection = ($::expert ? ", URI: $connect" : "");
- }
- my $sep = "!";
- $printer->{configured}{$queue}{queuedata}{menuentry} =
- ($::expert ? "$spooler$sep" : "") .
- "$localremote$sep$queue: $make $model$connection";
-}
-
-sub read_printer_db(;$) {
-
- my $spooler = $_[0];
-
- my $dbpath = $prefix . $PRINTER_DB_FILE;
-
- local *DBPATH; #- don't have to do close ... and don't modify globals at least
- # Generate the Foomatic printer/driver overview, read it from the
- # appropriate file when it is already generated
- if (!(-f $dbpath)) {
- open DBPATH, ($::testing ? $prefix : "chroot $prefix/ ") . #-#
- "foomatic-configure -O -q |" or
- die "Could not run foomatic-configure";
- } else {
- open DBPATH, $dbpath or die "An error occurred on $dbpath : $!"; #-#
- }
-
- my $entry = {};
- my $inentry = 0;
- my $indrivers = 0;
- my $inautodetect = 0;
- local $_;
- while (<DBPATH>) {
- chomp;
- if ($inentry) {
- # We are inside a printer entry
- if ($indrivers) {
- # We are inside the drivers block of a printers entry
- if (m!^\s*</drivers>\s*$!) {
- # End of drivers block
- $indrivers = 0;
- } elsif (m!^\s*<driver>(.+)</driver>\s*$!) {
- push (@{$entry->{drivers}}, $1);
- }
- } elsif ($inautodetect) {
- # We are inside the autodetect block of a printers entry
- # All entries inside this block will be ignored
- if (m!^.*</autodetect>\s*$!) {
- # End of autodetect block
- $inautodetect = 0;
- }
- } else {
- if (m!^\s*</printer>\s*$!) {
- # entry completed
- $inentry = 0;
- # Expert mode:
- # Make one database entry per driver with the entry name
- # manufacturer|model|driver
- if ($::expert) {
- foreach my $driver (@{$entry->{drivers}}) {
- my $driverstr;
- if ($driver eq "Postscript") {
- $driverstr = "PostScript";
- } else {
- $driverstr = "GhostScript + $driver";
- }
- if ($driver eq $entry->{defaultdriver}) {
- $driverstr .= " (recommended)";
- }
- $entry->{ENTRY} = "$entry->{make}|$entry->{model}|$driverstr";
- $entry->{driver} = $driver;
- # Duplicate contents of $entry because it is multiply entered to the database
- map { $thedb{$entry->{ENTRY}}{$_} = $entry->{$_} } keys %$entry;
- }
- } else {
- # Recommended mode
- # Make one entry per printer, with the recommended
- # driver (manufacturerer|model)
- $entry->{ENTRY} = "$entry->{make}|$entry->{model}";
- if ($entry->{defaultdriver}) {
- $entry->{driver} = $entry->{defaultdriver};
- map { $thedb{$entry->{ENTRY}}{$_} = $entry->{$_} } keys %$entry;
- }
- }
- $entry = {};
- } elsif (m!^\s*<id>\s*([^\s<>]+)\s*</id>\s*$!) {
- # Foomatic printer ID
- $entry->{printer} = $1;
- } elsif (m!^\s*<make>(.+)</make>\s*$!) {
- # Printer manufacturer
- $entry->{make} = uc($1);
- } elsif (m!^\s*<model>(.+)</model>\s*$!) {
- # Printer model
- $entry->{model} = $1;
- } elsif (m!<driver>(.+)</driver>!) {
- # Printer default driver
- $entry->{defaultdriver} = $1;
- } elsif (m!^\s*<drivers>\s*$!) {
- # Drivers block
- $indrivers = 1;
- @{$entry->{drivers}} = ();
- } elsif (m!^\s*<autodetect>\s*$!) {
- # Autodetect block
- $inautodetect = 1;
- }
- }
- } else {
- if (m!^\s*<printer>\s*$!) {
- # new entry
- $inentry = 1;
- }
- }
- }
- close DBPATH;
-
- # Add raw queue
- if ($spooler ne "pdq") {
- $entry->{ENTRY} = N("Raw printer (No driver)");
- $entry->{driver} = "raw";
- $entry->{make} = "";
- $entry->{model} = N("Unknown model");
- map { $thedb{$entry->{ENTRY}}{$_} = $entry->{$_} } keys %$entry;
- }
-
- #- Load CUPS driver database if CUPS is used as spooler
- if (($spooler) && ($spooler eq "cups") && ($::expert)) {
-
- #&$install('cups-drivers') unless $::testing;
- #my $w;
- #if ($in) {
- # $w = $in->wait_message(N("CUPS starting"),
- # N("Reading CUPS drivers database..."));
- #}
- poll_ppd_base();
- }
-
- @entries_db_short = sort keys %printer::thedb;
- #%descr_to_db = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short;
- #%descr_to_help = map { $printer::thedb{$_}{DESCR}, $printer::thedb{$_}{ABOUT} } @entries_db_short;
- #@entry_db_description = keys %descr_to_db;
- #db_to_descr = reverse %descr_to_db;
-
-}
-
-sub read_foomatic_options ($) {
- my ($printer) = @_;
- # Generate the option data for the chosen printer/driver combo
- my $COMBODATA;
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "foomatic-configure -P -q -p $printer->{currentqueue}{printer}" .
- " -d $printer->{currentqueue}{driver}" .
- ($printer->{OLD_QUEUE} ?
- " -s $printer->{SPOOLER} -n $printer->{OLD_QUEUE}" : "") .
- ($printer->{SPECIAL_OPTIONS} ?
- " $printer->{SPECIAL_OPTIONS}" : "")
- . " |" or
- die "Could not run foomatic-configure";
- eval (join('',(<F>)));
- close F;
- # Return the arguments field
- return $COMBODATA->{args};
-}
-
-sub read_cups_options ($) {
- my ($queue_or_file) = @_;
- # Generate the option data from a CUPS PPD file/a CUPS queue
- # Use the same Perl data structure as Foomatic uses to be able to
- # reuse the dialog
- local *F;
- if ($queue_or_file =~ /.ppd.gz$/) { # compressed PPD file
- open F, ($::testing ? $prefix : "chroot $prefix/ ") . #-#
- "gunzip -cd $queue_or_file | lphelp - |" or return 0;
- } else { # PPD file not compressed or queue
- open F, ($::testing ? $prefix : "chroot $prefix/ ") . #-#
- "lphelp $queue_or_file |" or return 0;
- }
- my $i;
- my $j;
- my @args;
- my $line;
- my $inoption = 0;
- my $inchoices = 0;
-# my $innumerical = 0;
- while ($line = <F>) {
- chomp $line;
- if ($inoption) {
- if ($inchoices) {
- if ($line =~ /^\s*(\S+)\s+(\S.*)$/) {
- push(@{$args[$i]{vals}}, {});
- $j = $#{$args[$i]{vals}};
- $args[$i]{vals}[$j]{value} = $1;
- my $comment = $2;
- # Did we find the default setting?
- if ($comment =~ /default\)\s*$/) {
- $args[$i]{default} = $args[$i]{vals}[$j]{value};
- $comment =~ s/,\s*default\)\s*$//;
- } else {
- $comment =~ s/\)\s*$//;
- }
- # Remove opening paranthese
- $comment =~ s/^\(//;
- # Remove page size info
- $comment =~ s/,\s*size:\s*[0-9\.]+x[0-9\.]+in$//;
- $args[$i]{vals}[$j]{comment} = $comment;
- } elsif (($line =~ /^\s*$/) && ($#{$args[$i]{vals}} > -1)) {
- $inchoices = 0;
- $inoption = 0;
- }
-# } elsif ($innumerical == 1) {
-# if ($line =~ /^\s*The default value is ([0-9\.]+)\s*$/) {
-# $args[$i]{default} = $1;
-# $innumerical = 0;
-# $inoption = 0;
-# }
- } else {
- if ($line =~ /^\s*<choice>/) {
- $inchoices = 1;
-# } elsif ($line =~ /^\s*<value> must be a(.*) number in the range ([0-9\.]+)\.\.([0-9\.]+)\s*$/) {
-# delete($args[$i]{vals});
-# $args[$i]{min} = $2;
-# $args[$i]{max} = $3;
-# my $type = $1;
-# if ($type =~ /integer/) {
-# $args[$i]{type} = 'int';
-# } else {
-# $args[$i]{type} = 'float';
-# }
-# $innumerical = 1;
- }
- }
- } else {
- if ($line =~ /^\s*([^\s:][^:]*):\s+-o\s+([^\s=]+)=<choice>\s*$/) {
-# if ($line =~ /^\s*([^\s:][^:]*):\s+-o\s+([^\s=]+)=<.*>\s*$/) {
- $inoption = 1;
- push(@args, {});
- $i = $#args;
- $args[$i]{comment} = $1;
- $args[$i]{name} = $2;
- $args[$i]{type} = 'enum';
- @{$args[$i]{vals}} = ();
- }
- }
- }
- close F;
- # Return the arguments field
- return \@args;
-}
-
-sub set_cups_special_options {
- my ($queue) = $_[0];
- # Set some special CUPS options
- my @lpoptions = chomp_(cat_("$prefix/etc/cups/lpoptions"));
- # If nothing is already configured, set text file borders of half an inch
- # and decrease the font size a little bit, so nothing of the text gets
- # cut off by unprintable borders.
- if (!grep { /$queue.*\s(page-(top|bottom|left|right)|lpi|cpi)=/ } @lpoptions) {
- run_program::rooted($prefix, "lpoptions",
- "-p", $queue,
- "-o", "page-top=36", "-o", "page-bottom=36",
- "-o", "page-left=36", "-o page-right=36",
- "-o", "cpi=12", "-o", "lpi=7", "-o", "wrap");
- }
- # Let images fill the whole page by default
- if (!grep { /$queue.*\s(scaling|natural-scaling|ppi)=/ } @lpoptions) {
- run_program::rooted($prefix, "lpoptions",
- "-p", $queue,
- "-o", "scaling=100");
- }
- return 1;
-}
-
-#------------------------------------------------------------------------------
-
-sub read_cups_printer_list {
- my ($printer) = $_[0];
- # This function reads in a list of all printers which the local CUPS
- # daemon currently knows, including remote ones.
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "lpstat -v |" or return ();
- my @printerlist;
- my $line;
- while ($line = <F>) {
- if ($line =~ m/^\s*device\s+for\s+([^:\s]+):\s*(\S+)\s*$/) {
- my $queuename = $1;
- my $comment = "";
- if (($2 =~ m!^ipp://([^/:]+)[:/]!) &&
- (!$printer->{configured}{$queuename})) {
- $comment = N("(on %s)", $1);
- } else {
- $comment = N("(on this machine)");
- }
- push (@printerlist, "$queuename $comment");
- }
- }
- close F;
- return @printerlist;
-}
-
-sub get_cups_remote_queues {
- my ($printer) = $_[0];
- # This function reads in a list of all remote printers which the local
- # CUPS daemon knows due to broadcasting of remote servers or
- # "BrowsePoll" entries in the local /etc/cups/cupsd.conf/
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "lpstat -v |" or return ();
- my @printerlist;
- my $line;
- while ($line = <F>) {
- if ($line =~ m/^\s*device\s+for\s+([^:\s]+):\s*(\S+)\s*$/) {
- my $queuename = $1;
- my $comment = "";
- if (($2 =~ m!^ipp://([^/:]+)[:/]!) &&
- (!$printer->{configured}{$queuename})) {
- $comment = N("On CUPS server \"%s\"", $1);
- my $sep = "!";
- push (@printerlist,
- ($::expert ? N("CUPS") . $sep : "") .
- N("Remote Printers") . "$sep$queuename: $comment"
- . ($queuename eq $printer->{DEFAULT} ?
- N(" (Default)") : ("")));
- }
- }
- }
- close F;
- return @printerlist;
-}
-
-sub set_cups_autoconf {
- my $autoconf = $_[0];
-
- # Read config file
- my $file = "$prefix/etc/sysconfig/printing";
- @file_content = cat_($file);
-
- # Remove all valid "CUPS_CONFIG" lines
- (/^\s*CUPS_CONFIG/ and $_ = "") foreach @file_content;
-
- # Insert the new "CUPS_CONFIG" line
- if ($autoconf) {
- push @file_content, "CUPS_CONFIG=automatic\n";
- } else {
- push @file_content, "CUPS_CONFIG=manual\n";
- }
-
- output($file, @file_content);
-
- # Restart CUPS
- restart_service("cups");
-
- return 1;
-}
-
-sub get_cups_autoconf {
- local *F;
- open F, "< $prefix/etc/sysconfig/printing" or return 1;
- my $line;
- while ($line = <F>) {
- if ($line =~ m!^[^\#]*CUPS_CONFIG=manual!) {
- return 0;
- }
- }
- return 1;
-}
-
-sub set_usermode {
- my $usermode = $_[0];
- $::expert = $usermode;
-
- # Read config file
- my $file = "$prefix/etc/sysconfig/printing";
- @file_content = cat_($file);
-
- # Remove all valid "USER_MODE" lines
- (/^\s*USER_MODE/ and $_ = "") foreach @file_content;
-
- # Insert the new "USER_MODE" line
- if ($usermode) {
- push @file_content, "USER_MODE=expert\n";
- } else {
- push @file_content, "USER_MODE=recommended\n";
- }
-
- output($file, @file_content);
-
- return 1;
-}
-
-sub get_usermode {
- local *F;
- open F, "< $prefix/etc/sysconfig/printing" or return 0;
- my $line;
- while ($line = <F>) {
- if ($line =~ m!^[^\#]*USER_MODE=expert!) {
- $::expert = 1;
- return 1;
- }
- }
- $::expert = 0;
- return 0;
-}
-
-sub set_default_printer {
- my ($printer) = $_[0];
- run_program::rooted($prefix, "foomatic-configure",
- "-D", "-q", "-s", $printer->{SPOOLER},
- "-n", $printer->{DEFAULT}) or return 0;
- return 1;
-}
-
-sub get_default_printer {
- my $printer = $_[0];
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "foomatic-configure -Q -q -s $printer->{SPOOLER} |" or return undef;
- my $line;
- while ($line = <F>) {
- if ($line =~ m!^\s*<defaultqueue>(.*)</defaultqueue>\s*$!) {
- return $1;
- }
- }
- return undef;
-}
-
-sub read_cupsd_conf {
- cat_("$prefix/etc/cups/cupsd.conf");
-}
-sub write_cupsd_conf {
- my (@cupsd_conf) = @_;
-
- output("$prefix/etc/cups/cupsd.conf", @cupsd_conf);
-
- #- restart cups after updating configuration.
- restart_service("cups");
-}
-
-sub read_printers_conf {
- my ($printer) = @_;
- my $current;
-
- #- read /etc/cups/printers.conf file.
- #- according to this code, we are now using the following keys for each queues.
- #- DeviceURI > lpd://printer6/lp
- #- Info > Info Text
- #- Location > Location Text
- #- State > Idle|Stopped
- #- Accepting > Yes|No
- local *PRINTERS; open PRINTERS, "$prefix/etc/cups/printers.conf" or return;
- local $_;
- while (<PRINTERS>) {
- chomp;
- /^\s*#/ and next;
- if (/^\s*<(?:DefaultPrinter|Printer)\s+([^>]*)>/) { $current = { mode => 'cups', QUEUE => $1, } }
- elsif (/\s*<\/Printer>/) { $current->{QUEUE} && $current->{DeviceURI} or next; #- minimal check of synthax.
- add2hash($printer->{configured}{$current->{QUEUE}} ||= {}, $current); $current = undef }
- elsif (/\s*(\S*)\s+(.*)/) { $current->{$1} = $2 }
- }
- close PRINTERS;
-
- #- assume this printing system.
- $printer->{SPOOLER} ||= 'cups';
-}
-
-sub get_direct_uri {
- #- get the local printer to access via a Device URI.
- my @direct_uri;
- local *F; open F, ($::testing ? $prefix : "chroot $prefix/ ") . "/usr/sbin/lpinfo -v |";
- local $_;
- while (<F>) {
- /^(direct|usb|serial)\s+(\S*)/ and push @direct_uri, $2;
- }
- close F;
- @direct_uri;
-}
-
-sub get_descr_from_ppd {
- my ($printer) = @_;
- my %ppd;
-
- #- if there is no ppd, this means this is a raw queue.
- local *F; open F, "$prefix/etc/cups/ppd/$printer->{OLD_QUEUE}.ppd" or return "|" . N("Unknown model");
- # "OTHERS|Generic PostScript printer|PostScript (en)";
- local $_;
- while (<F>) {
- /^\*([^\s:]*)\s*:\s*\"([^\"]*)\"/ and do { $ppd{$1} = $2; next };
- /^\*([^\s:]*)\s*:\s*([^\s\"]*)/ and do { $ppd{$1} = $2; next };
- }
- close F;
-
- my $descr = ($ppd{NickName} || $ppd{ShortNickName} || $ppd{ModelName});
- # Apply the beautifying rules of poll_ppd_base
- if ($descr =~ /Foomatic \+ Postscript/) {
- $descr =~ s/Foomatic \+ Postscript/PostScript/;
- } elsif ($descr =~ /Foomatic/) {
- $descr =~ s/Foomatic/GhostScript/;
- } elsif ($descr =~ /CUPS\+GIMP-print/) {
- $descr =~ s/CUPS\+GIMP-print/CUPS \+ GIMP-Print/;
- } elsif ($descr =~ /Series CUPS/) {
- $descr =~ s/Series CUPS/Series, CUPS/;
- } elsif (!(uc($descr) =~ /POSTSCRIPT/)) {
- $descr .= ", PostScript";
- }
-
- # Split the $descr into model and driver
- my $model;
- my $driver;
- if ($descr =~ /^([^,]+), (.*)$/) {
- $model = $1;
- $driver = $2;
- } else {
- # Some PPDs do not have the ", <driver>" part.
- $model = $descr;
- $driver = "PostScript";
- }
- my $make = $ppd{Manufacturer};
- my $lang = $ppd{LanguageVersion};
-
- # Remove manufacturer's name from the beginning of the model name
- if (($make) && ($model =~ /^$make[\s\-]+([^\s\-].*)$/)) {
- $model = $1;
- }
-
- # Put out the resulting description string
- uc($make) . '|' . $model . '|' . $driver .
- ($lang && (" (" . lc(substr($lang, 0, 2)) . ")"));
-}
-
-sub poll_ppd_base {
- #- before trying to poll the ppd database available to cups, we have to make sure
- #- the file /etc/cups/ppds.dat is no more modified.
- #- if cups continue to modify it (because it reads the ppd files available), the
- #- poll_ppd_base program simply cores :-)
- run_program::rooted($prefix, "ifconfig lo 127.0.0.1"); #- else cups will not be happy! and ifup lo don't run ?
- start_not_running_service("cups");
- my $driversthere = scalar(keys %thedb);
- foreach (1..60) {
- local *PPDS; open PPDS, ($::testing ? $prefix : "chroot $prefix/ ") . "/usr/bin/poll_ppd_base -a |";
- local $_;
- while (<PPDS>) {
- chomp;
- my ($ppd, $mf, $descr, $lang) = split /\|/;
- if ($ppd eq "raw") { next }
- my ($model, $driver);
- if ($descr) {
- if ($descr =~ /^([^,]+), (.*)$/) {
- $model = $1;
- $driver = $2;
- } else {
- # Some PPDs do not have the ", <driver>" part.
- $model = $descr;
- $driver = "PostScript";
- }
- }
- # Rename Canon "BJC XXXX" models into "BJC-XXXX" so that the models
- # do not appear twice
- if ($mf eq "CANON") {
- $model =~ s/BJC\s+/BJC-/;
- }
- $ppd && $mf && $descr and do {
- my $key = "$mf|$model|$driver" . ($lang && " ($lang)");
- $thedb{$key}{ppd} = $ppd;
- $thedb{$key}{driver} = $driver;
- $thedb{$key}{make} = $mf;
- $thedb{$key}{model} = $model;
- }
- }
- close PPDS;
- scalar(keys %thedb) - $driversthere > 5 and last;
- #- we have to try again running the program, wait here a little before.
- sleep 1;
- }
-
- #scalar(keys %descr_to_ppd) > 5 or die "unable to connect to cups server";
-
-}
-
-
-
-#-******************************************************************************
-#- write functions
-#-******************************************************************************
-
-sub configure_queue($) {
- my ($printer) = @_;
-
- if ($printer->{currentqueue}{foomatic}) {
- #- Create the queue with "foomatic-configure", in case of queue
- #- renaming copy the old queue
- run_program::rooted($prefix, "foomatic-configure", "-q",
- "-s", $printer->{currentqueue}{spooler},
- "-n", $printer->{currentqueue}{queue},
- (($printer->{currentqueue}{queue} ne
- $printer->{OLD_QUEUE}) &&
- ($printer->{configured}{$printer->{OLD_QUEUE}}) ?
- ("-C", $printer->{OLD_QUEUE}) : ()),
- "-c", $printer->{currentqueue}{connect},
- "-p", $printer->{currentqueue}{printer},
- "-d", $printer->{currentqueue}{driver},
- "-N", $printer->{currentqueue}{desc},
- "-L", $printer->{currentqueue}{loc},
- @{$printer->{currentqueue}{options}}
- ) or die "foomatic-configure failed";
- } elsif ($printer->{currentqueue}{ppd}) {
- #- If the chosen driver is a PPD file from /usr/share/cups/model,
- #- we use lpadmin to set up the queue
- run_program::rooted($prefix, "lpadmin",
- "-p", $printer->{currentqueue}{queue},
-# $printer->{State} eq 'Idle' &&
-# $printer->{Accepting} eq 'Yes' ? ("-E") : (),
- "-E",
- "-v", $printer->{currentqueue}{connect},
- ($printer->{currentqueue}{ppd} ne '1') ?
- ("-m", $printer->{currentqueue}{ppd}) : (),
- $printer->{currentqueue}{desc} ?
- ("-D", $printer->{currentqueue}{desc}) : (),
- $printer->{currentqueue}{loc} ?
- ("-L", $printer->{currentqueue}{loc}) : (),
- @{$printer->{currentqueue}{options}}
- ) or die "lpadmin failed";
- # Add a comment line containing the path of the used PPD file to the
- # end of the PPD file
- if ($printer->{currentqueue}{ppd} ne '1') {
- local *F;
- open F, ">> $prefix/etc/cups/ppd/$printer->{currentqueue}{queue}.ppd";
- print F "*%MDKMODELCHOICE:$printer->{currentqueue}{ppd}\n";
- }
- # Copy the old queue's PPD file to the new queue when it is renamed,
- # to conserve the option settings
- if (($printer->{currentqueue}{queue} ne
- $printer->{OLD_QUEUE}) &&
- ($printer->{configured}{$printer->{OLD_QUEUE}})) {
- system("cp -f $prefix/etc/cups/ppd/$printer->{OLD_QUEUE}.ppd $prefix/etc/cups/ppd/$printer->{currentqueue}{queue}.ppd");
- }
- } else {
- # Raw queue
- run_program::rooted($prefix, "foomatic-configure", "-q",
- "-s", $printer->{currentqueue}{spooler},
- "-n", $printer->{currentqueue}{queue},
- "-c", $printer->{currentqueue}{connect},
- "-d", $printer->{currentqueue}{driver},
- "-N", $printer->{currentqueue}{desc},
- "-L", $printer->{currentqueue}{loc}
- ) or die "foomatic-configure failed";
- }
-
- # Make sure that queue is active
- if ($printer->{SPOOLER} ne "pdq") {
- run_program::rooted($prefix, "foomatic-printjob",
- "-s", $printer->{currentqueue}{spooler},
- "-C", "up", $printer->{currentqueue}{queue});
- }
-
- # In case of CUPS set some more useful defaults for text and image printing
- if ($printer->{SPOOLER} eq "cups") {
- set_cups_special_options($printer->{currentqueue}{queue});
- }
-
- # Check whether a USB printer is configured and activate USB printing if so
- my $useUSB = 0;
- foreach (values %{$printer->{configured}}) {
- $useUSB ||= $_->{queuedata}{connect} =~ /usb/ ||
- $_->{DeviceURI} =~ /usb/;
- }
- $useUSB ||= ($printer->{currentqueue}{queue}{queuedata}{connect}
- =~ /usb/);
- if ($useUSB) {
- my $f = "$prefix/etc/sysconfig/usb";
- my %usb = getVarsFromSh($f);
- $usb{PRINTER} = "yes";
- setVarsInSh($f, \%usb);
- }
-
- # Open permissions for device file when PDQ is chosen as spooler
- # so normal users can print.
- if ($printer->{SPOOLER} eq 'pdq') {
- if ($printer->{currentqueue}{connect} =~ m!^\s*file:(\S*)\s*$!) {
- set_permissions($1,"666");
- }
- }
-
- # Make a new printer entry in the $printer structure
- $printer->{configured}{$printer->{currentqueue}{queue}}{queuedata} =
- {};
- copy_printer_params($printer->{currentqueue},
- $printer->{configured}{$printer->{currentqueue}{queue}}{queuedata});
- # Construct an entry line for tree view in main window of
- # printerdrake
- make_menuentry($printer, $printer->{currentqueue}{queue});
-
- # Store the default option settings
- $printer->{configured}{$printer->{currentqueue}{queue}}{args} = {};
- if ($printer->{currentqueue}{foomatic}) {
- my $tmp = $printer->{OLD_QUEUE};
- $printer->{OLD_QUEUE} = $printer->{currentqueue}{queue};
- $printer->{configured}{$printer->{currentqueue}{queue}}{args} =
- read_foomatic_options($printer);
- $printer->{OLD_QUEUE} = $tmp;
- } elsif ($printer->{currentqueue}{ppd}) {
- $printer->{configured}{$printer->{currentqueue}{queue}}{args} =
- read_cups_options($printer->{currentqueue}{queue});
- }
- # Clean up
- delete($printer->{ARGS});
- $printer->{OLD_CHOICE} = "";
- $printer->{ARGS} = {};
- $printer->{DBENTRY} = "";
- $printer->{currentqueue} = {};
-}
-
-sub remove_queue($$) {
- my ($printer) = $_[0];
- my ($queue) = $_[1];
- run_program::rooted($prefix, "foomatic-configure", "-R", "-q",
- "-s", $printer->{SPOOLER},
- "-n", $queue);
- # Delete old stuff from data structure
- delete $printer->{configured}{$queue};
- delete($printer->{currentqueue});
- delete($printer->{ARGS});
- $printer->{OLD_CHOICE} = "";
- $printer->{ARGS} = {};
- $printer->{DBENTRY} = "";
- $printer->{currentqueue} = {};
- removeprinterfromapplications($printer, $queue);
-}
-
-sub restart_queue($) {
- my ($printer) = @_;
- my $queue = $printer->{QUEUE};
-
- # Restart the daemon(s)
- foreach ($printer->{SPOOLER}) {
- /cups/ && do {
- #- restart cups.
- restart_service("cups");
- last };
- /lpr|lprng/ && do {
- #- restart lpd.
- foreach (("/var/spool/lpd/$queue/lock", "/var/spool/lpd/lpd.lock")) {
- my $pidlpd = (cat_("$prefix$_"))[0];
- kill 'TERM', $pidlpd if $pidlpd;
- unlink "$prefix$_";
- }
- restart_service("lpd"); sleep 1;
- last };
- }
- # Kill the jobs
- run_program::rooted($prefix, "foomatic-printjob", "-R",
- "-s", $printer->{SPOOLER},
- "-P", $queue, "-");
-
-}
-
-sub print_pages($@) {
- my ($printer, @pages) = @_;
- my $queue = $printer->{QUEUE};
- my $lpr = "/usr/bin/foomatic-printjob";
- my $lpq = "$lpr -Q";
-
- # Print the pages
- foreach (@pages) {
- my $page = $_;
- # Only text and PostScript can be printed directly with all spoolers,
- # images must be treated seperately
- if ($page =~ /\.jpg$/) {
- if ($printer->{SPOOLER} ne "cups") {
- # Use "convert" from ImageMagick for non-CUPS spoolers
- system(($::testing ? $prefix : "chroot $prefix/ ") .
- "/usr/bin/convert $page -page 427x654+100+65 PS:- | " .
- ($::testing ? $prefix : "chroot $prefix/ ") .
- "$lpr -s $printer->{SPOOLER} -P $queue");
- } else {
- # Use CUPS's internal image converter with CUPS, tell it
- # to let the image occupy 90% of the page size (so nothing
- # gets cut off by unprintable borders)
- run_program::rooted($prefix, $lpr, "-s", $printer->{SPOOLER},
- "-P", $queue, "-o", "scaling=90", $page);
- }
- } else {
- run_program::rooted($prefix, $lpr, "-s", $printer->{SPOOLER},
- "-P", $queue, $page);
- }
- }
- sleep 5; #- allow lpr to send pages.
- # Check whether the job is queued
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") . "$lpq -s $printer->{SPOOLER} -P $queue |";
- my @lpq_output =
- grep { !/^no entries/ && !(/^Rank\s+Owner/ .. /^\s*$/) } <F>;
- close F;
- @lpq_output;
-}
-
-sub help_output {
- my ($printer, $spooler) = @_;
- my $queue = $printer->{QUEUE};
-
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") . sprintf($spoolers{$spooler}{help}, $queue);
- $helptext = join("", <F>);
- close F;
- $helptext = "Option list not available!\n" if $spooler eq 'lpq' && (!$helptext || ($helptext eq ""));
- return $helptext;
-}
-
-sub print_optionlist {
- my ($printer) = @_;
- my $queue = $printer->{QUEUE};
- my $lpr = "/usr/bin/foomatic-printjob";
-
- # Print the option list pages
- if ($printer->{configured}{$queue}{queuedata}{foomatic}) {
- run_program::rooted($prefix, $lpr, "-s", $printer->{SPOOLER},
- "-P", $queue, "-o", "docs",
- "/etc/bashrc");
- } elsif ($printer->{configured}{$queue}{queuedata}{ppd}) {
- system(($::testing ? $prefix : "chroot $prefix/ ") .
- "/usr/bin/lphelp $queue | " .
- ($::testing ? $prefix : "chroot $prefix/ ") .
- "$lpr -s $printer->{SPOOLER} -P $queue");
- }
-}
-
-# ---------------------------------------------------------------
-#
-# Spooler config stuff
-#
-# ---------------------------------------------------------------
-
-sub get_copiable_queues {
- my ($oldspooler, $newspooler) = @_;
-
- my @queuelist; #- here we will list all Foomatic-generated queues
- # Get queue list with foomatic-configure
- local *QUEUEOUTPUT;
- open QUEUEOUTPUT, ($::testing ? $prefix : "chroot $prefix/ ") .
- "foomatic-configure -Q -q -s $oldspooler |" or
- die "Could not run foomatic-configure";
-
- my $entry = {};
- my $inentry = 0;
- local $_;
- while (<QUEUEOUTPUT>) {
- chomp;
- if ($inentry) {
- # We are inside a queue entry
- if (m!^\s*</queue>\s*$!) {
- # entry completed
- $inentry = 0;
- if (($entry->{foomatic}) &&
- ($entry->{spooler} eq $oldspooler)) {
- # Is the connection type supported by the new
- # spooler?
- if ((($newspooler eq "cups") &&
- (($entry->{connect} =~ /^file:/) ||
- ($entry->{connect} =~ /^ptal:/) ||
- ($entry->{connect} =~ /^lpd:/) ||
- ($entry->{connect} =~ /^socket:/) ||
- ($entry->{connect} =~ /^smb:/) ||
- ($entry->{connect} =~ /^ipp:/))) ||
- ((($newspooler eq "lpd") ||
- ($newspooler eq "lprng")) &&
- (($entry->{connect} =~ /^file:/) ||
- ($entry->{connect} =~ /^ptal:/) ||
- ($entry->{connect} =~ /^lpd:/) ||
- ($entry->{connect} =~ /^socket:/) ||
- ($entry->{connect} =~ /^smb:/) ||
- ($entry->{connect} =~ /^ncp:/) ||
- ($entry->{connect} =~ /^postpipe:/))) ||
- (($newspooler eq "pdq") &&
- (($entry->{connect} =~ /^file:/) ||
- ($entry->{connect} =~ /^ptal:/) ||
- ($entry->{connect} =~ /^lpd:/) ||
- ($entry->{connect} =~ /^socket:/)))) {
- push(@queuelist, $entry->{name});
- }
- }
- $entry = {};
- } elsif (m!^\s*<name>(.+)</name>\s*$!) {
- # queue name
- $entry->{name} = $1;
- } elsif (m!^\s*<connect>(.+)</connect>\s*$!) {
- # connection type (URI)
- $entry->{connect} = $1;
- }
- } else {
- if (m!^\s*<queue\s+foomatic\s*=\s*\"?(\d+)\"?\s*spooler\s*=\s*\"?(\w+)\"?\s*>\s*$!) {
- # new entry
- $inentry = 1;
- $entry->{foomatic} = $1;
- $entry->{spooler} = $2;
- }
- }
- }
- close QUEUEOUTPUT;
-
- return @queuelist;
-}
-
-sub copy_foomatic_queue {
- my ($printer, $oldqueue, $oldspooler, $newqueue) = @_;
- run_program::rooted($prefix, "foomatic-configure", "-q",
- "-s", $printer->{SPOOLER},
- "-n", $newqueue,
- "-C", $oldspooler, $oldqueue);
- # In case of CUPS set some more useful defaults for text and image printing
- if ($printer->{SPOOLER} eq "cups") {
- set_cups_special_options($newqueue);
- }
-}
-
-# ------------------------------------------------------------------
-#
-# Configuration of HP multi-function devices
-#
-# ------------------------------------------------------------------
-
-sub configure_hpoj {
- my ($device, @autodetected) = @_;
-
- # Make the subroutines of /usr/sbin/ptal-init available
- # It's only necessary to read it at the first call of this subroutine,
- # the subroutine definitions stay valid after leaving this subroutine.
- if (!$ptalinitread) {
- local *PTALINIT;
- open PTALINIT, "$prefix/usr/sbin/ptal-init" or do {
- die "unable to open $prefix/usr/sbin/ptal-init";
- };
- my @ptalinitfunctions; # subroutine definitions in /usr/sbin/ptal-init
- local $_;
- while (<PTALINIT>) {
- if (m!sub main!) {
- last;
- } elsif (m!^[^\#]!) {
- # Make the subroutines also working during installation
- if ($::isInstall) {
- s!\$prefix!\$hpoj_prefix!g;
- s!prefix=\"/usr\"!prefix=\"$prefix/usr\"!g;
- s!etcPtal=\"/etc/ptal\"!etcPtal=\"$prefix/etc/ptal\"!g;
- s!varLock=\"/var/lock\"!varLock=\"$prefix/var/lock\"!g;
- s!varRunPrefix=\"/var/run\"!varRunPrefix=\"$prefix/var/run\"!g;
- }
- push (@ptalinitfunctions, $_);
- }
- }
- close PTALINIT;
-
- eval "@ptalinitfunctions
- sub getDevnames {
- return (%devnames)
- }
- sub getConfigInfo {
- return (%configInfo)
- }";
-
- if ($::isInstall) {
- # Needed for photo card reader detection during installation
- system("ln -s $prefix/var/run/ptal-mlcd /var/run/ptal-mlcd");
- system("ln -s $prefix/etc/ptal /etc/ptal");
- }
- $ptalinitread = 1;
- }
-
- # Read the HPOJ config file and check whether this device is already
- # configured
- setupVariables ();
- readDeviceInfo ();
-
- $device =~ m!^/dev/\S*lp(\d+)$! or
- $device =~ m!^/dev/printers/(\d+)$! or
- $device =~ m!^socket://([^:]+)$! or
- $device =~ m!^socket://([^:]+):(\d+)$!;
- my $model = $1;
- my $model_long = "";
- my $serialnumber = "";
- my $serialnumber_long = "";
- my $cardreader = 0;
- my $device_ok = 1;
- my $bus;
- my $address_arg = "";
- my $base_address = "";
- my $hostname = "";
- my $port = $2;
- if ($device =~ /usb/) {
- $bus = "usb";
- } elsif (($device =~ /par/) ||
- ($device =~ /\/dev\/lp/) ||
- ($device =~ /printers/)) {
- $bus = "par";
- $address_arg = parport_addr($device);
- $address_arg =~ /^\s*-base\s+(\S+)/;
- eval ("$base_address = $1");
- } elsif ($device =~ /socket/) {
- $bus = "hpjd";
- $hostname = $model;
- return "" if $port && ($port < 9100 || $port > 9103);
- if ($port && $port != 9100) {
- $port -= 9100;
- $hostname .= ":$port";
- }
- } else {
- return "";
- }
- my $devdata;
- foreach (@autodetected) {
- $device eq $_->{port} or next;
- $devdata = $_;
- # $model is for the PTAL device name, so make sure that it is unique
- # so in the case of the model name auto-detection having failed leave
- # the port number or the host name as model name.
- my $searchunknown = N("Unknown model");
- if (($_->{val}{MODEL}) &&
- ($_->{val}{MODEL} !~ /$searchunknown/i) &&
- ($_->{val}{MODEL} !~ /^\s*$/)) {
- $model = $_->{val}{MODEL};
- }
- $serialnumber = $_->{val}{SERIALNUMBER};
- # Check if the device is really an HP multi-function device
- if ($bus ne "hpjd") {
- # Start ptal-mlcd daemon for locally connected devices
- stop_service("hpoj");
- run_program::rooted($prefix,
- "ptal-mlcd", "$bus:probe", "-device",
- $device, split(' ',$address_arg));
- }
- $device_ok = 0;
- my $ptalprobedevice = $bus eq "hpjd" ? "hpjd:$hostname" : "mlc:$bus:probe";
- local *F;
- if (open F, ($::testing ? $prefix : "chroot $prefix/ ") . "/usr/bin/ptal-devid $ptalprobedevice |") {
- my $devid = join("", <F>);
- close F;
- if ($devid) {
- $device_ok = 1;
- local *F;
- if (open F, ($::testing ? $prefix : "chroot $prefix/ ") . "/usr/bin/ptal-devid $ptalprobedevice -long -mdl 2>/dev/null |") {
- $model_long = join("", <F>);
- close F;
- chomp $model_long;
- # If SNMP or local port auto-detection failed but HPOJ
- # auto-detection succeeded, fill in model name here.
- if ((!$_->{val}{MODEL}) ||
- ($_->{val}{MODEL} =~ /$searchunknown/i) ||
- ($_->{val}{MODEL} =~ /^\s*$/)) {
- if ($model_long =~ /:([^:;]+);/) {
- $_->{val}{MODEL} = $1;
- }
- }
- }
- if (open F, ($::testing ? $prefix : "chroot $prefix/ ") . "/usr/bin/ptal-devid $ptalprobedevice -long -sern 2>/dev/null |") { #-#
- $serialnumber_long = join("", <F>);
- close F;
- chomp $serialnumber_long;
- }
- if (cardReaderDetected ($ptalprobedevice)) {
- $cardreader = 1;
- }
- }
- }
- if ($bus ne "hpjd") {
- # Stop ptal-mlcd daemon for locally connected devices
- local *F;
- if (open F, ($::testing ? $prefix : "chroot $prefix/ ") . "ps auxwww | grep \"ptal-mlcd $bus:probe\" | grep -v grep | ") {
- my $line = <F>;
- if ($line =~ /^\s*\S+\s+(\d+)\s+/) {
- my $pid = $1;
- kill (15, $pid);
- }
- close F;
- }
- start_service("hpoj");
- }
- last;
- }
- # No, it is not an HP multi-function device.
- return "" if !$device_ok;
-
- # Determine the ptal device name from already existing config files
- my $ptalprefix =
- ($bus eq "hpjd" ? "hpjd:" : "mlc:$bus:");
- my $ptaldevice = lookupDevname ($ptalprefix, $model_long,
- $serialnumber_long, $base_address);
-
- # It's all done for us, the device is already configured
- return $ptaldevice if defined($ptaldevice);
-
- # Determine the ptal name for a new device
- if ($bus eq "hpjd") {
- $ptaldevice = "hpjd:$hostname";
- } else {
- $ptaldevice = $model;
- $ptaldevice =~ s![\s/]+!_!g;
- $ptaldevice = "mlc:$bus:$ptaldevice";
- }
-
- # Delete any old/conflicting devices
- deleteDevice ($ptaldevice);
- if ($bus eq "par") {
- while (1) {
- my $oldDevname = lookupDevname ("mlc:par:",undef,undef,
- $base_address);
- if (!defined($oldDevname)) {
- last;
- }
- deleteDevice ($oldDevname);
- }
- }
-
- # Configure the device
-
- # Open configuration file
- local *CONFIG;
- open(CONFIG,"> $prefix/etc/ptal/$ptaldevice") or
- die "Could not open /etc/ptal/$ptaldevice for writing!\n";
-
- # Write file header.
- $_ = `date`;
- chomp;
- print CONFIG
- "# Added $_ by \"printerdrake\".\n".
- "\n".
- "# The basic format for this file is \"key[+]=value\".\n".
- "# If you say \"+=\" instead of \"=\", then the value is appended to any\n".
- "# value already defined for this key, rather than replacing it.\n".
- "\n".
- "# Comments must start at the beginning of the line. Otherwise, they may\n".
- "# be interpreted as being part of the value.\n".
- "\n".
- "# If you have multiple devices and want to define options that apply to\n".
- "# all of them, then put them in the file /etc/ptal/defaults, which is read\n".
- "# in before this file.\n".
- "\n".
- "# The format version of this file:\n".
- "# ptal-init ignores devices with incorrect/missing versions.\n".
- "init.version=1\n";
-
- # Write model string.
- if ($model_long !~ /\S/) {
- print CONFIG
- "\n".
- "# \"printerdrake\" couldn't read the model but added this device anyway:\n".
- "# ";
- } else {
- print CONFIG
- "\n".
- "# The device model that was originally detected on this port:\n".
- "# If this ever changes, then you should re-run \"printerdrake\"\n".
- "# to delete and re-configure this device.\n";
- if ($bus eq "par") {
- print CONFIG
- "# Comment out if you don't care what model is really connected to this\n".
- "# parallel port.\n";
- }
- }
- print CONFIG
- "init.mlcd.append+=-devidmatch \"$model_long\"\n";
-
- # Write serial-number string.
- if ($serialnumber_long!~/\S/) {
- print CONFIG
- "\n".
- "# The device's serial number is unknown.\n".
- "# ";
- } else {
- print CONFIG
- "\n".
- "# The serial number of the device that was originally detected on this port:\n";
- if ($bus=~/^[pu]/) {
- print CONFIG
- "# Comment out if you want to disable serial-number matching.\n";
- }
- }
- print CONFIG
- "init.mlcd.append+=-devidmatch \"$serialnumber_long\"\n";
-
- if ($bus=~/^[pu]/) {
- print CONFIG
- "\n".
- "# Standard options passed to ptal-mlcd:\n".
- "init.mlcd.append+=";
- if ($bus eq "usb") {
- # Important: don't put more quotes around /dev/usb/lp[0-9]*,
- # because ptal-mlcd currently does no globbing:
- print CONFIG "-device /dev/usb/lp[0-9]*";
- } elsif ($bus eq "par") {
- print CONFIG "$address_arg -device $device";
- }
- print CONFIG "\n".
- "\n".
- "# ptal-mlcd's remote console can be useful for debugging, but may be a\n".
- "# security/DoS risk otherwise. In any case, it's accessible with the\n".
- "# command \"ptal-connect mlc:<XXX>:<YYY> -service PTAL-MLCD-CONSOLE\".\n".
- "# Uncomment the following line if you want to enable this feature for\n".
- "# this device:\n".
- "# init.mlcd.append+=-remconsole\n".
- "\n".
- "# If you need to pass any other command-line options to ptal-mlcd, then\n".
- "# add them to the following line and uncomment the line:\n".
- "# init.mlcd.append+=\n".
- "\n".
- "# By default ptal-printd is started for mlc: devices. If you use CUPS,\n".
- "# then you may not be able to use ptal-printd, and you can uncomment the\n".
- "# following line to disable ptal-printd for this device:\n".
- "# init.printd.start=0\n";
- } else {
- print CONFIG
- "\n".
- "# By default ptal-printd isn't started for hpjd: devices.\n".
- "# If for some reason you want to start it for this device, then\n".
- "# uncomment the following line:\n".
- "init.printd.start=1\n";
- }
-
- print CONFIG
- "\n".
- "# If you need to pass any additional command-line options to ptal-printd,\n".
- "# then add them to the following line and uncomment the line:\n".
- "# init.printd.append+=\n";
- if ($cardreader) {
- print CONFIG
- "\n".
- "# Uncomment the following line to enable ptal-photod for this device:\n".
- "init.photod.start=1\n".
- "\n".
- "# If you have more than one photo-card-capable peripheral and you want to\n".
- "# assign particular TCP port numbers and mtools drive letters to each one,\n".
- "# then change the line below to use the \"-portoffset <n>\" option.\n".
- "init.photod.append+=-maxaltports 26\n";
- }
- close(CONFIG);
- readOneDevice ($ptaldevice);
-
- # Restart HPOJ
- restart_service("hpoj");
-
- # Return HPOJ device name to form the URI
- return $ptaldevice;
-}
-
-sub parport_addr {
- # auto-detect the parallel port addresses
- my ($device) = @_;
- $device =~ m!^/dev/lp(\d+)$! or
- $device =~ m!^/dev/printers/(\d+)$!;
- my $portnumber = $1;
- my $parport_addresses =
- `cat /proc/sys/dev/parport/parport$portnumber/base-addr`;
- my $address_arg;
- if ($parport_addresses =~ /^\s*(\d+)\s+(\d+)\s*$/) {
- $address_arg = sprintf(" -base 0x%x -basehigh 0x%x", $1, $2);
- } elsif ($parport_addresses =~ /^\s*(\d+)\s*$/) {
- $address_arg = sprintf(" -base 0x%x", $1);
- } else {
- $address_arg = "";
- }
- return $address_arg;
-}
-
-sub config_sane {
- # Add HPOJ backend to /etc/sane.d/dll.conf if needed (no individual
- # config file /etc/sane.d/hpoj.conf necessary, the HPOJ driver finds the
- # scanner automatically)
- return if member("hpoj", chomp_(cat_("$prefix/etc/sane.d/dll.conf")));
- local *F;
- open F, ">> $prefix/etc/sane.d/dll.conf" or
- die "can't write SANE config in /etc/sane.d/dll.conf: $!";
- print F "hpoj\n";
- close F;
-}
-
-sub config_photocard {
-
- # Add definitions for the drives p:. q:, r:, and s: to /etc/mtools.conf
- my $mtoolsconf = join("", cat_("$prefix/etc/mtools.conf"));
- return if $mtoolsconf =~ m/^\s*drive\s+p:/m;
- my $mtoolsconf_append = "
-# Drive definitions added for the photo card readers in HP multi-function
-# devices driven by HPOJ
-drive p: file=\":0\" remote
-drive q: file=\":1\" remote
-drive r: file=\":2\" remote
-drive s: file=\":3\" remote
-# This turns off some file system integrity checks of mtools, it is needed
-# for some photo cards.
-mtools_skip_check=1
-";
- local *F;
- open F, ">> $prefix/etc/mtools.conf" or
- die "can't write mtools config in /etc/mtools.conf: $!";
- print F $mtoolsconf_append;
- close F;
-
- # Generate a config file for the graphical mtools frontend MToolsFM or
- # modify the existing one
- my $mtoolsfmconf;
- if (-f "$prefix/etc/mtoolsfm.conf") {
- $mtoolsfmconf = cat_("$prefix/etc/mtoolsfm.conf") or die "can't read MToolsFM config in $prefix/etc/mtoolsfm.conf: $!";
- $mtoolsfmconf =~ m/^\s*DRIVES\s*=\s*\"([A-Za-z ]*)\"/m;
- my $alloweddrives = lc($1);
- foreach my $letter ("p", "q", "r", "s") {
- if ($alloweddrives !~ /$letter/) {
- $alloweddrives .= $letter;
- }
- }
- $mtoolsfmconf =~ s/^\s*DRIVES\s*=\s*\"[A-Za-z ]*\"/DRIVES=\"$alloweddrives\"/m;
- $mtoolsfmconf =~ s/^\s*LEFTDRIVE\s*=\s*\"[^\"]*\"/LEFTDRIVE=\"p\"/m;
- } else {
- $mtoolsfmconf = "\# MToolsFM config file. comments start with a hash sign.
-\#
-\# This variable sets the allowed driveletters (all lowercase). Example:
-\# DRIVES=\"ab\"
-DRIVES=\"apqrs\"
-\#
-\# This variable sets the driveletter upon startup in the left window.
-\# An empty string or space is for the hardisk. Example:
-\# LEFTDRIVE=\"a\"
-LEFTDRIVE=\"p\"
-\#
-\# This variable sets the driveletter upon startup in the right window.
-\# An empty string or space is for the hardisk. Example:
-\# RIGHTDRIVE=\"a\"
-RIGHTDRIVE=\" \"
-";
- }
- output("$prefix/etc/mtoolsfm.conf", $mtoolsfmconf);
-}
-
-# ------------------------------------------------------------------
-#
-# Configuration of printers in applications
-#
-# ------------------------------------------------------------------
-
-sub configureapplications {
- my ($printer) = @_;
- setcupslink ($printer);
- configurestaroffice($printer);
- configureopenoffice($printer);
- configuregimp($printer);
-}
-
-sub addcupsremotetoapplications {
- my ($printer, $queue) = @_;
- setcupslink ($printer);
- return (addcupsremotetostaroffice($printer, $queue) &&
- addcupsremotetoopenoffice($printer, $queue) &&
- addcupsremotetogimp($printer, $queue));
-}
-
-sub removeprinterfromapplications {
- my ($printer, $queue) = @_;
- setcupslink ($printer);
- return (removeprinterfromstaroffice($printer, $queue) &&
- removeprinterfromopenoffice($printer, $queue) &&
- removeprinterfromgimp($printer, $queue));
-}
-
-sub removelocalprintersfromapplications {
- my ($printer) = @_;
- setcupslink ($printer);
- removelocalprintersfromstaroffice($printer);
- removelocalprintersfromopenoffice($printer);
- removelocalprintersfromgimp($printer);
-}
-
-sub setcupslink {
- my ($printer) = @_;
- return 1 if !$::isInstall;
- return 1 if $printer->{SPOOLER} ne "cups";
- return 1 if -d "/etc/cups/ppd";
- system("ln -sf $prefix/etc/cups /etc/cups");
- return 1;
-}
-
-sub getcupsremotequeues {
- # The following code reads in a list of all remote printers which the
- # local CUPS daemon knows due to broadcasting of remote servers or
- # "BrowsePoll" entries in the local /etc/cups/cupsd.conf
- local *F;
- open F, ($::testing ? $prefix : "chroot $prefix/ ") .
- "lpstat -v |" or return ();
- my @printerlist;
- my $line;
- while ($line = <F>) {
- if ($line =~ m/^\s*device\s+for\s+([^:\s]+):\s*(\S+)\s*$/) {
- my $queuename = $1;
- if (($2 =~ m!^ipp://([^/:]+)[:/]!) &&
- (!$printer->{configured}{$queuename})) {
- my $server = $1;
- push (@printerlist, "$queuename|$server");
- }
- }
- }
- close F;
- return @printerlist;
-}
-
-# ------------------------------------------------------------------
-# Star Offica/OpenOffice.org
-# ------------------------------------------------------------------
-
-sub configurestaroffice {
- my ($printer) = @_;
- # Do we have Star Office installed?
- my $configfilename = findsofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/xp3/Xpdefaults$!;
- my $configprefix = $1;
- # Load Star Office printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Update remote CUPS queues
- if (0 && ($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- my @printerlist = getcupsremotequeues();
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $queue = $1;
- my $server = $2;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$queue.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$queue.ppd"));
- }
- if (-r "$prefix/etc/foomatic/$queue.ppd") {
- $configfilecontent =
- makestarofficeprinterentry($printer, $queue,
- $configprefix,
- $configfilecontent);
- }
- }
- }
- # Update local printer queues
- foreach my $queue (keys(%{$printer->{configured}})) {
- # Check if we have a PPD file
- if (! -r "$prefix/etc/foomatic/$queue.ppd") {
- if (-r "$prefix/etc/cups/ppd/$queue.ppd") {
- # If we have a PPD file in the CUPS config dir, link to it
- run_program::rooted($prefix,
- "ln", "-sf",
- "/etc/cups/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } elsif (-r "$prefix/usr/share/postscript/ppd/$queue.ppd") {
- # Check PPD directory of GPR, too
- run_program::rooted($prefix,
- "ln", "-sf",
- "/usr/share/postscript/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } else {
- # No PPD file at all? We cannot set up this printer
- next;
- }
- }
- $configfilecontent =
- makestarofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- }
- # Patch PostScript output to print Euro symbol correctly also for
- # the "Generic Printer"
- $configfilecontent = removeentry
- ("ports", "default_queue=", $configfilecontent);
- $configfilecontent = addentry
- ("ports",
- "default_queue=/usr/bin/perl -p -e \"s=16#80 /euro=16#80 /Euro=\" | /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}}",
- $configfilecontent);
- # Write back Star Office configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub configureopenoffice {
- my ($printer) = @_;
- # Do we have OpenOffice.org installed?
- my $configfilename = findopenofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/psprint/psprint.conf$!;
- my $configprefix = $1;
- # Load OpenOffice.org printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Update remote CUPS queues
- if (0 && ($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- my @printerlist = getcupsremotequeues();
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $queue = $1;
- my $server = $2;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$queue.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$queue.ppd"));
- }
- if (-r "$prefix/etc/foomatic/$queue.ppd") {
- $configfilecontent =
- makeopenofficeprinterentry($printer, $queue,
- $configprefix,
- $configfilecontent);
- }
- }
- }
- # Update local printer queues
- foreach my $queue (keys(%{$printer->{configured}})) {
- # Check if we have a PPD file
- if (! -r "$prefix/etc/foomatic/$queue.ppd") {
- if (-r "$prefix/etc/cups/ppd/$queue.ppd") {
- # If we have a PPD file in the CUPS config dir, link to it
- run_program::rooted($prefix,
- "ln", "-sf",
- "/etc/cups/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } elsif (-r "$prefix/usr/share/postscript/ppd/$queue.ppd") {
- # Check PPD directory of GPR, too
- run_program::rooted($prefix,
- "ln", "-sf",
- "/usr/share/postscript/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } else {
- # No PPD file at all? We cannot set up this printer
- next;
- }
- }
- $configfilecontent =
- makeopenofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- }
- # Patch PostScript output to print Euro symbol correctly also for
- # the "Generic Printer"
- $configfilecontent = removeentry
- ("Generic Printer", "Command=", $configfilecontent);
- $configfilecontent = addentry
- ("Generic Printer",
- "Command=/usr/bin/perl -p -e \"s=/euro /unused=/Euro /unused=\" | /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}}",
- $configfilecontent);
- # Write back OpenOffice.org configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub addcupsremotetostaroffice {
- my ($printer, $queue) = @_;
- # Do we have Star Office installed?
- my $configfilename = findsofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/xp3/Xpdefaults$!;
- my $configprefix = $1;
- # Load Star Office printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Update remote CUPS queues
- if (($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- my @printerlist = getcupsremotequeues();
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $q = $1;
- next if $q ne $queue;
- my $server = $2;
- # Remove server name from queue name
- $q =~ s/^([^@]*)@.*$/$1/;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- }
- # Does the file exist and is it not an error message?
- if ((-r "$prefix/etc/foomatic/$queue.ppd") &&
- (cat_("$prefix/etc/foomatic/$queue.ppd") =~
- /^\*PPD-Adobe/)) {
- $configfilecontent =
- makestarofficeprinterentry($printer, $queue,
- $configprefix,
- $configfilecontent);
- } else {
- unlink ("$prefix/etc/foomatic/$queue.ppd");
- return 0;
- }
- last;
- }
- }
- # Write back Star Office configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub addcupsremotetoopenoffice {
- my ($printer, $queue) = @_;
- # Do we have OpenOffice.org installed?
- my $configfilename = findopenofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/psprint/psprint.conf$!;
- my $configprefix = $1;
- # Load OpenOffice.org printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Update remote CUPS queues
- if (($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- my @printerlist = getcupsremotequeues();
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $q = $1;
- next if $q ne $queue;
- my $server = $2;
- # Remove server name from queue name
- $q =~ s/^([^@]*)@.*$/$1/;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- }
- # Does the file exist and is it not an error message?
- if ((-r "$prefix/etc/foomatic/$queue.ppd") &&
- (cat_("$prefix/etc/foomatic/$queue.ppd") =~
- /^\*PPD-Adobe/)) {
- $configfilecontent =
- makeopenofficeprinterentry($printer, $queue,
- $configprefix,
- $configfilecontent);
- } else {
- unlink ("$prefix/etc/foomatic/$queue.ppd");
- return 0;
- }
- }
- }
- # Write back OpenOffice.org configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub removeprinterfromstaroffice {
- my ($printer, $queue) = @_;
- # Do we have Star Office installed?
- my $configfilename = findsofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/xp3/Xpdefaults$!;
- my $configprefix = $1;
- # Load Star Office printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Remove the printer entry
- $configfilecontent =
- removestarofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- # Write back Star Office configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub removeprinterfromopenoffice {
- my ($printer, $queue) = @_;
- # Do we have OpenOffice.org installed?
- my $configfilename = findopenofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/psprint/psprint.conf$!;
- my $configprefix = $1;
- # Load OpenOffice.org printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Remove the printer entry
- $configfilecontent =
- removeopenofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- # Write back OpenOffice.org configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub removelocalprintersfromstaroffice {
- my ($printer) = @_;
- # Do we have Star Office installed?
- my $configfilename = findsofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/xp3/Xpdefaults$!;
- my $configprefix = $1;
- # Load Star Office printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Remove the printer entries
- foreach my $queue (keys(%{$printer->{configured}})) {
- $configfilecontent =
- removestarofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- }
- # Write back Star Office configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub removelocalprintersfromopenoffice {
- my ($printer) = @_;
- # Do we have OpenOffice.org installed?
- my $configfilename = findopenofficeconfigfile();
- return 1 if !$configfilename;
- $configfilename =~ m!^(.*)/share/psprint/psprint.conf$!;
- my $configprefix = $1;
- # Load OpenOffice.org printer config file
- my $configfilecontent = readsofficeconfigfile($configfilename);
- # Remove the printer entries
- foreach my $queue (keys(%{$printer->{configured}})) {
- $configfilecontent =
- removeopenofficeprinterentry($printer, $queue, $configprefix,
- $configfilecontent);
- }
- # Write back OpenOffice.org configuration file
- return writesofficeconfigfile($configfilename, $configfilecontent);
-}
-
-sub makestarofficeprinterentry {
- my ($printer, $queue, $configprefix, $configfile) = @_;
- # Set default printer
- if ($queue eq $printer->{DEFAULT}) {
- $configfile = removeentry("windows", "device=", $configfile);
- $configfile = addentry("windows",
- "device=$queue,$queue PostScript,$queue",
- $configfile);
- }
- # Make an entry in the "[devices]" section
- $configfile = removeentry("devices", "$queue=", $configfile);
- $configfile = addentry("devices",
- "$queue=$queue PostScript,$queue",
- $configfile);
- # Make an entry in the "[ports]" section
- # The "perl" command patches the PostScript output to print the Euro
- # symbol correctly.
- $configfile = removeentry("ports", "$queue=", $configfile);
- $configfile = addentry("ports",
- "$queue=/usr/bin/perl -p -e \"s=16#80 /euro=16#80 /Euro=\" | /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}} -P $queue",
- $configfile);
- # Make printer's section
- $configfile = addsection("$queue,PostScript,$queue", $configfile);
- # Load PPD file
- my $ppd = cat_("$prefix/etc/foomatic/$queue.ppd");
- # Set the PostScript level
- my $pslevel;
- if ($ppd =~ /^\s*\*LanguageLevel:\s*\"?([^\s\"]+)\"?\s*$/m) {
- $pslevel = $1;
- $pslevel = "2" if $pslevel eq "3";
- } else {
- $pslevel = "2";
- }
- $configfile = removeentry("$queue.PostScript.$queue",
- "Level=", $configfile);
- $configfile = addentry("$queue.PostScript.$queue",
- "Level=$pslevel", $configfile);
- # Set Color/BW
- my $color;
- if ($ppd =~ /^\s*\*ColorDevice:\s*\"?([Tt]rue)\"?\s*$/m) {
- $color = "1";
- } else {
- $color = "0";
- }
- $configfile = removeentry("$queue.PostScript.$queue",
- "BitmapColor=", $configfile);
- $configfile = addentry("$queue.PostScript.$queue",
- "BitmapColor=$color", $configfile);
- # Set the default paper size
- if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
- my $papersize = $1;
- $configfile = removeentry("$queue.PostScript.$queue",
- "PageSize=", $configfile);
- $configfile = removeentry("$queue.PostScript.$queue",
- "PPD_PageSize=", $configfile);
- $configfile = addentry("$queue.PostScript.$queue",
- "PageSize=$papersize", $configfile);
- $configfile = addentry("$queue.PostScript.$queue",
- "PPD_PageSize=$papersize", $configfile);
- }
- # Link the PPD file
- run_program::rooted($prefix,
- "ln", "-sf", "/etc/foomatic/$queue.ppd",
- "$configprefix/share/xp3/ppds/$queue.PS");
- return $configfile;
-}
-
-sub makeopenofficeprinterentry {
- my ($printer, $queue, $configprefix, $configfile) = @_;
- # Make printer's section
- $configfile = addsection($queue, $configfile);
- # Load PPD file
- my $ppd = cat_("$prefix/etc/foomatic/$queue.ppd");
- # "PPD_PageSize" line
- if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
- my $papersize = $1;
- $configfile = removeentry($queue,
- "PPD_PageSize=", $configfile);
- $configfile = addentry($queue,
- "PPD_PageSize=$papersize", $configfile);
- }
- # "Command" line
- # The "perl" command patches the PostScript output to print the Euro
- # symbol correctly.
- $configfile = removeentry($queue, "Command=", $configfile);
- $configfile = addentry($queue,
- "Command=/usr/bin/perl -p -e \"s=/euro /unused=/Euro /unused=\" | /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}} -P $queue",
- $configfile);
- # "Comment" line
- $configfile = removeentry($queue, "Comment=", $configfile);
- if (($printer->{configured}{$queue}) &&
- ($printer->{configured}{$queue}{queuedata}{desc})) {
- $configfile = addentry
- ($queue,
- "Comment=$printer->{configured}{$queue}{queuedata}{desc}",
- $configfile);
- } else {
- $configfile = addentry($queue,
- "Comment=",
- $configfile);
- }
- # "Location" line
- $configfile = removeentry($queue, "Location=", $configfile);
- if (($printer->{configured}{$queue}) &&
- ($printer->{configured}{$queue}{queuedata}{loc})) {
- $configfile = addentry
- ($queue,
- "Location=$printer->{configured}{$queue}{queuedata}{loc}",
- $configfile);
- } else {
- $configfile = addentry($queue,
- "Location=",
- $configfile);
- }
- # "DefaultPrinter" line
- $configfile = removeentry($queue, "DefaultPrinter=", $configfile);
- my $default = "0";
- if ($queue eq $printer->{DEFAULT}) {
- $default = "1";
- # "DefaultPrinter=0" for the "Generic Printer"
- $configfile = removeentry("Generic Printer", "DefaultPrinter=",
- $configfile);
- $configfile = addentry("Generic Printer",
- "DefaultPrinter=0",
- $configfile);
- }
- $configfile = addentry($queue,
- "DefaultPrinter=$default",
- $configfile);
- # "Printer" line
- $configfile = removeentry($queue, "Printer=", $configfile);
- $configfile = addentry($queue,
- "Printer=$queue/$queue",
- $configfile);
- # Link the PPD file
- run_program::rooted($prefix,
- "ln", "-sf", "/etc/foomatic/$queue.ppd",
- "$configprefix/share/psprint/driver/$queue.PS");
- return $configfile;
-}
-
-sub removestarofficeprinterentry {
- my ($printer, $queue, $configprefix, $configfile) = @_;
- # Remove default printer entry
- $configfile = removeentry("windows", "device=$queue,", $configfile);
- # Remove entry in the "[devices]" section
- $configfile = removeentry("devices", "$queue=", $configfile);
- # Remove entry in the "[ports]" section
- $configfile = removeentry("ports", "$queue=", $configfile);
- # Remove "[$queue,PostScript,$queue]" section
- $configfile = removesection("$queue,PostScript,$queue", $configfile);
- # Remove Link of PPD file
- run_program::rooted($prefix,
- "rm", "-f",
- "$configprefix/share/xp3/ppds/$queue.PS");
- return $configfile;
-}
-
-sub removeopenofficeprinterentry {
- my ($printer, $queue, $configprefix, $configfile) = @_;
- # Remove printer's section
- $configfile = removesection($queue, $configfile);
- # Remove Link of PPD file
- run_program::rooted($prefix,
- "rm", "-f",
- "$configprefix/share/psprint/driver/$queue.PS");
- return $configfile;
-}
-
-sub findsofficeconfigfile {
- my @configfilenames =
- ("/usr/lib/*/share/xp3/Xpdefaults",
- "/usr/local/lib/*/share/xp3/Xpdefaults",
- "/usr/local/*/share/xp3/Xpdefaults",
- "/opt/*/share/xp3/Xpdefaults");
- foreach my $configfilename (@configfilenames) {
- local *F;
- if (open F, "ls -r $prefix$configfilename 2> /dev/null |") {
- my $filename = <F>;
- close F;
- if ($filename) {
- if ($prefix ne "") {
- $filename =~ s/^$prefix//;
- }
- # Work around a bug in the "ls" of "busybox". During
- # installation it outputs the mask given on the command line
- # instead of nothing when the mask does not match any file
- next if $filename =~ /\*/;
- return $filename;
- }
- }
- }
- return "";
-}
-
-sub findopenofficeconfigfile {
- my @configfilenames =
- ("/usr/lib/*/share/psprint/psprint.conf",
- "/usr/local/lib/*/share/psprint/psprint.conf",
- "/usr/local/*/share/psprint/psprint.conf",
- "/opt/*/share/psprint/psprint.conf");
- foreach my $configfilename (@configfilenames) {
- local *F;
- if (open F, "ls -r $prefix$configfilename 2> /dev/null |") {
- my $filename = <F>;
- close F;
- if ($filename) {
- if ($prefix ne "") {
- $filename =~ s/^$prefix//;
- }
- # Work around a bug in the "ls" of "busybox". During
- # installation it outputs the mask given on the command line
- # instead of nothing when the mask does not match any file
- next if $filename =~ /\*/;
- return $filename;
- }
- }
- }
- return "";
-}
-
-sub readsofficeconfigfile {
- my ($file) = @_;
- local *F;
- open F, "< $prefix$file" or return "";
- my $filecontent = join("", <F>);
- close F;
- return $filecontent;
-}
-
-sub writesofficeconfigfile {
- my ($file, $filecontent) = @_;
- local *F;
- open F, "> $prefix$file" or return 0;
- print F $filecontent;
- close F;
- return 1;
-}
-
-sub addentry {
- my ($section, $entry, $filecontent) = @_;
- my $sectionfound = 0;
- my $entryinserted = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- if (!$sectionfound) {
- if (/^\s*\[\s*$section\s*\]\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (!/^\s*$/ && !/^\s*;/) { #-#
- $_ = "$entry\n$_";
- $entryinserted = 1;
- last;
- }
- }
- }
- if ($sectionfound && !$entryinserted) {
- push(@lines, $entry);
- }
- return join ("\n", @lines);
-}
-
-sub addsection {
- my ($section, $filecontent) = @_;
- my $entryinserted = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- if (/^\s*\[\s*$section\s*\]\s*$/) {
- # section already there, nothing to be done
- return $filecontent;
- }
- }
- return $filecontent . "\n[$section]";
-}
-
-sub removeentry {
- my ($section, $entry, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- $_ = "$_\n";
- next if $done;
- if (!$sectionfound) {
- if (/^\s*\[\s*$section\s*\]\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (/^\s*\[.*\]\s*$/) { # Next section
- $done = 1;
- } elsif (/^\s*$entry/) {
- $_ = "";
- $done = 1;
- }
- }
- }
- return join ("", @lines);
-}
-
-sub removesection {
- my ($section, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- $_ = "$_\n";
- next if $done;
- if (!$sectionfound) {
- if (/^\s*\[\s*$section\s*\]\s*$/) {
- $_ = "";
- $sectionfound = 1;
- }
- } else {
- if (/^\s*\[.*\]\s*$/) { # Next section
- $done = 1;
- } else {
- $_ = "";
- }
- }
- }
- return join ("", @lines);
-}
-
-# ------------------------------------------------------------------
-# GIMP
-# ------------------------------------------------------------------
-
-sub configuregimp {
- my ($printer, $queue) = @_;
- # Do we have files to treat?
- my @configfilenames = findgimpconfigfiles();
- return 1 if $#configfilenames < 0;
- # There is no system-wide config file, treat every user's config file
- foreach my $configfilename (@configfilenames) {
- # Load GIMP's printer config file
- my $configfilecontent = readgimpconfigfile($configfilename);
- # Update local printer queues
- foreach my $queue (keys(%{$printer->{configured}})) {
- # Check if we have a PPD file
- if (! -r "$prefix/etc/foomatic/$queue.ppd") {
- if (-r "$prefix/etc/cups/ppd/$queue.ppd") {
- # If we have a PPD file in the CUPS config dir, link to it
- run_program::rooted($prefix,
- "ln", "-sf",
- "/etc/cups/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } elsif (-r "$prefix/usr/share/postscript/ppd/$queue.ppd") {
- # Check PPD directory of GPR, too
- run_program::rooted
- ($prefix,
- "ln", "-sf",
- "/usr/share/postscript/ppd/$queue.ppd",
- "/etc/foomatic/$queue.ppd");
- } else {
- # No PPD file at all? We cannot set up this printer
- next;
- }
- }
- # Add the printer entry
- if (!isgimpprinterconfigured ($queue, $configfilecontent)) {
- # Remove the old printer entry
- $configfilecontent =
- removegimpprinter($queue, $configfilecontent);
- # Add the new printer entry
- $configfilecontent =
- makegimpprinterentry($printer, $queue,
- $configfilecontent);
- }
- }
- # Default printer
- if ($printer->{DEFAULT}) {
- if ($configfilecontent !~ /^\s*Current\-Printer\s*:/m) {
- $configfilecontent =~
- s/\n/\nCurrent-Printer: $printer->{DEFAULT}\n/s;
- } else {
- $configfilecontent =~ /^\s*Current\-Printer\s*:\s*(\S+)\s*$/m;
- if (!isgimpprinterconfigured ($1, $configfilecontent)) {
- $configfilecontent =~
- s/(Current\-Printer\s*:\s*)\S+/$1$printer->{DEFAULT}/;
- }
- }
- }
- # Write back GIMP's printer configuration file
- writegimpconfigfile($configfilename, $configfilecontent);
- }
- return 1;
-}
-
-sub addcupsremotetogimp {
- my ($printer, $queue) = @_;
- # Do we have files to treat?
- my @configfilenames = findgimpconfigfiles();
- return 1 if $#configfilenames < 0;
- my @printerlist = getcupsremotequeues();
- my $ppdfile = "";
- if (($printer->{SPOOLER} eq "cups") &&
- ((-x "$prefix/usr/bin/curl") || (-x "$prefix/usr/bin/wget"))) {
- foreach my $listentry (@printerlist) {
- next if !($listentry =~ /^([^\|]+)\|([^\|]+)$/);
- my $q = $1;
- next if $q ne $queue;
- my $server = $2;
- # Remove server name from queue name
- $q =~ s/^([^@]*)@.*$/$1/;
- if (-x "$prefix/usr/bin/wget") {
- eval(run_program::rooted
- ($prefix, "/usr/bin/wget", "-O",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- } else {
- eval(run_program::rooted
- ($prefix, "/usr/bin/curl", "-o",
- "/etc/foomatic/$queue.ppd",
- "http://$server:631/printers/$q.ppd"));
- }
- # Does the file exist and is it not an error message?
- if ((-r "$prefix/etc/foomatic/$queue.ppd") &&
- (cat_("$prefix/etc/foomatic/$queue.ppd") =~
- /^\*PPD-Adobe/)) {
- $ppdfile = "/etc/foomatic/$queue.ppd";
- } else {
- unlink ("$prefix/etc/foomatic/$queue.ppd");
- return 0;
- }
- }
- } else {
- return 1;
- }
- # There is no system-wide config file, treat every user's config file
- foreach my $configfilename (@configfilenames) {
- # Load GIMP's printer config file
- my $configfilecontent = readgimpconfigfile($configfilename);
- # Add the printer entry
- if (!isgimpprinterconfigured ($queue, $configfilecontent)) {
- # Remove the old printer entry
- $configfilecontent =
- removegimpprinter($queue, $configfilecontent);
- # Add the new printer entry
- $configfilecontent =
- makegimpprinterentry($printer, $queue,
- $configfilecontent);
- }
- # Write back GIMP's printer configuration file
- writegimpconfigfile($configfilename, $configfilecontent);
- }
- return 1;
-}
-
-sub removeprinterfromgimp {
- my ($printer, $queue) = @_;
- # Do we have files to treat?
- my @configfilenames = findgimpconfigfiles();
- return 1 if $#configfilenames < 0;
- # There is no system-wide config file, treat every user's config file
- foreach my $configfilename (@configfilenames) {
- # Load GIMP's printer config file
- my $configfilecontent = readgimpconfigfile($configfilename);
- # Remove the printer entry
- $configfilecontent =
- removegimpprinter($queue, $configfilecontent);
- # Write back GIMP's printer configuration file
- writegimpconfigfile($configfilename, $configfilecontent);
- }
- return 1;
-}
-
-sub removelocalprintersfromgimp {
- my ($printer) = @_;
- # Do we have files to treat?
- my @configfilenames = findgimpconfigfiles();
- return 1 if $#configfilenames < 0;
- # There is no system-wide config file, treat every user's config file
- foreach my $configfilename (@configfilenames) {
- # Load GIMP's printer config file
- my $configfilecontent = readgimpconfigfile($configfilename);
- # Remove the printer entries
- foreach my $queue (keys(%{$printer->{configured}})) {
- $configfilecontent =
- removegimpprinter($queue, $configfilecontent);
- }
- # Write back GIMP's printer configuration file
- writegimpconfigfile($configfilename, $configfilecontent);
- }
- return 1;
-}
-
-sub makegimpprinterentry {
- my ($printer, $queue, $configfile) = @_;
- # Make printer's section
- $configfile = addgimpprinter($queue, $configfile);
- # Load PPD file
- my $ppd = cat_("$prefix/etc/foomatic/$queue.ppd");
- # Is the printer configured with GIMP-Print?
- my $gimpprintqueue = 0;
- my $gimpprintdriver = "ps2";
- if ($ppd =~ /CUPS\s*\+\s*GIMP\s*\-\s*Print/im) {
- # Native CUPS driver
- $gimpprintqueue = 1;
- $ppd =~ /\s*\*ModelName:\s*\"(\S+)\"\s*$/im;
- $gimpprintdriver = $1;
- } elsif ($ppd =~ /Foomatic\s*\+\s*gimp\s*\-\s*print/im) {
- # GhostScript + Foomatic driver
- $gimpprintqueue = 1;
- $ppd =~
- /'idx'\s*=>\s*'ev\/gimp-print-((escp2|pcl|bjc|lexmark)\-\S*)'/im;
- $gimpprintdriver = $1;
- }
- if ($gimpprintqueue) {
- # Get the paper size from the PPD file
- if ($ppd =~ /^\s*\*DefaultPageSize:\s*(\S+)\s*$/m) {
- my $papersize = $1;
- $configfile = removegimpentry($queue,
- "Media-Size", $configfile);
- $configfile = addgimpentry($queue,
- "Media-Size: $papersize", $configfile);
- }
- $configfile = removegimpentry($queue,
- "PPD-File:", $configfile);
- $configfile = addgimpentry($queue,
- "PPD-File:", $configfile);
- $configfile = removegimpentry($queue,
- "Driver:", $configfile);
- $configfile = addgimpentry($queue,
- "Driver: $gimpprintdriver", $configfile);
- $configfile = removegimpentry($queue,
- "Destination:", $configfile);
- $configfile = addgimpentry($queue,
- "Destination: /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}} -P $queue -o raw", $configfile);
- } else {
- $configfile = removegimpentry($queue,
- "PPD-File:", $configfile);
- $configfile = addgimpentry($queue,
- "PPD-File: /etc/foomatic/$queue.ppd", $configfile);
- $configfile = removegimpentry($queue,
- "Driver:", $configfile);
- $configfile = addgimpentry($queue,
- "Driver: ps2", $configfile);
- $configfile = removegimpentry($queue,
- "Destination:", $configfile);
- $configfile = addgimpentry($queue,
- "Destination: /usr/bin/$lprcommand{$printer->{SPOOLER}{print_command}} -P $queue", $configfile);
- }
- return $configfile;
-}
-
-sub findgimpconfigfiles {
- my @configfilenames;
- if (-d "$prefix/usr/lib/gimp/1.2") {
- push (@configfilenames, ".gimp-1.2/printrc");
- }
- if (-d "$prefix/usr/lib/gimp/1.3") {
- push (@configfilenames, ".gimp-1.3/printrc");
- }
- my @filestotreat;
- local *PASSWD;
- open PASSWD, "< $prefix/etc/passwd" or die "Cannot read /etc/passwd!\n";
- local $_;
- while (<PASSWD>) {
- chomp;
- if (/^([^:]+):[^:]*:([^:]+):([^:]+):[^:]*:([^:]+):[^:]*$/) {
- my ($username, $uid, $gid, $homedir) = ($1, $2, $3, $4);
- if ((($uid == 0) || ($uid >= 500)) && ($username ne "nobody")) {
- foreach my $file (@configfilenames) {
- my $dir = "$homedir/$file";
- $dir =~ s,/[^/]*$,,;
- next if (-f $dir) && (! -d $dir);
- if (! -d "$prefix$dir") {
- run_program::rooted($prefix,
- "/bin/mkdir", $dir)
- or next;
- run_program::rooted($prefix,
- "/bin/chown", "$uid.$gid", $dir)
- or next;
- }
- if (! -f "$prefix$homedir/$file") {
- local *F;
- open F, "> $prefix$homedir/$file" or next;
- print F "#PRINTRCv1 written by GIMP-PRINT 4.2.2 - 13 Sep 2002\n";
- close F;
- run_program::rooted($prefix,
- "/bin/chown", "$uid.$gid",
- "$homedir/$file")
- or next;
- }
- push (@filestotreat, "$homedir/$file");
- }
- }
- }
- }
- @filestotreat;
-}
-
-sub readgimpconfigfile {
- my ($file) = @_;
- local *F;
- open F, "< $prefix$file" or return "";
- my $filecontent = join("", <F>);
- close F;
- return $filecontent;
-}
-
-sub writegimpconfigfile {
- my ($file, $filecontent) = @_;
- local *F;
- open F, "> $prefix$file" or return 0;
- print F $filecontent;
- close F;
- return 1;
-}
-
-sub addgimpentry {
- my ($section, $entry, $filecontent) = @_;
- my $sectionfound = 0;
- my $entryinserted = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- if (!$sectionfound) {
- if (/^\s*Printer\s*:\s*($section)\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (!/^\s*$/ && !/^\s*;/) { #-#
- $_ = "$entry\n$_";
- $entryinserted = 1;
- last;
- }
- }
- }
- if ($sectionfound && !$entryinserted) {
- push(@lines, $entry);
- }
- return join ("\n", @lines);
-}
-
-sub addgimpprinter {
- my ($section, $filecontent) = @_;
- my $entryinserted = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- if (/^\s*Printer\s*:\s*($section)\s*$/) {
- # section already there, nothing to be done
- return $filecontent;
- }
- }
- return $filecontent . "\nPrinter: $section";
-}
-
-sub removegimpentry {
- my ($section, $entry, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- $_ = "$_\n";
- next if $done;
- if (!$sectionfound) {
- if (/^\s*Printer\s*:\s*($section)\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
- $done = 1;
- } elsif (/^\s*$entry/) {
- $_ = "";
- $done = 1;
- }
- }
- }
- return join ("", @lines);
-}
-
-sub removegimpprinter {
- my ($section, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- $_ = "$_\n";
- next if $done;
- if (!$sectionfound) {
- if (/^\s*Printer\s*:\s*($section)\s*$/) {
- $_ = "";
- $sectionfound = 1;
- }
- } else {
- if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
- $done = 1;
- } else {
- $_ = "";
- }
- }
- }
- return join ("", @lines);
-}
-
-sub isgimpprinterconfigured {
- my ($queue, $filecontent) = @_;
- my $sectionfound = 0;
- my $done = 0;
- my $drivernotps2 = 0;
- my $ppdfileset = 0;
- my $nonrawprinting = 0;
- my @lines = split("\n", $filecontent);
- foreach (@lines) {
- last if $done;
- if (!$sectionfound) {
- if (/^\s*Printer\s*:\s*($queue)\s*$/) {
- $sectionfound = 1;
- }
- } else {
- if (/^\s*Printer\s*:\s*.*\s*$/) { # Next section
- $done = 1;
- } elsif (/^\s*Driver:\s*(\S+)\s*$/) {
- $drivernotps2 = ($1 ne "ps2");
- } elsif (/^\s*PPD\-File:\s*(\S+)\s*$/) {
- $ppdfileset = 1;
- } elsif (/^\s*Destination:\s*(\S+.*)$/) {
- $nonrawprinting = ($1 !~ /\-o\s*raw/);
- }
- }
- }
- return 0 if $done && !$sectionfound;
- return 1 if $ppdfileset || $drivernotps2 || $nonrawprinting;
- return 0;
-}
-
-# ------------------------------------------------------------------
-
-1;