index : drakx	distro/mdv2007.1 distro/mdv2008.0 distro/mdv2008.1 distro/mdv2009.0 distro/mdv2009.1 distro/mdv2010.0 distro/mes5 distro/mes5-2.6.33 distro/mes6 distro/mga1 distro/mga2 distro/mga3 distro/mga4 distro/mga5 distro/mga6 distro/mga7 distro/mga8 distro/mga9 master topic/Corpo_2_1 topic/KA9_0 topic/MDK-10-update topic/MDK-10_1-update topic/MDK-10_2-update topic/MDK-2006_0-update topic/MDK92-branch topic/MDKC_1_0 topic/PCMCIA_CS_DISTRO topic/R9_0-64bit-branch topic/R9_1_HP-branch topic/a topic/before_matchbox_wm topic/bug-13680 topic/dietlibc topic/efi topic/extlinux topic/firewall topic/gdk-pixbuf-0-branch topic/gi-ppc topic/ia64-8_1 topic/mandrakesoft topic/mlcd4 topic/ppp topic/rp-pppoe topic/switching_to_dnf topic/switching_to_urpmi topic/unlabeled-1.1.1 topic/v_webmin_0_87 topic/x86_64-branch user/animtim/designWork user/colin/rescue-systemd user/ennael/mga6 user/erwan/bug-13680 user/jibz/aarch64 user/martinw/mga6 user/pterjan/arm64
	Mageia Installer and base platform for many utilities	Thierry Vignaud [tv]

summaryrefslogtreecommitdiffstats

log msg author committer range

path: root/perl-install/services.pm

	Commit message (Expand)	Author	Age	Files	Lines
*	(ask_) fix calling interactive::gtk::display_help()	Thierry Vignaud	2008-10-07	1	-2/+2
*	fix/adjust some help pages (#42986)	Thierry Vignaud	2008-09-30	1	-2/+4
*	(ask_) use HTML help for services step too	Thierry Vignaud	2008-09-16	1	-1/+2
*	list rpcbind service in "System" category	Olivier Blin	2008-09-11	1	-1/+1
*	list nfs-common and nfs-server services (instead of nfs) in "File sharing" ca...	Olivier Blin	2008-09-11	1	-1/+1
*	list ip6tables service in "Internet" category (thanks to spuk)	Olivier Blin	2008-09-11	1	-1/+1
*	add a FIXME note about services with no chkconfig line and with no Default-St...	Olivier Blin	2008-03-27	1	-0/+1
*	remove old comment	Olivier Blin	2008-03-27	1	-2/+0
*	handle services with "-" as default chkconfig level in more places (by reusin...	Olivier Blin	2008-03-27	1	-2/+2
*	extract _set_service function that handles services with "-" as default chkco...	Olivier Blin	2008-03-27	1	-5/+10
*	factorize in a _run_action wrapper	Olivier Blin	2008-03-27	1	-8/+11
*	xfs is *not* mandatory for Xorg to run (#32846)	Pascal Rigaux	2007-08-27	1	-1/+1
*	typo fix (Dotan Kamber)	Thierry Vignaud	2007-08-09	1	-1/+1
*	typo fix	Thierry Vignaud	2007-08-09	1	-1/+1
*	(description) describe a few more services (cups, dm, haldaemon,	Thierry Vignaud	2007-08-06	1	-0/+9
*	re-sync after the big svn loss	Pascal Rigaux	2007-04-25	1	-17/+6
*	fill in missing titles for banners and specify icons	Thierry Vignaud	2005-08-27	1	-2/+2
*	create enable() and disable() out of set_status()	Olivier Blin	2005-06-10	1	-4/+14
*	don't need prefixing with current package	Pascal Rigaux	2005-06-09	1	-4/+4
*	- introduce set_status(), restart_or_start() and service_exists()	Olivier Blin	2005-05-24	1	-18/+33
*	better english (writing style rather than spoken one)	Thierry Vignaud	2004-12-13	1	-2/+2
*	remove some unneeded ";", add some for normalization (as told by perl_checker)	Pascal Rigaux	2004-11-18	1	-1/+1
*	simplify	Pascal Rigaux	2004-10-14	1	-3/+2
*	simplify	Pascal Rigaux	2004-10-14	1	-5/+4
*	fixed encoding problem with the output of start/stop init scripts	Pablo Saratxaga	2004-10-05	1	-1/+3
*	- Lete the function "start_not_running_service()" really start the specified ...	Till Kamppeter	2004-09-01	1	-0/+4
*	- Restored wrong upload.	Till Kamppeter	2004-09-01	1	-41/+360
*	- Lete the function "start_not_running_service()" really start the specified ...	Till Kamppeter	2004-09-01	1	-360/+41
*	aspell's typo fixes	Thierry Vignaud	2004-08-23	1	-2/+2
*	replaced XFree86 and XFree with Xorg (bugzilla #10531)	Pascal Rigaux	2004-08-05	1	-2/+2
*	for install, a service is on if there is at least one runlevel for which the	Pascal Rigaux	2004-02-10	1	-1/+1
*	add a fam description (telling that GNOME & KDE uses it). closes part of bugz...	Pascal Rigaux	2004-01-08	1	-0/+2
*	perl_checker compliance	Pascal Rigaux	2003-08-11	1	-1/+0
*	in drakxservices, display differently services handled by xinetd (bug #4516)	Pascal Rigaux	2003-08-06	1	-23/+33
*	create services_raw() which returns all the info out of "chkconfig --list"	Pascal Rigaux	2003-08-06	1	-5/+18
*	perl_checker compliance	Pascal Rigaux	2003-08-06	1	-1/+1
*	remove stock icons (per IHM team request)	Pascal Rigaux	2003-08-05	1	-1/+1
*	switch from gtk2-perl to gtk2-perl-xs	Thierry Vignaud	2003-07-09	1	-1/+1
*	increase gui coherency of drakxtools vs other gtk+ apps: use stock icons	Thierry Vignaud	2003-07-06	1	-1/+1
*	perl_checker adaptations + fixes	Pascal Rigaux	2003-04-24	1	-2/+2
*	- fix packing on standalone mode (no horizontal scrolling)	Thierry Vignaud	2003-03-10	1	-1/+1
*	we do use $in !!!!	Thierry Vignaud	2003-03-06	1	-1/+1
*	in drakxservices, don't stop services if one is using the gtk frontend (since...	Pascal Rigaux	2003-03-04	1	-1/+3
*	perl_checker fix	Thierry Vignaud	2003-02-27	1	-1/+1
*	in standalone mode, only display a service as enabled at boot time	Thierry Vignaud	2003-02-24	1	-2/+8
*	(ask_standalone_gtk): ensure popup is not destroyed more than once	Pascal Rigaux	2003-02-21	1	-1/+1
*	Gtk2::Label::set is deprecated	Guillaume Cottenceau	2003-02-20	1	-1/+1
*	fix rawdevices description (bug #1677)	Pascal Rigaux	2003-02-16	1	-1/+1
*	use $::prefix	Pascal Rigaux	2003-02-14	1	-22/+21
*	- set_help is deprecated	Pascal Rigaux	2003-02-13	1	-0/+1

• [next]

generated by cgit v1.2.1 (git 2.21.0) at 2025-01-29 10:19:36 +0000

package printer; # $Id$

use diagnostics;
use strict;

use vars qw(%thedb %thedb_gsdriver %printer_type %printer_type_inv @papersize_type %fields @entries_db_short @entry_db_description %descr_to_help %descr_to_db %db_to_descr %descr_to_ppd);

use common qw(:common :system :file);
use commands;

#-if we are in an DrakX config
my $prefix = "";

#-location of the printer database in an installed system
my $PRINTER_DB_FILE    = "/usr/lib/rhs/rhs-printfilters/printerdb";
my $PRINTER_FILTER_DIR = "/usr/lib/rhs/rhs-printfilters";

%printer_type = (
    __("Local printer")            => "LOCAL",
    __("Remote printer")           => "REMOTE",
    __("Remote CUPS server")       => "CUPS",
    __("Remote lpd server")        => "LPD",
    __("Network printer (socket)") => "SOCKET",
    __("SMB/Windows 95/98/NT")     => "SMB",
    __("NetWare")                  => "NCP",
    __("Printer Device URI")       => "URI",
);
%printer_type_inv = reverse %printer_type;

%fields = (
    STANDARD => [qw(QUEUE SPOOLDIR IF)],
    SPEC     => [qw(DBENTRY RESOLUTION PAPERSIZE BITSPERPIXEL CRLF)],
    LOCAL    => [qw(DEVICE)],
    REMOTE   => [qw(REMOTEHOST REMOTEQUEUE)],
    SMB      => [qw(SMBHOST SMBHOSTIP SMBSHARE SMBUSER SMBPASSWD SMBWORKGROUP AF)],
    NCP      => [qw(NCPHOST NCPQUEUE NCPUSER NCPPASSWD)],
);
@papersize_type = qw(letter legal ledger a3 a4);

#------------------------------------------------------------------------------
sub set_prefix($) { $prefix = $_[0]; }

sub default_queue($) { (split '\|', $_[0]{QUEUE})[0] }
sub default_spooldir($) { "/var/spool/lpd/" . default_queue($_[0]) }

sub default_printer_type($) { "LOCAL" }
sub printer_type($) {
    for ($_[0]{mode}) {
	/CUPS/ && return @printer_type_inv{qw(LOCAL REMOTE SMB), $::expert ? qw(URI) : ()};
	/lpr/  && return @printer_type_inv{qw(LOCAL LPD SMB NCP)};
    }
}

sub copy_printer_params($$) {
    my ($from, $to) = @_;
    map { $to->{$_} = $from->{$_} } grep { $_ ne 'configured' } keys %$from; #- avoid cycles.
}

sub getinfo($) {
    my ($prefix) = @_;
    my $printer = {};

    set_prefix($prefix);

    #- try to detect which printing system has been previously installed.
    #- the first detected is the default.
    read_printers_conf($printer); #- try to read existing cups (local only) queues.
    read_configured_queue($printer); #- try to read existing lpr queues.

    add2hash($printer, {
			#- global parameters.
			want         => 0,
			complete     => 0,
			str_type     => undef,
			QUEUE        => "lp",

			#- lpr parameters.
			SPOOLDIR     => "/var/spool/lpd/lp",
			DBENTRY      => "PostScript",
			PAPERSIZE    => "",
			ASCII_TO_PS  => undef,
			CRLF         => undef,
			NUP          => 1,
			RTLFTMAR     => 18,
			TOPBOTMAR    => 18,
			AUTOSENDEOF  => 1,

			DEVICE       => "/dev/lp0",

			REMOTEHOST   => "",
			REMOTEQUEUE  => "",

			NCPHOST      => "", #-"printerservername",
			NCPQUEUE     => "", #-"queuename",
			NCPUSER      => "", #-"user",
			NCPPASSWD    => "", #-"pass",

			SMBHOST      => "", #-"hostname",
			SMBHOSTIP    => "", #-"1.2.3.4",
			SMBSHARE     => "", #-"printername",
			SMBUSER      => "", #-"user",
			SMBPASSWD    => "", #-"passowrd",
			SMBWORKGROUP => "", #-"AS3",

			#- cups parameters.
			DeviceURI    => "parallel:/dev/lp0",
			Info         => "",
			Location     => "",
			State        => "Idle",
			Accepting    => "Yes",
		       });
    $printer;
}

#------------------------------------------------------------------------------
sub read_configured_queue($) {
    my ($printer) = @_;
    my $current = undef;
    my $flush_current = sub {
	if ($current) {
	    add2hash($printer->{configured}{$current->{QUEUE}} ||= {}, $current);
	    $current = undef;
	}
    };

    #- read /etc/printcap file.
    local *PRINTCAP; open PRINTCAP, "$prefix/etc/printcap" or return;
    local $_;
    while (<PRINTCAP>) {
	chomp;
	my $p = '(?:\{(.*?)\}|(\S+))';
	if (/^##PRINTTOOL3##\s+$p\s+$p\s+$p\s+$p\s+$p\s+$p\s+$p(?:\s+$p)?/) {
	    &$flush_current;
	    $current = {
			mode => 'lpr',
			TYPE => $1 || $2,
			GSDRIVER => $3 || $4,
			RESOLUTION => $5 || $6,
			PAPERSIZE => $7 || $8,
			#- ignored $9 || $10,
			DBENTRY => $11 || $12,
			BITSPERPIXEL => $13 || $14,
			CRLF => $15 || $16,
		       };
	} elsif (/^\s*$/) { &$flush_current }
	elsif (/^([^:]*):\\/) { $current->{QUEUE} = $1 }
	if (/^\s+:(?:[^:]*:)*sd=([^:]*):/) { $current->{SPOOLDIR} = $1 }
	if (/^\s+:(?:[^:]*:)*lp=([^:]*):\\/) { $current->{DEVICE} = $1 }
	if (/^\s+:(?:[^:]*:)*rm=([^:]*):\\/) { $current->{REMOTEHOST} = $1 }
	if (/^\s+:(?:[^:]*:)*rp=([^:]*):\\/) { $current->{REMOTEQUEUE} = $1 }
	if (/^\s+:(?:[^:]*:)*af=([^:]*):\\/) { $current->{AF} = $1 }
	if (/^\s+:(?:[^:]*:)*if=([^:]*):\\/) { $current->{IF} = $1 }
    }
    close PRINTCAP;
    &$flush_current;

    #- parse general.cfg for any configured queue.
    foreach (values %{$printer->{configured}}) {
	my $entry = $_;
	local *F; open F, "$prefix$entry->{SPOOLDIR}/general.cfg" or next;
	local $_;
	while (<F>) {
	    chomp;
	    if (/^\s*(?:export\s+)?PRINTER_TYPE=(.*?)\s*$/) { $entry->{TYPE} = $1 unless defined $entry->{TYPE} }
	    elsif (/^\s*(?:export\s+)?ASCII_TO_PS=(.*?)\s*$/) { $entry->{ASCII_TO_PS} = $1 eq 'YES' unless defined $entry->{ASCII_TO_PS} }
	    elsif (/^\s*(?:export\s+)?PAPER_SIZE=(.*?)\s*$/) { $entry->{PAPERSIZE} = $1 unless defined $entry->{PAPERSIZE} }
	}
	close F;
    }

    #- parse postscript.cfg for any configured queue.
    foreach (values %{$printer->{configured}}) {
	my $entry = $_;
	local *F; open F, "$prefix$entry->{SPOOLDIR}/postscript.cfg" or next;
	local $_;
	while (<F>) {
	    chomp;
	    if (/^\s*(?:export\s+)?GSDEVICE=(.*?)\s*$/) { $entry->{GSDRIVER} = $1 unless defined $entry->{GSDRIVER} }
	    elsif (/^\s*(?:export\s+)?RESOLUTION=(.*?)\s*$/) { $entry->{RESOLUTION} = $1 unless defined $entry->{RESOLUTION} }
	    elsif (/^\s*(?:export\s+)?COLOR=-dBitsPerPixel=(.*?)\s*$/) { $entry->{COLOR} = $1 unless defined $entry->{COLOR} }
	    elsif (/^\s*(?:export\s+)?COLOR=(.*?)\s*$/) { $entry->{COLOR} = $1 ? $1 : 'Default' unless defined $entry->{COLOR} }
	    elsif (/^\s*(?:export\s+)?PAPERSIZE=(.*?)\s*$/) { $entry->{PAPERSIZE} = $1 unless defined $entry->{PAPERSIZE} }
	    elsif (/^\s*(?:export\s+)?EXTRA_GS_OPTIONS=(.*?)\s*$/) { $entry->{EXTRA_GS_OPTIONS} = $1 unless defined $entry->{EXTRA_GS_OPTIONS}; $entry->{EXTRA_GS_OPTIONS} =~ s/^\"(.*)\"/$1/ }
	    elsif (/^\s*(?:export\s+)?REVERSE_ORDER=(.*?)\s*$/) { $entry->{REVERSE_ORDER} = $1 unless defined $entry->{REVERSE_ORDER} }
	    elsif (/^\s*(?:export\s+)?PS_SEND_EOF=(.*?)\s*$/) { $entry->{AUTOSENDEOF} = $1 eq 'YES' && $entry->{DBENTRY} eq 'PostScript' unless defined $entry->{AUTOSENDEOF} }
	    elsif (/^\s*(?:export\s+)?NUP=(.*?)\s*$/) { $entry->{NUP} = $1 unless defined $entry->{NUP} }
	    elsif (/^\s*(?:export\s+)?RTLFTMAR=(.*?)\s*$/) { $entry->{RTLFTMAR} = $1 unless defined $entry->{RTLFTMAR} }
	    elsif (/^\s*(?:export\s+)?TOPBOTMAR=(.*?)\s*$/) { $entry->{TOPBOTMAR} = $1 unless defined $entry->{TOPBOTMAR} }
	}
	close F;
    }

    #- parse textonly.cfg for any configured queue.
    foreach (values %{$printer->{configured}}) {
	my $entry = $_;
	local *F; open F, "$prefix$entry->{SPOOLDIR}/textonly.cfg" or next;
	local $_;
	while (<F>) {
	    chomp;
	    if (/^\s*(?:export\s+)?TEXTONLYOPTIONS=(.*?)\s*$/) { $entry->{TEXTONLYOPTIONS} = $1 unless defined $entry->{TEXTONLYOPTIONS}; $entry->{TEXTONLYOPTIONS} =~ s/^\"(.*)\"/$1/ }
	    elsif (/^\s*(?:export\s+)?CRLFTRANS=(.*?)\s*$/) { $entry->{CRLF} = $1 eq 'YES' unless defined $entry->{CRLF} }
	    elsif (/^\s*(?:export\s+)?TEXT_SEND_EOF=(.*?)\s*$/) { $entry->{AUTOSENDEOF} = $1 eq 'YES' && $entry->{DBENTRY} ne 'PostScript' unless defined $entry->{AUTOSENDEOF} }
	}
	close F;
    }

    #- get extra parameters for SMB or NCP type queue.
    foreach (values %{$printer->{configured}}) {
	my $entry = $_;
	if ($entry->{TYPE} eq 'SMB') {
	    my $config_file = "$prefix$entry->{SPOOLDIR}/.config";
	    local *F; open F, "$config_file" or next; #die "Can't open $config_file $!";
	    local $_;
	    while (<F>) {
		chomp;
		if (/^\s*share='\\\\(.*?)\\(.*?)'/) {
		    $entry->{SMBHOST} = $1;
		    $entry->{SMBSHARE} = $2;
		} elsif (/^\s*hostip=(.*)/) {
		    $entry->{SMBHOSTIP} = $1;
		} elsif (/^\s*user='(.*)'/) {
		    $entry->{SMBUSER} = $1;
		} elsif (/^\s*password='(.*)'/) {
		    $entry->{SMBPASSWD} = $1;
		} elsif (/^\s*workgroup='(.*)'/) {
		    $entry->{SMBWORKGROUP} = $1;
		}
	    }
	    close F;
	} elsif ($entry->{TYPE} eq 'NCP') {
	    my $config_file = "$prefix$entry->{SPOOLDIR}/.config";
	    local *F; open F, "$config_file" or next; #die "Can't open $config_file $!";
	    local $_;
	    while (<F>) {
		chomp;
		if (/^\s*server=(.*)/) {
		    $entry->{NCPHOST} = $1;
		} elsif (/^\s*user='(.*)'/) {
		    $entry->{NCPUSER} = $1;
		} elsif (/^\s*password='(.*)'/) {
		    $entry->{NCPPASSWD} = $1;
		} elsif (/^\s*queue='(.*)'/) {
		    $entry->{NCPQUEUE} = $1;
		}
	    }
	    close F;
	}
    }

    #- assume this printing system, but only if some queue are defined.
    scalar(keys %{$printer->{configured}}) > 0 and $printer->{mode} ||= 'lpr';
}

sub read_printer_db(;$) {
    my $dbpath = $prefix . ($_[0] || $PRINTER_DB_FILE);

    scalar(keys %thedb) > 4 and return; #- try reparse if using only ppa, POSTSCRIPT, TEXT.

    my %available_devices; #- keep only available devices in our database.
    local $_; #- use of while (<...
    local *AVAIL; open AVAIL, ($::testing ? "$prefix" : "chroot $prefix/ ") . "/usr/bin/gs --help |";
    while (<AVAIL>) {
	if (/^Available devices:/ ... /^\S/) {
	    @available_devices{split /\s+/, $_} = () if /^\s+/;
	}
    }
    close AVAIL;
    $available_devices{ppa} = undef; #- if -x "$prefix/usr/bin/pbm2ppa" && -x "$prefix/usr/bin/pnm2ppa";
    delete $available_devices{''};
    @available_devices{qw/POSTSCRIPT TEXT/} = (); #- these are always available.

    local *DBPATH; #- don't have to do close ... and don't modify globals at least
    open DBPATH, $dbpath or die "An error has occurred on $dbpath : $!";

    while (<DBPATH>) {
	if (/^StartEntry:\s(\w*)/) {
	    my $entry = { ENTRY => $1 };

	  WHILE :
	      while (<DBPATH>) {
		SWITCH: {
		      /GSDriver:\s*(\w*)/      and do { $entry->{GSDRIVER} = $1; last SWITCH };
		      /Description:\s*{(.*)}/  and do { $entry->{DESCR}    = $1; last SWITCH };
		      /About:\s*{\s*(.*?)\s*}/ and do { $entry->{ABOUT}    = $1; last SWITCH };
		      /About:\s*{\s*(.*?)\s*\\\s*$/
			and do {
			    my $string = $1;
			    while (<DBPATH>) {
				$string =~ /\S$/ and $string .= ' ';
				/^\s*(.*?)\s*\\\s*$/ and $string .= $1;
				/^\s*(.*?)\s*}\s*$/  and do { $entry->{ABOUT} = $string . $1; last SWITCH };
			    }
			};
		      /Resolution:\s*{(.*)}\s*{(.*)}\s*{(.*)}/
			and do { push @{$entry->{RESOLUTION} ||= []}, { XDPI => $1, YDPI => $2, DESCR => $3 }; last SWITCH };
		      /BitsPerPixel:\s*{(.*)}\s*{(.*)}/
			and do { push @{$entry->{BITSPERPIXEL} ||= []}, {DEPTH => $1, DESCR => $2}; last SWITCH };

		      /EndEntry/ and last WHILE;
		  }
	      }
	    if (exists $available_devices{$entry->{GSDRIVER}}) {
		$thedb{$entry->{ENTRY}} = $entry;
		$thedb_gsdriver{$entry->{GSDRIVER}} = $entry;
	    }
	}
    }

    @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_cupsd_conf {
    my @cupsd_conf;
    local *F;

    open F, "$prefix/etc/cups/cupsd.conf";
    @cupsd_conf = <F>;
    close F;

    @cupsd_conf;
}
sub write_cupsd_conf {
    my (@cupsd_conf) = @_;
    local *F;

    open F, ">$prefix/etc/cups/cupsd.conf";
    print F @cupsd_conf;
    close F;

    #- restart cups after updating configuration.
    require run_program;
    run_program::rooted($prefix, "/etc/rc.d/init.d/cups restart"); sleep 1;
}

sub read_printers_conf {
    my ($printer) = @_;
    my $current = undef;

    #- 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->{mode} ||= '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 the PostScript generic filter.
    local *F; open F, "$prefix/etc/cups/ppd/$printer->{QUEUE}.ppd" or return "Generic PostScript";
    local $_;
    while (<F>) {
	/^\*([^\s:]*)\s*:\s*\"([^\"]*)\"/ and do { $ppd{$1} = $2; next };
	/^\*([^\s:]*)\s*:\s*([^\s\"]*)/   and do { $ppd{$1} = $2; next };
    }
    close F;

    $ppd{Manufacturer} . '|' . ($ppd{NickName} || $ppd{ShortNickName} || $ppd{ModelName}) .
      ($ppd{LanguageVersion} && (" (" . lc(substr($ppd{LanguageVersion}, 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, "ifup lo"); #- else cups will not be happy!
    run_program::rooted($prefix, "/etc/rc.d/init.d/cups start");

    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 /\|/;
	    $ppd && $mf && $descr and $descr_to_ppd{"$mf|$descr" . ($lang && " ($lang)")} = $ppd;
	}
	close PPDS;
	scalar(keys %descr_to_ppd) > 5 and last;
	sleep 1; #- we have to try again running the program, wait here a little before.
    }

    scalar(keys %descr_to_ppd) > 5 or die "unable to connect to cups server";

    #- assume a default printer not using any ppd at all.
    $descr_to_ppd{"Generic PostScript"} = '';
}

#-******************************************************************************
#- write functions
#-******************************************************************************

#------------------------------------------------------------------------------
#- given the path queue_path, we create all the required spool directory
#------------------------------------------------------------------------------
sub create_spool_dir($) {
    my ($queue_path) = @_;
    my $complete_path = "$prefix/$queue_path";

    commands::mkdir_("-p", $complete_path);

    unless ($::testing) {
	#-redhat want that "drwxr-xr-x root lp"
	my $gid_lp = (getpwnam("lp"))[3];
	chown 0, $gid_lp, $complete_path
	  or die "An error has occurred - can't chgrp $complete_path to lp $!";
    }
}

#------------------------------------------------------------------------------
#-given the input spec file 'input', and the target output file 'output'
#-we set the fields specified by fieldname to the values in fieldval
#-nval  is the number of fields to set
#-Doesnt currently catch error exec'ing sed yet
#------------------------------------------------------------------------------
sub create_config_file($$%) {
    my ($inputfile, $outputfile, %toreplace) = @_;
    template2file("$prefix/$inputfile", "$prefix/$outputfile", %toreplace);
    eval { commands::chown_("root.lp", "$prefix/$outputfile") };
}


#------------------------------------------------------------------------------
#-copy master filter to the spool dir
#------------------------------------------------------------------------------
sub copy_master_filter($) {
    my ($queue_path) = @_;
    my $complete_path = "$prefix/$queue_path/filter";
    my $master_filter = "$prefix/$PRINTER_FILTER_DIR/master-filter";

    eval { commands::cp('-f', $master_filter, $complete_path) };
    $@ and die "Can't copy $master_filter to $complete_path $!";
    eval { commands::chown_("root.lp", $complete_path); };
}

#------------------------------------------------------------------------------
#- given a PrintCap Entry, create the spool dir and special
#- rhs-printfilters related config files which are required
#------------------------------------------------------------------------------
my $intro_printcap_test = "
#
# Please don't edit this file directly unless you know what you are doing!
# Look at the printcap(5) man page for more info.
# Be warned that the control-panel printtool requires a very strict format!
#
# This file can be edited with printerdrake or printtool.
#

";

sub configure_queue($) {
    my ($entry) = @_;

    for ($entry->{mode}) {
	/CUPS/ && do {
	    #- at this level, we are using lpadmin to create a local printer (only local
	    #- printer are supported with printerdrake).
	    require run_program;
	    run_program::rooted($prefix, "lpadmin",
				"-p", $entry->{QUEUE},
				$entry->{State} eq 'Idle' && $entry->{Accepting} eq 'Yes' ? ("-E") : (),
				"-v", $entry->{DeviceURI},
				$entry->{cupsPPD} ? ("-m", $entry->{cupsPPD}) : (),
				$entry->{Info} ? ("-D", $entry->{Info}) : (),
				$entry->{Location} ? ("-L", $entry->{Location}) : (),
			       );
	    last };
	/lpr/  && do {
	    #- old style configuration scheme for lpr.
	    my $queue_path = "$entry->{SPOOLDIR}";
	    create_spool_dir($queue_path);

	    my $get_name_file = sub {
		my ($name) = @_;
		("$PRINTER_FILTER_DIR/$name.in", "$entry->{SPOOLDIR}/$name")
	    };
	    my ($filein, $file);
	    my %fieldname = ();
	    my $dbentry = $thedb{($entry->{DBENTRY})} or die "no dbentry";

	    #- make general.cfg
	    ($filein, $file) = &$get_name_file("general.cfg");
	    $fieldname{ascps_trans} = $entry->{ASCII_TO_PS} || $dbentry->{GSDRIVER} eq 'ppa' ? "YES" : "NO";
	    $fieldname{desiredto}   = $dbentry->{GSDRIVER} ne "TEXT" ? "ps" : "asc";
	    $fieldname{papersize}   = $entry->{PAPERSIZE} ? $entry->{PAPERSIZE} : "letter";
	    $fieldname{printertype} = $entry->{TYPE};
	    create_config_file($filein, $file, %fieldname);

	    #- now do postscript.cfg
	    ($filein, $file) = &$get_name_file("postscript.cfg");
	    %fieldname = ();
	    $fieldname{gsdevice}       = $dbentry->{GSDRIVER};
	    $fieldname{papersize}      = $entry->{PAPERSIZE} ? $entry->{PAPERSIZE} : "letter";
	    $fieldname{resolution}     = $entry->{RESOLUTION};
	    $fieldname{color}          = $entry->{BITSPERPIXEL} ne "Default" &&
	      (($dbentry->{GSDRIVER} ne "uniprint" && "-dBitsPerPixel=") . $entry->{BITSPERPIXEL});
	    $fieldname{reversepages}   = $entry->{REVERSE_ORDER} ? "YES" : "";
	    $fieldname{extragsoptions} = "\"$entry->{EXTRA_GS_OPTIONS}\"";
	    $fieldname{pssendeof}      = $entry->{AUTOSENDEOF} ? ($dbentry->{GSDRIVER} eq "POSTSCRIPT" ? "YES" : "NO") : "NO";
	    $fieldname{nup}            = $entry->{NUP};
	    $fieldname{rtlftmar}       = $entry->{RTLFTMAR};
	    $fieldname{topbotmar}      = $entry->{TOPBOTMAR};
	    create_config_file($filein, $file, %fieldname);

	    #- finally, make textonly.cfg
	    ($filein, $file) = &$get_name_file("textonly.cfg");
	    %fieldname = ();
	    $fieldname{textonlyoptions} = "\"$entry->{TEXTONLYOPTIONS}\"";
	    $fieldname{crlftrans}       = $entry->{CRLF} ? "YES" : "";
	    $fieldname{textsendeof}     = $entry->{AUTOSENDEOF} ? ($dbentry->{GSDRIVER} eq "POSTSCRIPT" ? "NO" : "YES") : "NO";
	    create_config_file($filein, $file, %fieldname);

	    if ($entry->{TYPE} eq "SMB") {
		#- simple config file required if SMB printer
		my $config_file = "$prefix$queue_path/.config";
		local *F;
		open F, ">$config_file" or die "Can't create $config_file $!";
		print F "share='\\\\$entry->{SMBHOST}\\$entry->{SMBSHARE}'\n";
		print F "hostip=$entry->{SMBHOSTIP}\n";
		print F "user='$entry->{SMBUSER}'\n";
		print F "password='$entry->{SMBPASSWD}'\n";
		print F "workgroup='$entry->{SMBWORKGROUP}'\n";
		close F;
		eval { chmod 0640, $config_file; commands::chown_("root.lp", $config_file) };
	    } elsif ($entry->{TYPE} eq "NCP") {
		#- same for NCP printer
		my $config_file = "$prefix$queue_path/.config";
		local *F;
		open F, ">$config_file" or die "Can't create $config_file $!";
		print F "server=$entry->{NCPHOST}\n";
		print F "queue=$entry->{NCPQUEUE}\n";
		print F "user=$entry->{NCPUSER}\n";
		print F "password=$entry->{NCPPASSWD}\n";
		close F;
		eval { chmod 0640, $config_file; commands::chown_("root.lp", $config_file) };
	    }

	    copy_master_filter($queue_path);

	    #-now the printcap file, note this one contains all the printer (use configured for that).
	    local *PRINTCAP;
	    open PRINTCAP, ">$prefix/etc/printcap" or die "Can't open printcap file $!";
	    print PRINTCAP $intro_printcap_test;
	    foreach (values %{$entry->{configured}}) {
		$_->{DBENTRY} = $thedb_gsdriver{$_->{GSDRIVER}}{ENTRY} unless defined $_->{DBENTRY};
		my $db_ = $thedb{$_->{DBENTRY}} or next; #die "no dbentry";

		$_->{SPOOLDIR} ||= default_spooldir($_);
		$_->{IF}       ||= "$_->{SPOOLDIR}/filter";
		$_->{AF}       ||= "$_->{SPOOLDIR}/acct";

		printf PRINTCAP "##PRINTTOOL3##  %s %s %s %s %s %s %s%s\n",
		  $_->{TYPE} || '{}',
		    $db_->{GSDRIVER} || '{}',
		      $_->{RESOLUTION} || '{}',
			$_->{PAPERSIZE} || '{}',
			  '{}',
			    $db_->{ENTRY} || '{}',
			      $_->{BITSPERPIXEL} || '{}',
				$_->{CRLF} ? " 1" : "";

		print PRINTCAP "$_->{QUEUE}:\\\n";
		print PRINTCAP "\t:sd=$_->{SPOOLDIR}:\\\n";
		print PRINTCAP "\t:mx#0:\\\n\t:sh:\\\n";

		if ($_->{TYPE} eq "LOCAL") {
		    print PRINTCAP "\t:lp=$_->{DEVICE}:\\\n";
		} elsif ($_->{TYPE} eq "REMOTE") {
		    print PRINTCAP "\t:rm=$_->{REMOTEHOST}:\\\n";
		    print PRINTCAP "\t:rp=$_->{REMOTEQUEUE}:\\\n";
		} else {
		    #- (pcentry->Type == (PRINTER_SMB | PRINTER_NCP))
		    print PRINTCAP "\t:lp=/dev/null:\\\n";
		    print PRINTCAP "\t:af=$_->{AF}\\\n";
		}

		#- cheating to get the input filter!
		print PRINTCAP "\t:if=$_->{IF}:\n";
		print PRINTCAP "\n";
	    }
	    eval { commands::chown_("root.lp", "$prefix/etc/printcap") };
	    last };
    }

    my $useUSB = 0;
    foreach (values %{$entry->{configured}}) {
	$useUSB ||= $_->{DEVICE} =~ /usb/ || $_->{DeviceURI} =~ /usb/;
    }
    if ($useUSB) {
	my $f = "$prefix/etc/sysconfig/usb";
	my %usb = getVarsFromSh($f);
	$usb{PRINTER} = "yes";
	setVarsInSh($f, \%usb);
    }
}

#- use the queue currently configured at the top of printer hash.
sub remove_queue($) {
    my ($printer) = @_;
    $printer->{configured}{$printer->{QUEUE}} or return; #- something strange at this point.

    if ($printer->{mode} eq 'CUPS') {
	require run_program;
	run_program::rooted($prefix, "lpadmin", "-x", $printer->{QUEUE});
    }
    delete $printer->{configured}{$printer->{QUEUE}};
}

sub restart_queue($) {
    my ($printer) = @_;
    my $queue = default_queue($printer);

    for ($printer->{mode}) {
	/CUPS/ && do {
	    #- restart cups before cleaning the queue.
	    require run_program;
	    run_program::rooted($prefix, "/etc/rc.d/init.d/cups start"); sleep 1;
	    run_program::rooted($prefix, "lprm-cups", "-P$queue", "-");
	    last };
	/lpr/  && do {
	    #- restart lpd after cleaning the queue.
	    foreach (("/var/spool/lpd/$queue/lock", "/var/spool/lpd/lpd.lock")) {
		my $pidlpd = (cat_("$prefix$_"))[0];
		kill 'TERM', $pidlpd if $pidlpd;
		unlink "$prefix$_";
	    }
	    require run_program;
	    run_program::rooted($prefix, "lprm-lpd", "-P$queue", "-"); sleep 1;
	    run_program::rooted($prefix, "lpd"); sleep 1;
	    last };
    }
}

sub print_pages($@) {
    my ($printer, @pages) = @_;
    my $queue = default_queue($printer);
    my ($lpr, $lpq);

    for ($printer->{mode}) {
	/CUPS/ and ($lpr, $lpq) = ("/usr/bin/lpr-cups", "/usr/bin/lpq-cups");
	/lpr/  and ($lpr, $lpq) = ("/usr/bin/lpq-lpd", "/usr/bin/lpq-lpd");
    }

    require run_program;
    foreach (@pages) {
	run_program::rooted($prefix, $lpr, "-P$queue", $_);
    }
    sleep 5; #- allow lpr to send pages.
    local *F; open F, ($::testing ? "$prefix" : "chroot $prefix/ ") . "$lpq -P$queue |";
    my @lpq_output = grep { !/^no entries/ && !(/^Rank\s+Owner/ .. /^\s*$/) } <F>;
    close F;
    @lpq_output;
}

#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
1;