#!/usr/bin/perl -w use strict; # -*- perl -*- # This is foomatic-configure, a program to establish and configure # print queues, drivers, spoolers, etc using the foomatic database and # companion filters. # It also comprises half of a programatic API for user tools: you can # learn and control everything about the static properties of print # queues here. With the sister program foomatic-printjob, you can do # everything related to print queue dynamic state: submit jobs, and # query, cancel, reorder, and redirect them. use Foomatic::Defaults; use Foomatic::DB; use Data::Dumper; # Connect syntax: # # This differs a tad from CUPS's, partly because everything is # supposed to be a file, and CUPS doesn't entirely reflect that. # But I'm not really very particular... # # If a certain URI is not supported by all the spoolers, the spoolers # which support it are listed in parantheses, "direct" means direct, # spooler-less printing. # # usb:/path/device # Local USB printer # usb://make/model?serial=xxx # Printer-bound USB connection (CUPS) # parallel:/path/device # Local parallel printer # serial:/path/device # Local serial printer # file:/path/file # includes usb, lp, named pipes, other # hp:/bus/model?serial=xxx # HPLIP print queue (hpinkjet.sf.net) # hpfax:/bus/model?serial=xxx # HPLIP fax queue (hpinkjet.sf.net) # ptal:/provider:bus:name # HPOJ MLC protocol (hpoj.sf.net,obsolete) # mtink:/path/device # Epson inkjet through mtink daemon # # (for ink level monitoring when printing, # # http://xwtools.automatix.de/) # lpd://host/queue # LPD protocol # lpd://host # LPD protocol (default queue, CUPS only) # socket://host:port # TCP aka appsocket # socket://host # TCP aka appsocket (port 9100) # ncp://user:pass@host/queue # Netware (LPD, LPRng, direct) # smb://user:pass@wgrp/host/queue # Windows (CUPS, PPR, LPD, LPRng, direct) # stdout # Standard output (direct) # postpipe:"" # Free-formed backend command line # # (LPD, LPRng, direct) # # Read out the program name with which we were called, but discard the path $0 =~ m!/([^/]+)\s*$!; my $progname = ($1 || $0); my $debug = 0; # We use the library Getopt::Long here, so that we can have more than # one "-o" option on one command line. my($opt_q, $opt_f, $opt_w, $opt_n, $opt_N, $opt_L, $opt_ppd, $opt_d, $opt_p, $opt_s, $opt_C, $opt_R, $opt_D, $opt_Q, $opt_P, $opt_O, $opt_X, $opt_c, @opt_o, $opt_r, $opt_dd, $opt_nodd, $opt_att, $opt_delay, $opt_h); use Getopt::Long; Getopt::Long::Configure("no_ignore_case"); GetOptions("q" => \$opt_q, # Quiet, non-interactive operation "f" => \$opt_f, # Force rebuild of PPD from database "w" => \$opt_w, # Cut GUI strings in the PPD to 39 # characters (for CUPS Windows driver) "n=s" => \$opt_n, # queue Name "N=s" => \$opt_N, # human-readable Name (Model, # Description) "L=s" => \$opt_L, # Location "ppd=s" => \$opt_ppd, # PPD file "d=s" => \$opt_d, # Driver "p=s" => \$opt_p, # Printer "s=s" => \$opt_s, # Spooler "C" => \$opt_C, # Copy queue "R" => \$opt_R, # Remove queue "D" => \$opt_D, # set Default queue "Q" => \$opt_Q, # Query queue info "P" => \$opt_P, # Perl queue/printer/driver info output "O" => \$opt_O, # get printer support Overview "X" => \$opt_X, # query XML printer/driver/combo info "c=s" => \$opt_c, # printer Connection type "o=s" => \@opt_o, # default printing Options "r" => \$opt_r, # list Remote queues "backend-dont-disable=s" => \$opt_dd, # Do not disable CUPS # backends "backend-attempts=s" => \$opt_att, # Try that often when backend # fails "backend-delay=s" => \$opt_delay, # Delay in seconds between # retries of failed backend "h" => \$opt_h, # Help! "help"=> \$opt_h) || help(); help() if $opt_h; my $db = new Foomatic::DB; overview() if $opt_O; get_xml() if $opt_X; my $force = ($opt_f ? 1 : 0); my $shortgui = ($opt_w ? 1 : 0); my $in_config = {'queue' => $opt_n, 'desc' => $opt_N, 'loc' => $opt_L, 'ppdfile' => $opt_ppd, 'driver' => $opt_d, 'printer' => $opt_p, 'spooler' => $opt_s, 'connect' => $opt_c, 'options' => \@opt_o, 'force' => $force, 'shortgui' => $shortgui, 'dd' => $opt_dd, 'att' => $opt_att, 'delay' => $opt_delay, 'foomatic' => 1}; # If description and location contain only whitespace, use an empty string # instead if ((defined($in_config->{'desc'})) && ($in_config->{'desc'} =~ m!^\s*$!)) { $in_config->{'desc'} = ""; } if ((defined($in_config->{'loc'})) && ($in_config->{'loc'} =~ m!^\s*$!)) { $in_config->{'loc'} = ""; } my $action = ($opt_R ? 'delete' : 'configure'); $action = ($opt_D ? 'default' : $action); $action = ($opt_Q ? 'query' : $action); $action = ($opt_P ? 'query' : $action); my $procs = { 'lpd' => { 'delete' => \&delete_lpd, 'configure' => \&setup_lpd, 'default' => \&default_lpd, 'query' => \&query_lpd }, 'lprng'=>{ 'delete' => \&delete_lpd, 'query' => \&query_lpd, 'default' => \&default_lprng, 'configure' => \&setup_lpd }, 'cups' =>{ 'delete' => \&delete_cups, 'query' => \&query_cups, 'default' => \&default_cups, 'configure' => \&setup_cups }, 'pdq' =>{ 'delete' => \&delete_pdq, 'query' => \&query_pdq, 'default' => \&default_pdq, 'configure' => \&setup_pdq }, 'ppr' =>{ 'delete' => \&delete_ppr, 'query' => \&query_ppr, 'default' => \&default_ppr, 'configure' => \&setup_ppr }, 'direct'=>{'delete' => \&delete_direct, 'query' => \&query_direct, 'default' => \&default_direct, 'configure' => \&setup_direct } }; if (!($opt_Q or $opt_P or defined($in_config->{'queue'}))) { # No queue manipulation without knowing the name of the queue print STDERR "You must specify a queue name with -n!\n"; help(); exit 1; } if (!defined($in_config->{'spooler'})) { my $takenfromconfigfile = 0; # Personal default spooler my $s; if (($> != 0) && (-f "$ENV{'HOME'}/.defaultspooler")) { $s = `cat $ENV{'HOME'}/.defaultspooler`; chomp $s; $takenfromconfigfile = 1; } # System default spooler if ((!defined($s)) && (-f "$sysdeps->{'foo-etc'}/defaultspooler")) { $s = `cat $sysdeps->{'foo-etc'}/defaultspooler`; chomp $s; $takenfromconfigfile = 1; } if (!defined($s)) { $s = detect_spooler(); } die "Unable to identify spooler, please specify with -s\n" unless $s; if ((!$opt_q) && (!$takenfromconfigfile)) { print STDERR "You appear to be using $s. Correct? "; my $yn = ; die "\n" if ($yn !~ m!^y!i); } $in_config->{'spooler'} = $s; } if ($in_config->{'printer'}) { # If the user supplies an old numerical printer ID, translate it to # a new clear-text ID $in_config->{'printer'} = Foomatic::DB::translate_printer_id($in_config->{'printer'}); } # Call proper proc &{$procs->{$in_config->{'spooler'}}{$action}}($in_config); exit(0); # Common parts for queue creation/modification functions sub getoldqueuedata { my ($config, $reconf) = @_; my ($sourcespooler, $sourcequeue, $olddatablob, $beh); # Copy a queue if ($opt_C) { if ($#ARGV == 0) { # 1 argument -> queue from same spooler $sourcespooler = $config->{'spooler'}; $sourcequeue = $ARGV[0]; } elsif ($#ARGV == 1) { # 2 arguments -> queue from given spooler $sourcespooler = $ARGV[0]; $sourcequeue = $ARGV[1]; } else { die "Unsufficient options to copy a queue, " . "try \"$progname -h\"!\n"; } # Read data from source queue if (!($olddatablob = load_datablob($sourcespooler, $sourcequeue))) { # It is not possible to copy the given source queue die "The source queue $sourcequeue does not exist " . "or is corrupted!\n"; } # PPD file of the source queue, if it exists, and if the user # does not insist on using another PPD file, we must copy it my $sourceppd = $olddatablob->{'ppdfile'}; if ((-r $sourceppd) && (!$config->{'ppdfile'})) { $config->{'ppdfile'} = $sourceppd; } # Stuff data into the $config structure, all items must be defined, # so that an old queue gets overwritten if ($olddatablob->{'queuedata'}) { my $i; for $i (('desc', 'loc', 'printer', 'driver', 'connect', 'ppdfile', 'dd', 'att', 'delay')) { if (!defined($config->{$i})) { if ($olddatablob->{'queuedata'}{$i}){ $config->{$i} = $olddatablob->{'queuedata'}{$i}; } elsif ($i eq 'dd') { $config->{$i} = 0; } elsif ($i eq 'att') { $config->{$i} = 1; } elsif ($i eq 'delay') { $config->{$i} = 30; } else { $config->{$i} = ""; } } } # Check consistency of the printer/driver settings if ((($config->{'driver'} eq "") || ($config->{'driver'} eq "raw") || # No new driver, printer, ($config->{'printer'} eq "")) && # PPD file ($config->{'ppdfile'} eq "") && ((!defined($olddatablob->{'args'})) || # No existing options ($#{$olddatablob->{'args'}} < 0))) { # -> source queue raw $config->{'driver'} = "raw"; $config->{'printer'} = undef; } # We do not need the queue data block any more delete($olddatablob->{'queuedata'}); } else { # No Foomatic/PPD data $olddatablob = undef; } } else { # Load the datablob of the former configuration if ($reconf) { if ($olddatablob = load_datablob($config->{'spooler'}, $config->{'queue'})) { # If the user has supplied only a printer or only a driver # fill in the second of the two fields in $config if ((!$config->{'ppdfile'}) && ($olddatablob->{'queuedata'}{'foomatic'})) { if ((!$config->{'driver'}) && ($config->{'printer'})) { $config->{'driver'} = $olddatablob->{'driver'}; } if ((!$config->{'printer'}) && ($config->{'driver'})) { $config->{'printer'} = $olddatablob->{'id'}; } } # Extract URI and backend error handling data if ($config->{'spooler'} eq "cups") { $beh->{'uri'} = $olddatablob->{'queuedata'}{'connect'}; $beh->{'dd'} = $olddatablob->{'queuedata'}{'dd'}; $beh->{'att'} = $olddatablob->{'queuedata'}{'att'}; $beh->{'delay'} = $olddatablob->{'queuedata'}{'delay'}; } # We do not need the queue data block here delete($olddatablob->{'queuedata'}); } else { $olddatablob = undef; } } } # If the user does not supply info about his printer and/or driver # and the queue did not exist before we assume that he wants to set up a # raw queue. To make a raw queue out of a formerly filtered one, one # has to use the driver name "raw". $config->{'driver'} = "" if not defined $config->{'driver'}; $config->{'printer'} = "" if not defined $config->{'printer'}; $config->{'ppdfile'} = "" if not defined $config->{'ppdfile'}; my $nodriver = (((!$config->{'driver'}) && (!$config->{'printer'}) && (!$config->{'ppdfile'})) || ($config->{'driver'} eq "raw")); # Set to 1 when we retrieve a data set from the Foomatic database my $newfoomaticdata = 0; if ($nodriver) { if ($olddatablob) { if ($config->{'driver'} ne "raw") { # We couldn't determine a certain driver, probably we had a # native PostScript PPD file $db->{'dat'} = $olddatablob; } else { # For a raw queue overtake at least the $postpipe if (defined($olddatablob->{'postpipe'})) { $db->{'dat'}{'postpipe'} = $olddatablob->{'postpipe'}; } } } } elsif ($config->{'ppdfile'}) { if (! -r $config->{'ppdfile'}) { die "The PPD file \'$config->{'ppdfile'}\' does not exist or is " . "readable.\n"; } # Load the data from the PPD file $db->getdatfromppd($config->{'ppdfile'}); # Overtake the former default settings if ($olddatablob) {overtake_defaults($olddatablob)}; # Overtake the former $postpipe if (defined($olddatablob->{'postpipe'})) { $db->{'dat'}{'postpipe'} = $olddatablob->{'postpipe'}; } } else { if (($olddatablob) && ($olddatablob->{'driver'} eq $config->{'driver'}) && ($olddatablob->{'id'} eq $config->{'printer'}) && (!$config->{'force'})) { # Overtake data from the former configuration $db->{'dat'} = $olddatablob; } else { # Retrieve data from the Foomatic database if (!$config->{'driver'}) { die "You also need to specify a driver with \"-d\"!\n"; } if (!$config->{'printer'}) { die "You also need to specify a printer with \"-p\"!\n"; } # The printer is supported by the chosen driver? If yes, load # its data my $possible = $db->getdat($config->{'driver'}, $config->{'printer'}); die "That printer and driver combination is not possible.\n" if (!$possible); die "There is neither a custom PPD file nor the driver database entry contains sufficient data to build a PPD file.\n" if (!$db->{'dat'}{'cmd'}) && (!$db->{'dat'}{'ppdfile'}); $newfoomaticdata = 1; # Overtake the former default settings if ($olddatablob) {overtake_defaults($olddatablob)}; # Overtake the former $postpipe if (defined($olddatablob->{'postpipe'})) { $db->{'dat'}{'postpipe'} = $olddatablob->{'postpipe'}; } } } # When we have no arguments in the current configuration, we must have # a raw queue my $rawqueue = ((!defined($db->{'dat'}{'args'})) || ($#{$db->{'dat'}{'args'}} < 0)); # Set the default printing options supplied on the command line if (!$rawqueue) { set_default_options($config, $db->{'dat'}); } # Printer model name (for comment field of the queue configuration) my ($make, $model, $makemodel); if (defined($db->{'dat'})) { $make = $db->{'dat'}{'make'}; $model = $db->{'dat'}{'model'}; $makemodel = $db->{'dat'}{'makemodel'}; if (($make) && ($model)) { $makemodel = "$make $model"; } } return ($rawqueue, $newfoomaticdata, $makemodel, ($config->{'spooler'} eq "cups" ? $beh : ())); } #fix to work on Ubuntu, where cupd runs not as root, but as cupsys user #like system ("chown cupsys $ppdfile"), but #changeowner function changes owner only if user exists on system sub changeowner { my ($username, $file) = @_; my ($uid,$gid) = (-1, -1); my $l; $l = getpwnam($username); $uid = $l if defined($l); $l = getgrnam($username); $gid = $l if defined($l); chown $uid, $gid, $file; } sub writeppdfile { my ($config, $ppdfile, $rawqueue, $newfoomaticdata) = @_; # Save old $ppdfile, if any system("cp -f \'$ppdfile\' \'$ppdfile.old\'") if (-f $ppdfile); if ($rawqueue) { # Raw queue with $postpipe, use a "PPD" only containing the # $postpipe (LPRng, LPD, and no spooler only) if (((defined $db->{'dat'}{'postpipe'} && $db->{'dat'}{'postpipe'} ne "") && (($config->{'spooler'} eq 'lprng') || ($config->{'spooler'} eq 'lpd'))) || ($config->{'spooler'} eq 'direct')) { open PPDFILE, "> $ppdfile" or die "Cannot write \'$ppdfile\'!\n"; print PPDFILE "*PPD-Adobe: \"4.3\"\n*%\n"; print PPDFILE "*% This is a raw (driverless/unfiltered) " . "queue, this PPD file only carries\n" . "*% the postpipe.\n*%\n"; close PPDFILE; $db->ppdsetdefaults($ppdfile); chmod 0644, $ppdfile; #fix to work on Ubuntu, where cupd runs not as root, but as cupsys user #system ("chown cupsys $ppdfile"); #changeowner function changes owner only if user exists on system changeowner("cupsys", $ppdfile); } else { if (-f $ppdfile) { unlink "$ppdfile" or die "Cannot delete \'$ppdfile\'!\n"; } } } else { if ($config->{'ppdfile'}) { # Copy in the PPD file specified on the command line if ($config->{'ppdfile'} !~ /\.gz$/i) { # Uncompressed PPD file system("cp -f \'$config->{'ppdfile'}\' \'$ppdfile\'") and die "Cannot copy \'$config->{'ppdfile'}\' to \'$ppdfile\'!\n"; } else { # Compressed PPD file system("$sysdeps->{'gzip'} -dc " . "\'$config->{'ppdfile'}\' > " . "\'$ppdfile\'") and die "Cannot copy \'$config->{'ppdfile'}\' to \'$ppdfile\'!\n"; } # Set default option settings and $postpipe $db->ppdsetdefaults($ppdfile); } elsif ($newfoomaticdata) { # Generate the PPD file from the Foomatic database open PPDFILE, "> $ppdfile" or die "Cannot write \'$ppdfile\'!\n"; print PPDFILE $db->getppd($config->{'shortgui'}); close PPDFILE; } else { # Keep the previous PPD file, only set the options and the # $postpipe $db->ppdsetdefaults($ppdfile); } # Correct the permissions of the PPD file chmod 0644, $ppdfile; #fix to work on Ubuntu, where cupd runs not as root, but as cupsys user #system ("chown cupsys $ppdfile"); #changeowner function changes owner only if user exists on system changeowner("cupsys", $ppdfile); } } ### Queue manipulation functions for both LPD and LPRng sub setup_lpd { my ($config) = $_[0]; # Read the previous /etc/printcap my $pcap = load_lpd_printcap(); my ($ppdfile, $entry, $reconf, $p); for $p (@{$pcap}) { if ($p->{'names'}[0] eq $config->{'queue'}) { $entry = $p; $reconf = 1; print "Reconfigure of ", Dumper($p) if $debug; last; } } # PPD file name $ppdfile = sprintf('%s/lpd/%s.ppd', $sysdeps->{'foo-etc'}, $config->{'queue'}) if !$ppdfile; # Get the data from the former queue if we reconfigure or copy a queue # do also some checking of the user-supplied parameters my ($rawqueue, $newfoomaticdata, $makemodel) = getoldqueuedata($config, $reconf); # Set the printer queue name line in /etc/printcap if (!$reconf) { if (!$rawqueue) { $entry->{'names'}[0] = $config->{'queue'}; $entry->{'names'}[1] = $config->{'desc'}; $entry->{'names'}[2] = "$makemodel"; $entry->{'names'}[3] = $config->{'loc'}; } else { $entry->{'names'}[0] = $config->{'queue'}; $entry->{'names'}[1] = $config->{'desc'}; $entry->{'names'}[2] = "Raw queue"; $entry->{'names'}[3] = $config->{'loc'}; } } else { if (!$rawqueue) { $entry->{'names'}[2] = "$makemodel"; } else { if (($entry->{'names'}[2] eq "Raw queue") || ($config->{'driver'} eq "raw")) { $rawqueue = 1; $entry->{'names'}[2] = "Raw queue"; } } if (defined($config->{'desc'})) { $entry->{'names'}[1] = $config->{'desc'}; } if (defined($config->{'loc'})) { $entry->{'names'}[3] = $config->{'loc'}; } } # These lines are always in /etc/printcap $entry->{'str'}{'sd'} = sprintf('%s/%s', $sysdeps->{'lpd-dir'}, $config->{'queue'}); $entry->{'str'}{'lf'} = $sysdeps->{'lpd-log'}; $entry->{'num'}{'mx'} = '0'; $entry->{'bool'}{'sh'} = 1; # Lines depending on the printer/spooler if (!$rawqueue) { if ($config->{'spooler'} eq "lpd") { $entry->{'str'}{'ppdfile'} = $ppdfile; # For the GPR printing GUI delete $entry->{'str'}{'ppd'}; $entry->{'str'}{'if'} = $sysdeps->{'foomatic-rip'}; $entry->{'str'}{'af'} = $ppdfile; delete $entry->{'bool'}{'force_localhost'}; delete $entry->{'str'}{'filter_options'}; } elsif ($config->{'spooler'} eq "lprng") { $entry->{'str'}{'ppd'} = $ppdfile; # for LPRng PPD support $entry->{'str'}{'if'} = $sysdeps->{'foomatic-rip'}; $entry->{'bool'}{'force_localhost'} = 1; delete $entry->{'str'}{'ppdfile'}; delete $entry->{'str'}{'af'}; delete $entry->{'str'}{'filter_options'}; } else { die "The spooler $config->{'spooler'} is not supported " . "by this function!\n"; } } else { delete $entry->{'str'}{'if'}; delete $entry->{'str'}{'af'}; delete $entry->{'str'}{'filter_options'}; delete $entry->{'str'}{'ppd'}; if ($config->{'spooler'} eq "lpd") { delete $entry->{'bool'}{'force_localhost'}; } elsif ($config->{'spooler'} eq "lprng") { $entry->{'bool'}{'force_localhost'} = 1; } else { die "The spooler $config->{'spooler'} is not supported " . "by this function!\n"; } } # If printing job has to be passed through a special program, put the # command line into $postpipe (for example for Socket, Samba, ...) my $postpipe = ""; if ((!$reconf) or ($config->{'connect'})) { # Set up connection type # Remove "rm" and "rp" tags to avoid problems when overwriting a # raw queue delete $entry->{'str'}{'rm'}; delete $entry->{'str'}{'rp'}; # All URIs ("-c" option) have the same syntax as URIs in CUPS ("-v" # option of "lpadmin"). my $file; if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)!) { # Local printer or printing to a file $file = $2; if ($config->{'connect'} =~ m!^usb://!) { # Queue with printer-bound USB URI transferred from CUPS, # as LPD/LPRng does not support these URIs, translate it # back to a standard USB device URI $file = cups_usb_printer_uri_to_device_uri($file); } if (! -e $file) { warn "The device or file $file doesn't exist? " . "Working anyway.\n"; } if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) || ($file =~ m!^/dev/ptal-printd/(.+)$!) || ($file =~ m!^/var/run/ptal-printd/(.+)$!)) { # Translate URI for ptal-printd to postpipe using the # "ptal-connect" command my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $postpipe = "$sysdeps->{'ptal-connect'} $devname -print"; $entry->{'str'}{'lp'} = "/dev/null"; } else { $entry->{'str'}{'lp'} = $file; } } elsif ($config->{'connect'} =~ m!^ptal://?([^/].*)$!) { # HPOJ MLC protocol my $devname = $1; $postpipe = "$sysdeps->{'ptal-connect'} $devname -print"; $entry->{'str'}{'lp'} = "/dev/null"; } elsif ($config->{'connect'} =~ m!^mtink:/(.+)$!) { # Printing through "mtinkd" $entry->{'str'}{'lp'} = "$sysdeps->{'mtink-pipes'}/$1"; } elsif ($config->{'connect'} =~ m!^lpd://([^/]+)/([^/]+)$!) { # Remote LPD my $remhost = $1; my $remqueue = $2; if (($rawqueue) && ($config->{'spooler'} eq "lpd")) { $entry->{'str'}{'rm'} = $remhost; $entry->{'str'}{'rp'} = $remqueue; delete $entry->{'str'}{'lp'}; } elsif( ($config->{'spooler'} eq "lprng")) { delete $entry->{'str'}{'rm'}; delete $entry->{'str'}{'rp'}; $entry->{'str'}{'lp'} = "$remqueue\@$remhost"; } else { # classic LPD does not support sending jobs to a server with the # "rm" and "rp" tags in /etc/printcap and filtering it # before ("if" tag). So when we do not set up a raw queue, # we do not # # $entry->{'str'}{'rm'} = $remhost; # $entry->{'str'}{'rp'} = $remqueue; # # but use "rlpr" in a $postpipe. Note that "rlpr" prints a # banner page by default, "-h" suppresses it. "rlpr" must # be SUID "root". $postpipe = "$sysdeps->{'rlpr'} -q -h -P " . "$remqueue\@$remhost"; $entry->{'str'}{'lp'} = "/dev/null"; } } elsif ($config->{'connect'} =~ m!^socket://([^/:]+):([0-9]+)/?$!) { # Socket (AppSocket/HP JetDirect) my $remhost = $1; my $remport = $2; if( ($config->{'spooler'} eq "lprng")) { $entry->{'str'}{'lp'} = "$remhost\%$remport"; } else { $postpipe = "$sysdeps->{'nc'} -w 1 $remhost $remport"; $entry->{'str'}{'lp'} = "/dev/null"; } } elsif ($config->{'connect'} =~ m!^smb://(.*)$!) { # SMB (Printer on Windows server) my $parameters = $1; # Get the user's login and password from the URI my $smbuser = ""; my $smbpassword = ""; if ($parameters =~ m!([^@]*)@([^@]+)!) { my $login = $1; $parameters = $2; if ($login =~ m!([^:]*):([^:]*)!) { $smbuser = $1; $smbpassword = $2; } else { $smbuser = $login; $smbpassword = ""; } } else { $smbuser = "GUEST"; $smbpassword = ""; } # Get the workgroup, server, and share name my $workgroup = ""; my $smbserver = ""; my $smbshare = ""; if ($parameters =~ m!([^/]*)/([^/]+)/([^/]+)$!) { $workgroup = $1; $smbserver = $2; $smbshare = $3; } elsif ($parameters =~ m!([^/]+)/([^/]+)$!) { $workgroup = ""; $smbserver = $1; $smbshare = $2; } else { die "The \"smb://\" URI must at least contain the " . "server name and the share name!\n"; } # Set up the command line for printing on the SMB server $postpipe = "$sysdeps->{'smbclient'} '//$smbserver/$smbshare'"; if ($smbpassword ne "") { warn("WARNING: smbclient password is visible in PPD file\n"); $postpipe .= " '$smbpassword'"; } if ($smbuser ne "") {$postpipe .= " -U '$smbuser'";} if ($workgroup ne "") {$postpipe .= " -W '$workgroup'";} $postpipe .= " -N -P -c 'print -' "; $entry->{'str'}{'lp'} = "/dev/null"; } elsif ($config->{'connect'} =~ m!^ncp://(.*)$!) { my $parameters = $1; # Get the user's login and password from the URI my $ncpuser = ""; my $ncppassword = ""; if ($parameters =~ m!([^@]*)@([^@]+)!) { my $login = $1; $parameters = $2; if ($login =~ m!([^:]*):([^:]*)!) { $ncpuser = $1; $ncppassword = $2; } else { $ncpuser = $login; $ncppassword = ""; } } else { $ncpuser = ""; $ncppassword = ""; } # Get the server and share name my $ncpserver = ""; my $ncpqueue = ""; if ($parameters =~ m!([^/]+)/([^/]+)$!) { $ncpserver = $1; $ncpqueue = $2; } else { die "The \"ncp://\" URI must at least contain the " . "server name and the queue name!\n"; } # Set up the command line for printing on the Netware server $postpipe = "$sysdeps->{'nprint'} -S $ncpserver"; if ($ncpuser ne "") { $postpipe .= " -U $ncpuser"; if ($ncppassword ne "") { warn("WARNING: ncp password is visible in PPD file\n"); $postpipe .= " -P $ncppassword"; } else { $postpipe .= " -n"; } } $postpipe .= " -q $ncpqueue -N - 2>/dev/null"; $entry->{'str'}{'lp'} = "/dev/null"; } elsif ($config->{'connect'} =~ m!^postpipe:(.*)$!) { # Pipe output into a command $postpipe = $1; $entry->{'str'}{'lp'} = "/dev/null"; } elsif ($config->{'connect'}) { $entry->{'str'}{'lp'} = '/dev/null'; die ("The URI \"$config->{'connect'}\" is not supported " . "for LPD/LPRng or you have\nmistyped.\n"); } else { print STDERR "You must specify a connection with -c.\n"; help(); exit(1); } # Put $postpipe into the data structure, so that it will be # inserted into the PPD file if ($postpipe ne "") { $postpipe = "| $postpipe"; $db->{'dat'}{'postpipe'} = $postpipe; } else { undef $db->{'dat'}{'postpipe'}; } } else { # Keep previous connection type # Use previous $postpipe if (defined($db->{'dat'}{'postpipe'})) { $postpipe = $db->{'dat'}{'postpipe'}; } } # When we have a $postpipe we never write to a device if ($postpipe ne "") { $entry->{'str'}{'lp'} = '/dev/null'; if ($config->{'spooler'} eq "lpd") { $entry->{'str'}{'if'} = $sysdeps->{'foomatic-rip'}; $entry->{'str'}{'af'} = $ppdfile; } elsif ($config->{'spooler'} eq "lprng") { $entry->{'str'}{'if'} = $sysdeps->{'foomatic-rip'}; $entry->{'str'}{'ppd'} = $ppdfile; $entry->{'bool'}{'force_localhost'} = 1; } else { die "The spooler $config->{'spooler'} is not supported " . "by this function!\n"; } } # Various file setup mkdir $sysdeps->{'foo-etc'}, 0755; mkdir "$sysdeps->{'foo-etc'}/lpd", 0755; mkdir $entry->{'str'}{'sd'}, 0755; # Lead with a blank line for new entries push (@{$entry->{'comments'}}, "\n") if (!$reconf); # Put in a useful comment for both new and old entries push (@{$entry->{'comments'}}, sprintf ("\# Entry edited %s by $progname.", scalar(localtime(time))), "\# Additional configuration atop $ppdfile"); # Add to the printcap if a new entry if (!$reconf) { push(@{$pcap}, $entry); } # Generate/write te PPD file writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata); # Make sure that /var/spool/lp-errs exists system "touch $sysdeps->{'lpd-log'}"; chmod 0600, $sysdeps->{'lpd-log'}; my ($lpuid, $lpgid) = (-1, -1); my $l; $l = getpwnam("lp"); $lpuid = $l if defined($l); $l = getgrnam("lp"); $lpgid = $l if defined($l); chown $lpuid, $lpgid, $sysdeps->{'lpd-log'}; # Write back /etc/printcap my $printcap = $sysdeps->{'lpd-pcap'}; rename $printcap, "$printcap.old" or die "Cannot backup $printcap!\n"; open PRINTCAP, "> $printcap" or die "Cannot write $printcap!\n"; print PRINTCAP dump_lpd_printcap($config, $pcap); close PRINTCAP; chmod 0644, $printcap; # In case of LPRng, give SIGHUP to the daemon, LPRng needs this to # recognize a new queue if ($config->{'spooler'} eq "lprng") { # first check configuration system("$sysdeps->{'lprng-checkpc'} -f > /dev/null 2>&1"); # now signal to use it system("$sysdeps->{'lpd-lpc'} reread > /dev/null 2>&1"); } return 1; } sub default_lpd { my ($config) = $_[0]; my $name = $config->{'queue'}; my $pcap = load_lpd_printcap(); # Add the alias "lp" to the /etc/printcap entry to make LPD considering # the chosen printer as default printer # Some stuff for renaming a queue named "lp" my $nppdfile = undef; my $newname = undef; my $rawqueue = 0; my @newcap; for (@{$pcap}) { my $p = $_; if ($p->{'names'}[0] eq $name) { $p->{'names'}[4] = 'lp'; } else { # Rename a printer whose first name is 'lp' if ($p->{'names'}[0] eq 'lp') { # Do we have a raw queue? if ((!defined($p->{'str'}{'if'})) || ($p->{'str'}{'if'} ne $sysdeps->{'foomatic-rip'})) { $rawqueue = 1; } # Search for a free name my $i = 0; my $namefound = 0; while(!$namefound) { my $pp; my $nameinuse = 0; for $pp (@{$pcap}) { if (defined($pp->{'names'})) { my $n; for $n (@{$pp->{'names'}}) { if ($n eq "lp$i") { $nameinuse = 1; last; } } if ($nameinuse) { $i++; last; } } } $namefound = 1 - $nameinuse; } $newname = "lp$i"; # Old PPD file name my $ppdfile = sprintf('%s/lpd/lp.ppd', $sysdeps->{'foo-etc'}); # New PPD file name my $nppdfile = sprintf('%s/lpd/%s.ppd', $sysdeps->{'foo-etc'}, $newname); # Rename the printer $p->{'names'}[0] = $newname; my $oldspooldir = $p->{'str'}{'sd'}; $p->{'str'}{'sd'} = sprintf('%s/%s', $sysdeps->{'lpd-dir'}, $newname); if ($p->{'str'}{'af'} =~ /\.ppd$/) { $p->{'str'}{'af'} = $nppdfile; } # Rename old $ppdfile, if any rename $ppdfile, $nppdfile if (-f $ppdfile); # Rename the spool directory rename $oldspooldir, $p->{'str'}{'sd'} if (-d $oldspooldir); # Put out warning warn("WARNING: Printer \"lp\" renamed to \"$newname\".\n"); } # Remove 'lp' as alias name my $n; for $n (@{$p->{'names'}}) { if ($n eq 'lp') { $n = ''; } } } push (@newcap, $p); } my @newprintcap = dump_lpd_printcap($config, \@newcap); my $printcap = $sysdeps->{'lpd-pcap'}; rename $printcap, "$printcap.old" or die "Cannot backup $printcap!\n"; open PRINTCAP, "> $printcap" or die "Cannot write $printcap!\n"; print PRINTCAP @newprintcap; close PRINTCAP; chmod 0644, $printcap; return 1; } sub default_lprng { my ($config) = $_[0]; my $name = $config->{'queue'}; my $pcap = load_lpd_printcap(); # Move the /etc/printcap entry for the chosen printer to the first place # so that LPRng considers it as the default printer my @newcap; for (@{$pcap}) { push (@newcap, $_) if ($_->{'names'}[0] eq $name); } for (@{$pcap}) { push (@newcap, $_) unless ($_->{'names'}[0] eq $name); } my @newprintcap = dump_lpd_printcap($config, \@newcap); my $printcap = $sysdeps->{'lpd-pcap'}; rename $printcap, "$printcap.old" or die "Cannot backup $printcap!\n"; open PRINTCAP, "> $printcap" or die "Cannot write $printcap!\n"; print PRINTCAP @newprintcap; close PRINTCAP; chmod 0644, $printcap; # In case of LPRng, give SIGHUP to the daemon, LPRng needs this to # recognize the changes if ($config->{'spooler'} eq "lprng") { system("$sysdeps->{'lpd-lpc'} reread > /dev/null 2>&1"); system("$sysdeps->{'lprng-checkpc'} -f > /dev/null 2>&1"); } return 1; } sub delete_lpd { my ($config) = $_[0]; my $name = $config->{'queue'}; my $pcap = load_lpd_printcap(); my @newcap; for (@{$pcap}) { push (@newcap, $_) unless ($_->{'names'}[0] eq $name); } my @newprintcap = dump_lpd_printcap($config, \@newcap); my $printcap = $sysdeps->{'lpd-pcap'}; rename $printcap, "$printcap.old" or die "Cannot backup $printcap!\n"; open PRINTCAP, "> $printcap" or die "Cannot write $printcap!\n"; print PRINTCAP @newprintcap; close PRINTCAP; chmod 0644, $printcap; # PPD file name my $ppdfile = sprintf('%s/lpd/%s.ppd', $sysdeps->{'foo-etc'}, $config->{'queue'}); # Rename old $ppdfile, if any rename $ppdfile, "$ppdfile.old" if (-f $ppdfile); # In case of LPRng, give SIGHUP to the daemon, LPRng needs this to # recognize the changes if ($config->{'spooler'} eq "lprng") { system("$sysdeps->{'lpd-lpc'} reread > /dev/null 2>&1"); system("$sysdeps->{'lprng-checkpc'} -f > /dev/null 2>&1"); } return 1; } sub query_lpd { my ($config) = @_; # User requests data of a printer/driver combo to see the options before # installing a queue if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) && ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) { if ($opt_n) { my $olddatablob = load_lpd_datablob($opt_n); print_perl_combo_data($config, $olddatablob); } else { print_perl_combo_data($config); } return; } my $i = $ARGV[0]; if (!defined($i)) {$i = 0;} my $pcap = load_lpd_printcap(); my $p; if (!$opt_P) { print "\n"; } # Query the default printer my $default; if (!defined($config->{'queue'})) { if ($config->{'spooler'} eq "lpd") { # Under LPD the default printer is the printer which has # "lp" as its name or as an alias name my $def_firstname = undef; for $p (@{$pcap}) { if (defined($p->{'names'})) { my $n; for $n (@{$p->{'names'}}) { if ($n eq 'lp') { $def_firstname = $p->{'names'}[0]; last; } } if (defined($def_firstname)) { last; } } } if (defined($def_firstname)) { $default = $def_firstname; if (!$opt_P) { print "$def_firstname\n"; } } } else { # Under LPRng the default printer is the first entry in # /etc/printcap for $p (@{$pcap}) { if (defined($p->{'names'})) { $default = $p->{'names'}[0]; if (!$opt_P) { print "$p->{'names'}[0]" . "\n"; } last; } } } } for $p (@{$pcap}) { # enpty end entry for trailing comments next if !defined($p->{'names'}); # were we invoked for only one queue? next if (defined($config->{'queue'}) and $config->{'queue'} ne $p->{'names'}[0]); # load the queue data $db->{'dat'} = load_lpd_datablob($p->{'names'}[0]); # extract the queue data block my $c = $db->{'dat'}{'queuedata'}; if ($opt_P) { if ($p->{'names'}[0] eq $default) { $db->{'dat'}{'queuedata'}{'default'} = 1; } else { $db->{'dat'}{'queuedata'}{'default'} = 0; } $db->{'dat'}{'queuedata'}{'remote'} = 0; my $asciidata = $db->getascii(); $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g; print $asciidata; $i ++; } else { # and get it to standard output dump_config($c); } } if (!$opt_P) { print "\n"; } return; } ### Queue manipulation functions for CUPS sub setup_cups { my ($config) = $_[0]; # PPD file name # (/etc/foomatic/cups/ will be a link to /etc/cups/ppd/) my $ppdfile = sprintf('%s/ppd/%s.ppd', $sysdeps->{'cups-etc'}, $config->{'queue'}); # Get the data from the former queue if we reconfigure or copy a queue # do also some checking of the user-supplied parameters my ($rawqueue, $newfoomaticdata, $makemodel, $beh) = getoldqueuedata($config, 1); # Here we set up the command line for the "lpadmin" command my $lpadminline = "$sysdeps->{'cups-admin'} -p \"$config->{'queue'}\" -E"; # Use manufacturer and model as description when no description is # provided if (defined($config->{'desc'})) { $lpadminline .= " -D \"$config->{'desc'}\""; } else { # Before we overwrite the description field with manufacturer # and model, check if there is some old contents my $pconf = load_cups_printersconf(); my $p; my $olddesc; for $p (@{$pconf}) { next if (defined($config->{'queue'}) and $config->{'queue'} ne $p->{'name'}); $olddesc = $p->{'Info'}; } if (!$olddesc) { if (!$rawqueue) { $lpadminline .= " -D \"$makemodel\""; } else { $lpadminline .= " -D \"Raw queue\""; } } } # Fill in the "location" field if something for it is provided. if (defined($config->{'loc'})) { $lpadminline .= " -L \"$config->{'loc'}\""; } # PPD file argument for the printer if (!$rawqueue) { $lpadminline .= " -P \'$ppdfile\'"; } # All URIs ("-c" option) have the same syntax as URIs in CUPS # ("-v" option of "lpadmin"). Here the old "file:/" URIs are # translated to the form which CUPS needs. All other URIs are # simply passed to lpadmin. my $cupsuri = ""; if (defined($config->{'connect'})) { if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)$!) { # Translate "file:/" into the prefix needed by CUPS, if # necessary $cupsuri = $2; if ((($cupsuri =~ m!$sysdeps->{'ptal-pipes'}/(.+)$!) || ($cupsuri =~ m!/dev/ptal-printd/(.+)$!) || ($cupsuri =~ m!/var/run/ptal-printd/(.+)$!)) && (-x "$sysdeps->{'cups-backends'}/ptal")) { # Translate URI for ptal-printd (does not work with CUPS # 1.1.12 and newer) to URI for the "ptal" CUPS backend # script (if the script is there) my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $cupsuri = "ptal:/$devname"; } elsif ((($cupsuri =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) || ($cupsuri =~ m!^/var/mtink/(.+)$!)) && (-x "$sysdeps->{'cups-backends'}/mtink")) { # Translate URI for mtinkd (does not work with CUPS # 1.1.12 and newer) to URI for the "mtink" CUPS backend # script (if the script is there) $cupsuri = "mtink:/$1"; } elsif ($config->{'connect'} =~ m!usb!i) { $cupsuri = cups_usb_device_uri_to_printer_uri($cupsuri); $cupsuri = "usb:$cupsuri"; } elsif (($cupsuri =~ m!lp[0-9]!) || ($cupsuri =~ m!LP[0-9]!)|| ($cupsuri =~ m!parallel!)) { $cupsuri = "parallel:$cupsuri"; } elsif (($cupsuri =~ m!tty!) || ($cupsuri =~ m!TTY!) || ($cupsuri =~ m!serial!)) { $cupsuri = "serial:$cupsuri"; } else { $cupsuri = "file:$cupsuri"; } } elsif (($config->{'connect'} =~ m!^ptal://?([^/].*)$!) && (!-x "$sysdeps->{'cups-backends'}/ptal")) { # If there is no "ptal" backend script for CUPS, use an URI # pointing to the pipe set up by ptal-printd. my $devname = $1; $devname =~ tr/:/_/; $cupsuri = "file:$sysdeps->{'ptal-pipes'}/$devname"; } elsif (($config->{'connect'} =~ m!^mtink:/(.*)$!) && (!-x "$sysdeps->{'cups-backends'}/mtink")) { # If there is no "mtink" backend script for CUPS, use an URI # pointing to the pipe set up by mtinkd. $cupsuri = "file:$sysdeps->{'mtink-pipes'}/$1"; } else { $cupsuri=$config->{'connect'}; } # Correct PTAL URIs: "ptal:/..." for HPOJ 0.9, "ptal://..." for newer # HPOJ if ($cupsuri =~ m!^ptal:/!) { $cupsuri = cups_correct_ptal_uri($cupsuri); } } # Are there changes in the error handling of the backend? if (((defined($config->{'dd'})) && (((defined($beh->{'dd'})) && ($config->{'dd'} ne $beh->{'dd'})) || ($config->{'dd'} != 0))) || ((defined($config->{'att'})) && (((defined($beh->{'att'})) && ($config->{'att'} ne $beh->{'att'})) || ($config->{'att'} != 1))) || ((defined($config->{'delay'})) && (((defined($beh->{'delay'})) && ($config->{'delay'} ne $beh->{'delay'})) || ($config->{'delay'} != 30)))) { if (!defined($config->{'dd'})) { $config->{'dd'} = (defined($beh->{'dd'}) ? $beh->{'dd'} : 0); } if (!defined($config->{'att'})) { $config->{'att'} = (defined($beh->{'att'}) ? $beh->{'att'} : 1); } if (!defined($config->{'delay'})) { $config->{'delay'} = (defined($beh->{'delay'}) ? $beh->{'delay'} : 30); } $cupsuri = $beh->{'uri'} if !$cupsuri; # Do only add the "beh" wrapper backend when it is really needed # (More than one retry and/or no disabling) and if the queue is not # using the HPLIP ("hp") backend, as otherwise the "hp-toolbox" # will not list the printer any more. HPLIP does infinite retries # in 30-sec intervals anyway. if (($cupsuri) && ($cupsuri !~ m!^hp(fax|):/!) && (($config->{'dd'} != 0) || ($config->{'att'} != 1))) { $cupsuri = sprintf("beh:/%d/%d/%d/%s", $config->{'dd'}, $config->{'att'}, $config->{'delay'}, $cupsuri); } } if ($cupsuri) { $lpadminline .= " -v \"$cupsuri\""; } # Directory setup, let the Foomatic PPD directory for CUPS be the same # as /etc/cups/ppd/ (where CUPS stores the PPDs of the installed queues) mkdir $sysdeps->{'foo-etc'}, 0755; symlink "$sysdeps->{'cups-etc'}/ppd/", "$sysdeps->{'foo-etc'}/cups"; # In CUPS we never have a $postpipe # (when we get a $postpipe from a source PPD file from another # spooler, we don't need to remove it really, because it will be # ignored by foomatic-rip, uncomment this to remove it) #$db->{'dat'}{'postpipe'} = ""; # Generate/write te PPD file writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata); # Execute the lpadmin command to set up the new queue if (system $lpadminline) { # Remove the config files unlink "$ppdfile" if (-f "$ppdfile"); # Revert changed config files rename "$ppdfile.old", "$ppdfile" if (-f "$ppdfile.old"); die "Could not set up/change the queue \"$config->{'queue'}\"!\n"; } return 1; } sub default_cups { my ($config) = $_[0]; if ($< == 0) { # (/etc/cups/printers.conf can only be manipulated by root) # This line sets the default printer in /etc/cups/printers.conf my $command = "$sysdeps->{'cups-admin'} -d " . "\"$config->{'queue'}\" > /dev/null"; # Do it! (Ignore errors silently) system $command; } # This line sets the default printer in /etc/cups/lpoptions # (required for setting a remote queue as default) my $command = "$sysdeps->{'cups-lpoptions'} -d " . "\"$config->{'queue'}\" > /dev/null"; # Do it! system $command and die "Unable to set queue \"$config->{'queue'}\" as default!\n"; } sub delete_cups { my ($config) = $_[0]; # This line deletes the old printer queue my $queuedeleteline = "$sysdeps->{'cups-admin'} -x \"$config->{'queue'}\""; # Do it! system $queuedeleteline and die "Unable to delete queue \"$config->{'queue'}\"!\n"; return 1; } sub query_cups { my ($config) = @_; # User requests data of a printer/driver combo to see the options before # installing a queue if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) && ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) { if ($opt_n) { my $olddatablob = load_cups_datablob($opt_n); print_perl_combo_data($config, $olddatablob); } else { print_perl_combo_data($config); } return; } my $i = $ARGV[0]; if (!defined($i)) {$i = 0;} my $pconf = load_cups_printersconf(); if (defined($opt_r)) {$opt_r = undef;} my $p; if (!$opt_P) { print "\n"; } # Query the default printer my $default = ''; if (!defined($config->{'queue'})) { open DEFAULT, "$sysdeps->{'cups-lpstat'} -d |" or die "Could not run $sysdeps->{'cups-lpstat'}!\n"; my $defaultstr = ; close DEFAULT; if ($defaultstr =~ m!\S+:\s+(\S+)$!) { $default = $1; if (!$opt_P) { print "$default\n"; } } } for $p (@{$pconf}) { # were we invoked for only one queue? next if (defined($config->{'queue'}) and $config->{'queue'} ne $p->{'name'}); # load the queue data $db->{'dat'} = load_cups_datablob($p->{'name'}); # Enter info for remote queue if ($p->{'remote'}) { $db->{'dat'}{'queuedata'}{'foomatic'} = 0; $db->{'dat'}{'queuedata'}{'spooler'} = 'cups'; $db->{'dat'}{'queuedata'}{'queue'} = $p->{'name'}; $db->{'dat'}{'queuedata'}{'connect'} = $p->{'DeviceURI'}; $db->{'dat'}{'queuedata'}{'description'} = $p->{'Info'}; $db->{'dat'}{'queuedata'}{'loc'} = $p->{'Location'}; $db->{'dat'}{'queuedata'}{'remote'} = 1; } else { $db->{'dat'}{'queuedata'}{'remote'} = 0; } # extract the queue data block my $c = $db->{'dat'}{'queuedata'}; if ($opt_P) { if ($p->{'name'} eq $default) { $db->{'dat'}{'queuedata'}{'default'} = 1; } else { $db->{'dat'}{'queuedata'}{'default'} = 0; } my $asciidata = $db->getascii(); $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g; print $asciidata; $i ++; } else { # and get it to standard output dump_config($c); } } if (!$opt_P) { print "\n"; } return; } ### Queue manipulation functions for PDQ sub setup_pdq { my ($config) = $_[0]; # Read the previous /usr/lib/pdq/printrc my $printrc = load_pdq_printrc(); my ($ppdfile, $driverfile, $entry, $reconf, $p); $reconf = 0; for $p (@{$printrc}) { if ((defined($p->{'name'})) && ($p->{'name'} eq $config->{'queue'})) { $entry = $p; $reconf = 1; last; use Data::Dumper; print "Reconfigure of ", Dumper($p); } } # Config file names $ppdfile = sprintf('%s/pdq/%s.ppd', $sysdeps->{'foo-etc'}, $config->{'queue'}); $driverfile = sprintf('%s/pdq/driverdescr/%s.pdq', $sysdeps->{'foo-etc'}, $config->{'queue'}); # Get the data from the former queue if we reconfigure or copy a queue # do also some checking of the user-supplied parameters my ($rawqueue, $newfoomaticdata, $makemodel) = getoldqueuedata($config, $reconf); # Set the initial line of the "printer" block in /usr/lib/pdq/printrc $entry->{'name'} = $config->{'queue'}; # Location field if ((defined($config->{'loc'})) || (!$reconf)) { $entry->{'location'} = "\"$config->{'loc'}\""; } # Model/Description field if (defined($config->{'desc'})) { $entry->{'model'} = "\"$config->{'desc'}\""; } elsif (!$entry->{'model'}) { if (!$rawqueue) { $entry->{'model'} = "\"$makemodel\""; } else { $entry->{'model'} = "\"Raw printer\""; } } # Create directories mkdir $sysdeps->{'foo-etc'}, 0755; mkdir $sysdeps->{'foo-etc'} . '/pdq', 0755; mkdir $sysdeps->{'foo-etc'} . '/pdq/driverdescr', 0755; # Make the printer driver descriptions in /etc/foomatic/pdq visible # for PDQ # symlink $sysdeps->{'foo-etc'} . '/pdq', $sysdeps->{'pdq-foomatic'}; # Save old driver file, use the "~" to make it appear an editor # backup so that PDQ does not parse it. # Save old $driverfile, if any rename $driverfile, "$driverfile.old~" if (-f $driverfile); # Generate/write the PPD file writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata); # Create driver description file if ($rawqueue) { system("$sysdeps->{'foomatic-rip'} --genrawpdq $driverfile") and die "Cannot create $driverfile!\n"; } else { system("$sysdeps->{'foomatic-rip'} --ppd \'$ppdfile\' --genpdq " . "$driverfile") and die "Cannot create $driverfile!\n"; } # PDQ configuration file # Driver fields # Extract driver name my $driverdesc = `cat $driverfile`; $driverdesc =~ m!^\s*driver\s*(\"\S*\-\d+\")!m; # Driver-specific entries $entry->{'driver'} = $1; $entry->{'driver_opts'} = "\{ \}"; $entry->{'driver_args'} = "\{ \}"; # Interface fields # All URIs ("-c" option) have the same syntax as URIs in CUPS ("-v" # option of "lpadmin"). if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)!) { # Local printer or printing to a file my $file = $2; if ($config->{'connect'} =~ m!^usb://!) { # Queue with printer-bound USB URI transferred from CUPS, # as PDQ does not support these URIs, translate it # back to a standard USB device URI $file = cups_usb_printer_uri_to_device_uri($file); } if (! -e $file) { warn "The device or file $file doesn't exist? " . "Working anyway.\n"; } $entry->{'interface'} = "\"local-port\""; $entry->{'interface_opts'} = "\{ \}"; $entry->{'interface_args'} = "\{ \"PORT\" = \"$file\" \}"; } elsif ($config->{'connect'} =~ m!^ptal://?([^/].*)$!) { # HPOJ MLC protocol my $devname = $1; $devname =~ tr/:/_/; $entry->{'interface'} = "\"local-port\""; $entry->{'interface_opts'} = "\{ \}"; $entry->{'interface_args'} = "\{ \"PORT\" = " . "\"$sysdeps->{'ptal-pipes'}/$devname\" \}"; } elsif ($config->{'connect'} =~ m!^mtink:/(.+)$!) { # Printing through "mtinkd" $entry->{'interface'} = "\"local-port\""; $entry->{'interface_opts'} = "\{ \}"; $entry->{'interface_args'} = "\{ \"PORT\" = " . "\"$sysdeps->{'mtink-pipes'}/$1\" \}"; } elsif ($config->{'connect'} =~ m!^lpd://([^/]+)/([^/]+)$!) { # Remote LPD my $remhost = $1; my $remqueue = $2; $entry->{'interface'} = "\"bsd-lpd\""; $entry->{'interface_opts'} = "\{ \}"; $entry->{'interface_args'} = "\{ \"QUEUE\" = \"$remqueue\", \"REMOTE_HOST\" = " . "\"$remhost\" \}"; } elsif ($config->{'connect'} =~ m!^socket://([^/:]+):([0-9]+)/?$!) { # Socket (AppSocket/HP JetDirect) my $remhost = $1; my $remport = $2; $entry->{'interface'} = "\"tcp-port\""; $entry->{'interface_opts'} = "\{ \}"; $entry->{'interface_args'} = "\{ \"REMOTE_PORT\" = \"$remport\", \"REMOTE_HOST\" = " . "\"$remhost\" \}"; } elsif ($config->{'connect'}) { die ("The URI \"$config->{'connect'}\" is not supported " . "for PDQ or you have\nmistyped.\n"); } elsif (!$reconf) { die "You must specify a connection with -c.\n"; } # Add to the printrc if it is a new entry if (!$reconf) { push(@{$printrc}, $entry); } # Write back the modified printrc file my $printrcname = $sysdeps->{'pdq-printrc'}; rename $printrcname, "$printrcname.old" or die "Cannot backup $printrcname!\n"; open PRINTRC, "> $printrcname" or die "Cannot write $printrcname!\n"; print PRINTRC dump_pdq_printrc($printrc); close PRINTRC; chmod 0644, $printrcname; return 1; } sub default_pdq { my ($config) = $_[0]; # Determine the name of the config file to modify my $printrcname = ""; if ($< == 0) { $printrcname = "$sysdeps->{'pdq-printrc'}"; if (!(-f $printrcname)) {die "No file $printrcname!"}; } else { $printrcname = "$ENV{HOME}/.printrc"; if (!(-f $printrcname)) {system "touch $printrcname"}; } # Read the config file open PRINTRC, "$printrcname" or die "Cannot open $printrcname!"; my @printrc = ; close PRINTRC; # Remove all valid "default_printer" lines ($_ =~ /^\s*default_printer/ and $_="") foreach @printrc; # Insert the new "default_printer" line push @printrc, "default_printer $config->{'queue'}\n"; # Write back the modified config file open PRINTRC, "> $printrcname" or die "Cannot open $printrcname!"; print PRINTRC @printrc; close PRINTRC; } sub delete_pdq { my ($config) = $_[0]; my $name = $config->{'queue'}; my $printrc = load_pdq_printrc(); my @newrc; for (@{$printrc}) { push (@newrc, $_) unless (defined($_->{'name'}) && ($_->{'name'} eq $name)); } my @newprintrc = dump_pdq_printrc(\@newrc); my $printrcname = $sysdeps->{'pdq-printrc'}; rename $printrcname, "$printrcname.old" or die "Cannot backup $printrcname!\n"; open PRINTRC, "> $printrcname" or die "Cannot write $printrcname!\n"; print PRINTRC @newprintrc; close PRINTRC; chmod 0644, $printrcname; # Config file names my $ppdfile = sprintf('%s/pdq/%s.ppd', $sysdeps->{'foo-etc'}, $config->{'queue'}); my $driverfile = sprintf('%s/pdq/driverdescr/%s.pdq', $sysdeps->{'foo-etc'}, $config->{'queue'}); # Rename old $ppdfile, if any rename $ppdfile, "$ppdfile.old" if (-f $ppdfile); # Rename old driverfile, if any, use the "~" to make it appear an # editor backup so that PDQ does not parse it. # Rename old $driverfile, if any rename $driverfile, "$driverfile.old~" if (-f $driverfile); return 1; } sub query_pdq { my ($config) = @_; # User requests data of a printer/driver combo to see the options before # installing a queue if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) && ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) { if ($opt_n) { my $olddatablob = load_pdq_datablob($opt_n); print_perl_combo_data($config, $olddatablob); } else { print_perl_combo_data($config); } return; } my $i = $ARGV[0]; if (!defined($i)) {$i = 0;} my $printrc = load_pdq_printrc(); my $p; if (!$opt_P) { print "\n"; } # Query the default printer my $default; if (!defined($config->{'queue'})) { open DEFAULT, "$sysdeps->{'pdq-print'} -h 2>&1 |" or die "Could not run $sysdeps->{'pdq-print'}!\n"; my $defaultstr = join('', ); close DEFAULT; if ($defaultstr =~ m!The\s+default\s+printer\s+is\s+(\S+)$!m) { $default = $1; if (!$opt_P) { print "$default\n"; } } } for $p (@{$printrc}) { # Omit non-printer-block items next if (!(defined($p->{'name'}))); # were we invoked for only one queue? next if (defined($config->{'queue'}) and $config->{'queue'} ne $p->{'name'}); # load the queue data $db->{'dat'} = load_pdq_datablob($p->{'name'}); # extract the queue data block my $c = $db->{'dat'}{'queuedata'}; if ($opt_P) { if ($p->{'name'} eq $default) { $db->{'dat'}{'queuedata'}{'default'} = 1; } else { $db->{'dat'}{'queuedata'}{'default'} = 0; } $db->{'dat'}{'queuedata'}{'remote'} = 0; my $asciidata = $db->getascii(); $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g; print $asciidata; $i ++; } else { # and get it to standard output dump_config($c); } } if (!$opt_P) { print "\n"; } return; } ### Queue manipulation functions for PPR sub setup_ppr { my ($config) = $_[0]; # Read the previous configuration my $printrc = load_ppr_printers_conf(); my ($ppdfile, $entry, $reconf, $p); $reconf = 0; for $p (@{$printrc}) { if ((defined($p->{'name'})) && ($p->{'name'} eq $config->{'queue'})) { $entry = $p; $reconf = 1; last; use Data::Dumper; print "Reconfigure of ", Dumper($p); } } # PPD file name $ppdfile = sprintf('%s/ppr/%s.ppd', $sysdeps->{'foo-etc'}, $config->{'queue'}); # Determine the PPR version in use my $pprversion; if (open VER, "$sysdeps->{'ppr-pprd'} --version |") { my $ver = ; close VER; $ver =~ /^\D*(\d+)\.(\d+)(\.(\d+)|)((a|alpha|b|beta|r|rc)(\d+|)|)/; $pprversion = (1e8 * $1 + 1e6 * $2 + 1e4 * $4 + ($5 ? 100 * (ord(uc($6)) - 64) + $7 : 9999)) / 1e8; } else { # Could not determine version, so we set it to 0 (oldest possible) $pprversion = 0; } # Get the data from the former queue if we reconfigure or copy a queue # do also some checking of the user-supplied parameters my ($rawqueue, $newfoomaticdata, $makemodel) = getoldqueuedata($config, $reconf); # Read out previous interface settings my $interface = ""; my $address = ""; my $options = ""; my $interface_options = ""; if ($reconf) { $interface = $entry->{'Interface'}; $address = $entry->{'Address'}; $interface_options = $entry->{'Options'}; if (($interface eq "foomatic-rip") || ($interface eq "ppromatic")) { if ($interface_options =~ /backend=(\S+)/) { $interface = $1; $interface_options =~ s/backend=(\S+)//; if ($interface_options =~ /^\s*$/) { $interface_options = ""; } } else { $interface = ""; } } } # All URIs ("-c" option) have the same syntax as URIs in CUPS ("-v" # option of "lpadmin"). if (defined($config->{'connect'})) { $interface_options =~ s/smbuser=(\S+)//; $interface_options =~ s/smbpassword=(\S+)//; if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)!) { # Local printer or printing to a file $address = $2; if ($config->{'connect'} =~ m!^usb://!) { # Queue with printer-bound USB URI transferred from CUPS, # as PPR does not support these URIs, translate it # back to a standard USB device URI $address = cups_usb_printer_uri_to_device_uri($address); } if (! -e $address) { warn "The device or file $address doesn't exist? " . "Working anyway.\n"; } if (($address =~ m!usb!) || ($address =~ m!USB!) || ($address =~ m!$sysdeps->{'ptal-pipes'}!) || ($address =~ m!/dev/ptal-printd!) || ($address =~ m!/var/run/ptal-printd!) || ($address =~ m!$sysdeps->{'mtink-pipes'}!) || ($address =~ m!/var/mtink!)) { $interface = "simple"; } elsif (($address =~ m!lp[0-9]!) || ($address =~ m!LP[0-9]!) || ($address =~ m!parallel!)) { $interface = "parallel"; } elsif (($address =~ m!tty!) || ($address =~ m!TTY!) || ($address =~ m!serial!)) { $interface = "serial"; } else { $interface = "dummy"; } $options = ""; } elsif ($config->{'connect'} =~ m!^ptal://?([^/].*)$!) { # HPOJ MLC protocol my $devname = $1; $devname =~ tr/:/_/; $address = "$sysdeps->{'ptal-pipes'}/$devname"; $interface = "simple"; $options = ""; } elsif ($config->{'connect'} =~ m!^mtink:/(.+)$!) { # Printing through "mtinkd" $address = "$sysdeps->{'mtink-pipes'}/$1"; $interface = "simple"; $options = ""; } elsif ($config->{'connect'} =~ m!^lpd://([^/]+)/([^/]+)$!) { # Remote LPD my $remhost = $1; my $remqueue = $2; $address = "${remqueue}\@${remhost}"; $interface = "lpr"; $options = ""; } elsif ($config->{'connect'} =~ m!^socket://([^/:]+):([0-9]+)/?$!) { # Socket (AppSocket/HP JetDirect) my $remhost = $1; my $remport = $2; $address = "$remhost:$remport"; $interface = "tcpip"; $options = ""; } elsif ($config->{'connect'} =~ m!^smb://(.*)$!) { # SMB (Printer on Windows server) my $parameters = $1; # Get the user's login and password from the URI my $smbuser = ""; my $smbpassword = ""; if ($parameters =~ m!([^@]*)@([^@]+)!) { my $login = $1; $parameters = $2; if ($login =~ m!([^:]*):([^:]*)!) { $smbuser = $1; $smbpassword = $2; } else { $smbuser = $login; $smbpassword = ""; } } else { $smbuser = "GUEST"; $smbpassword = ""; } # When a password is given, a user name should be given, too. if (($smbpassword ne "") && ($smbuser eq "")) { $smbuser = "GUEST"; } # The "smb" interface of PPR uses "ppr" as the SMB user when no # user name is given. Usually one does not have such a user name # under Windows. So use "GUEST" if no user name is given. if ($smbuser eq "") { $smbuser = "GUEST"; } # Set the options for PPR's "smb" interface $options = ""; if ($smbuser ne "") { $options = "smbuser=\"$smbuser\""; if ($smbpassword ne "") { $options .= " smbpassword=\"$smbpassword\""; } } # Get the workgroup, server, and share name my $workgroup = ""; my $smbserver = ""; my $smbshare = ""; if ($parameters =~ m!([^/]*)/([^/]+)/([^/]+)$!) { $workgroup = $1; $smbserver = $2; $smbshare = $3; } elsif ($parameters =~ m!([^/]+)/([^/]+)$!) { $workgroup = ""; $smbserver = $1; $smbshare = $2; } else { die "The \"smb://\" URI must at least contain the " . "server name and the share name!\n"; } $address = "//$smbserver/$smbshare"; $interface = "smb"; } else { die ("The URI \"$config->{'connect'}\" is not supported for " . "PPR or you have\nmistyped.\n"); } } elsif (!$reconf) { die "You must specify a connection with -c.\n"; } # Here we set up the command line for the "ppad interface" and the # "ppad options" commands my $ppad_interface = ""; my $ppad_options = ""; my $ppad_rip = ""; if ($rawqueue) { $ppad_interface = "$sysdeps->{'ppr-ppad'} interface " . "\"$config->{'queue'}\" $interface \"$address\""; $ppad_options = "$sysdeps->{'ppr-ppad'} options " . "\"$config->{'queue'}\" $options $interface_options"; $ppad_rip = "$sysdeps->{'ppr-ppad'} " . "rip \"$config->{'queue'}\""; } else { if ($pprversion >= 1.50000102 ) { #1.50a2 $ppad_interface = "$sysdeps->{'ppr-ppad'} interface " . "\"$config->{'queue'}\" $interface \"$address\""; $ppad_options = "$sysdeps->{'ppr-ppad'} options " . "\"$config->{'queue'}\" $options $interface_options"; if ($db->{'dat'}{'id'}) { $ppad_rip = "$sysdeps->{'ppr-ppad'} " . "rip \"$config->{'queue'}\" foomatic-rip x" . # PPR 1.50a2 has a bug and needs at least one option for # the command line of the PPR RIP, therefore we add the # "0" in this case. The number is very likely not the # name of any boolean option, so it will be ignored by # foomatic-rip (($pprversion < 1.50000103 ) ? " 0" : ""); } else { $ppad_rip = "$sysdeps->{'ppr-ppad'} " . "rip \"$config->{'queue'}\""; } } else { $ppad_interface = "$sysdeps->{'ppr-ppad'} interface " . "\"$config->{'queue'}\" foomatic-rip \"$address\""; $ppad_options = "$sysdeps->{'ppr-ppad'} options " . "\"$config->{'queue'}\" backend=\"$interface\" " . "$options $interface_options"; $ppad_rip = "$sysdeps->{'ppr-ppad'} " . "rip \"$config->{'queue'}\""; } } # Execute the ppad commands to set up the new queue if ((system $ppad_interface) || (system $ppad_options) || (system $ppad_rip)) { die "Could not set up/change the queue \"$config->{'queue'}\"!\n"; } # Use manufacturer and model as description when no description is # provided my($comment, $olddesc); if (defined($config->{'desc'})) { $comment = $config->{'desc'}; } else { # Before we overwrite the description field with manufacturer # and model, check if there is some old contents if (($reconf) && ($entry->{'Comment'})) { $olddesc = $entry->{'Comment'}; } if (!$olddesc) { if (!$rawqueue) { $comment = "$makemodel"; } else { $comment = "Raw queue"; } } } if ($comment) { my $ppad_comment = "$sysdeps->{'ppr-ppad'} comment " . "\"$config->{'queue'}\" \"$comment\""; if (system $ppad_comment) { warn "Could not set description for the queue " . "\"$config->{'queue'}\"!\n"; } } # Fill in the "location" field if something for it is provided. if (defined($config->{'loc'})) { my $ppad_location = "$sysdeps->{'ppr-ppad'} location " . "\"$config->{'queue'}\" \"$config->{'loc'}\""; if (system $ppad_location) { warn "Could not set location for the queue " . "\"$config->{'queue'}\"!\n"; } } # Various file setup mkdir $sysdeps->{'foo-etc'}, 0755; mkdir $sysdeps->{'foo-etc'} . '/ppr', 0755; # Generate/write the PPD file writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata); if ($rawqueue) { my $ppad_ppd = "$sysdeps->{'ppr-ppad'} ppd " . "\"$config->{'queue'}\" \"\" 2> /dev/null"; if (!system $ppad_ppd) { # Automatic input tray selection not activated by default, # because the feature requires manual choice of the paper types # in the trays and other spoolers than PPR do not have automatic # paper tray selection. In addition "ppop media " is # broken for printers with a high number of input trays in their # PPD files. #my $ppad_bins = "$sysdeps->{'ppr-ppad'} bins delete " . #"\"$config->{'queue'}\" \"" . #join ('" "', @{$entry->{'Bins'}}) . "\""; #if (system $ppad_bins) { #warn "Could not set paper input trays for the " . #"queue \"$config->{'queue'}\"!\n"; #} my $ppad_deffiltopts = "$sysdeps->{'ppr-ppad'} " . "deffiltopts \"$config->{'queue'}\" 2> /dev/null"; if (system $ppad_deffiltopts) { warn "Could not set \"DefFiltOpts\" entry for " . "the queue \"$config->{'queue'}\"!\n"; } } else { die "Could not set PPD for the queue \"$config->{'queue'}\"!\n"; } } else { my $ppad_ppd = "$sysdeps->{'ppr-ppad'} ppd " . "\"$config->{'queue'}\" \"$ppdfile\" 2> /dev/null"; if (!system $ppad_ppd) { # Automatic input tray selection not activated by default, # because the feature requires manual choice of the paper types # in the trays and other spoolers than PPR do not have automatic # paper tray selection. In addition "ppop media " is # broken for printers with a high number of input trays in their # PPD files. #my $ppad_bins = "$sysdeps->{'ppr-ppad'} bins ppd " . #"\"$config->{'queue'}\""; #if (system $ppad_bins) { #warn "Could not set paper input trays for the " . #"queue \"$config->{'queue'}\"!\n"; #} my $ppad_deffiltopts = "$sysdeps->{'ppr-ppad'} " . "deffiltopts \"$config->{'queue'}\" 2> /dev/null"; if (system $ppad_deffiltopts) { warn "Could not set \"DefFiltOpts\" entry for the " . "queue \"$config->{'queue'}\"!\n"; } } else { die "Could not set PPD for the queue \"$config->{'queue'}\"!\n"; } } if ($rawqueue) { # If we have a raw queue, delete the PPD file if there is still # one from a former queue. unlink "$ppdfile" if (-f "$ppdfile"); } else { # Clean up "Switchset" entry my @switchset = split('|', $entry->{'Switchset'}); my @newswitchset = (); for my $option (@switchset) { if (!(($option =~ /^F\s*\*([^\*\s=:]+)\s+([^\*\s=:]+)\s*$/) || ($option =~ /^F\s*([^\*\s=:]+)\s*=\s*([^\*\s=:]+)\s*$/) || ($option =~ /^F\s*\*([^\*\s=:]+)\s*$/) || ($option =~ /^F\s*([^\*\s=:]+)\s*$/))) { # The option is not a PPD option, keep it. # PPD options are incorporated in the PPD file now and so # they can be dropped in the "Switchset". if ($option =~ /^\s*(\S)(.*)$/) { push (@newswitchset, "-$1 \"$2\""); } } } my $ppad_switchset = "$sysdeps->{'ppr-ppad'} switchset " . "\"$config->{'queue'}\" " . join (' ', @newswitchset); if (system $ppad_switchset) { warn "Could not set switchset for the queue " . "\"$config->{'queue'}\"!\n"; } # Check, if there is a PJL option and set the "Jobbreak" to "none" # because otherwise there is a Ctrl+D between the PJL frame added # by foomatic-rip and the PostScript job. This breaks printing of # certain PS files as the CUPS test page. my $pjloption = 0; for my $arg (@{$db->{'dat'}->{'args'}}) { if ($arg->{'style'} eq "J") { $pjloption = 1; last; } } if ($pjloption) { my $ppad_jobbreak = "$sysdeps->{'ppr-ppad'} jobbreak " . "\"$config->{'queue'}\" none"; if (system $ppad_jobbreak) { warn "Could not set \"Jobbreak\" entry for the " . "queue \"$config->{'queue'}\"!\n"; } } } return 1; } sub default_ppr { my ($config) = $_[0]; # The default printer under PPR is the printer named "default". To be # able to easily switch the default printer we set up a printer group # named "default" containing the chosen default printer as its only # member. If there is already a printer called "default", we rename it. my $name = $config->{'queue'}; my $printrc = load_ppr_printers_conf(); my $printerfound = 0; for my $p (@{$printrc}) { if ($p->{'name'} eq $name) { $printerfound = 1; } # Rename a printer whose name is 'default' if ($p->{'name'} eq 'default') { # Search for a free name my $i = 0; my $namefound = 0; my $newname = ""; while(!$namefound) { my $pp; my $nameinuse = 0; for $pp (@{$printrc}) { if (defined($pp->{'name'})) { if ($pp->{'name'} eq "default$i") { $nameinuse = 1; $i++; last; } } } $namefound = 1 - $nameinuse; } $newname = "default$i"; # If the printer we want to use as default printer has the # name "default", we must use the new name as the member name # in the default group. if ($name eq "default") { $name = $newname; } # Do the renaming # Copy the queue ... if (system("foomatic-configure -s ppr -n $newname -C default")){ die "Could not copy the queue \"default\" into the " . "queue \"$newname\"!\n"; } # ... and remove the original one if (system("foomatic-configure -s ppr -n default -R")) { die "Could not remove the queue \"default\"!\n"; } warn "Renamed the printer\"default\" to \"$newname\"!\n"; } } # The desired default printer exists? Then make it the default if ($printerfound) { # Create a group named "default" with only this printer as member my $ppad_group = "$sysdeps->{'ppr-ppad'} group members " . "default \"$name\""; if (system $ppad_group) { warn "Could not create a group to make the queue \"$name\" " . "the default!\n"; } } } sub delete_ppr { my ($config) = $_[0]; # This line deletes the old printer queue my $queuedeleteline = "$sysdeps->{'ppr-ppad'} delete " . "\"$config->{'queue'}\""; # Do it! system $queuedeleteline and die "Unable to delete queue \"$config->{'queue'}\"!\n"; # Rename the PPD file # PPD file name my $ppdfile = sprintf('%s/ppr/%s.ppd', $sysdeps->{'foo-etc'}, $config->{'queue'}); # Rename old $ppdfile, if any rename "$ppdfile", "$ppdfile.old" if (-f "$ppdfile"); return 1; } sub query_ppr { my ($config) = @_; # User requests data of a printer/driver combo to see the options before # installing a queue if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) && ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) { if ($opt_n) { my $olddatablob = load_ppr_datablob($opt_n); print_perl_combo_data($config, $olddatablob); } else { print_perl_combo_data($config); } return; } my $i = $ARGV[0]; if (!defined($i)) {$i = 0;} my $pconf = load_ppr_printers_conf(); if (defined($opt_r)) {$opt_r = undef;} my $p; if (!$opt_P) { print "\n"; } # Query the default printer my $default; if (!defined($config->{'queue'})) { for $p (@{$pconf}) { if ($p->{'default'}) { $default = $p->{'name'}; if (!$opt_P) { print "$p->{'name'}\n"; } last; } } } for $p (@{$pconf}) { # were we invoked for only one queue? next if (defined($config->{'queue'}) and $config->{'queue'} ne $p->{'name'}); # load the queue data $db->{'dat'} = load_ppr_datablob($p->{'name'}); # extract the queue data block my $c = $db->{'dat'}{'queuedata'}; if ($opt_P) { if ($p->{'name'} eq $default) { $db->{'dat'}{'queuedata'}{'default'} = 1; } else { $db->{'dat'}{'queuedata'}{'default'} = 0; } $db->{'dat'}{'queuedata'}{'remote'} = 0; my $asciidata = $db->getascii(); $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g; print $asciidata; $i ++; } else { # and get it to standard output dump_config($c); } } if (!$opt_P) { print "\n"; } return; } ### Queue manipulation functions for direct, spooler-less printing sub setup_direct { my ($config) = $_[0]; # Read the previous config file my $pconfig = load_direct_config(); my ($entry, $reconf, $p); for $p (@{$pconfig}) { if ($p->{'name'} eq $config->{'queue'}) { $entry = $p; $reconf = 1; last; use Data::Dumper; print "Reconfigure of ", Dumper($p); } } # PPD file name my $ppdfile = sprintf('%s/direct/%s.ppd', $sysdeps->{'foo-etc'}, $config->{'queue'}); # Get the data from the former queue if we reconfigure or copy a queue # do also some checking of the user-supplied parameters my ($rawqueue, $newfoomaticdata, $makemodel) = getoldqueuedata($config, $reconf); # Set the printer queue name $entry->{'name'} = $config->{'queue'}; # Use manufacturer and model as description when no description is # provided if (defined($config->{'desc'})) { $entry->{'desc'} = $config->{'desc'}; } else { # Before we overwrite the description field with manufacturer # and model, check if there is some old contents my( $olddesc ); if (($reconf) && ($entry->{'desc'})) { $olddesc = $entry->{'desc'}; } if (!$olddesc) { $entry->{'desc'} = "$makemodel"; } } # Fill in the "location" field if something for it is provided. if (defined($config->{'loc'})) { $entry->{'loc'} = $config->{'loc'}; } # If the printing jobs should not be passed to standard output, put the # command line into $postpipe (for example for Socket, Samba, parallel # port ...) my $postpipe = ""; if ((!$reconf) or ($config->{'connect'})) { # Set up connection type # All URIs ("-c" option) have the same syntax as URIs in CUPS ("-v" # option of "lpadmin"). if ($config->{'connect'} =~ m!^(file|usb|parallel|serial):(.*)!) { # Local printer or printing to a file my $file = $2; if ($config->{'connect'} =~ m!^usb://!) { # Queue with printer-bound USB URI transferred from CUPS, # as spooler-less printing does not support these URIs, # translate it back to a standard USB device URI $file = cups_usb_printer_uri_to_device_uri($file); } if (! -e $file) { warn "The device or file $file doesn't exist? " . "Working anyway.\n"; } if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) || ($file =~ m!^/dev/ptal-printd/(.+)$!) || ($file =~ m!^/var/run/ptal-printd/(.+)$!)) { # Translate URI for ptal-printd to postpipe using the # "ptal-connect" command my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $postpipe = "$sysdeps->{'ptal-connect'} $devname -print"; } else { $postpipe = "$sysdeps->{'cat'} > $file"; } } elsif ($config->{'connect'} =~ m!^ptal://?([^/].*)$!) { # HPOJ MLC protocol my $devname = $1; $postpipe = "$sysdeps->{'ptal-connect'} $devname -print"; } elsif ($config->{'connect'} =~ m!^mtink:/(.+)$!) { # Printing through "mtinkd" $postpipe = "$sysdeps->{'cat'} > $sysdeps->{'mtink-pipes'}/$1"; } elsif ($config->{'connect'} =~ m!^lpd://([^/]+)/([^/]+)$!) { # Remote LPD my $remhost = $1; my $remqueue = $2; $postpipe = "$sysdeps->{'rlpr'} -q -h -P $remqueue\@$remhost"; } elsif ($config->{'connect'} =~ m!^socket://([^/:]+):([0-9]+)/?$!){ # Socket (AppSocket/HP JetDirect) my $remhost = $1; my $remport = $2; $postpipe = "$sysdeps->{'nc'} -w 1 $remhost $remport"; } elsif ($config->{'connect'} =~ m!^smb://(.*)$!) { # SMB (Printer on Windows server) my $parameters = $1; # Get the user's login and password from the URI my $smbuser = ""; my $smbpassword = ""; if ($parameters =~ m!([^@]*)@([^@]+)!) { my $login = $1; $parameters = $2; if ($login =~ m!([^:]*):([^:]*)!) { $smbuser = $1; $smbpassword = $2; } else { $smbuser = $login; $smbpassword = ""; } } else { $smbuser = "GUEST"; $smbpassword = ""; } # Get the workgroup, server, and share name my $workgroup = ""; my $smbserver = ""; my $smbshare = ""; if ($parameters =~ m!([^/]*)/([^/]+)/([^/]+)$!) { $workgroup = $1; $smbserver = $2; $smbshare = $3; } elsif ($parameters =~ m!([^/]+)/([^/]+)$!) { $workgroup = ""; $smbserver = $1; $smbshare = $2; } else { die "The \"smb://\" URI must at least contain the " . "server name and the share name!\n"; } # Set up the command line for printing on the SMB server $postpipe = "$sysdeps->{'smbclient'} \"//$smbserver/$smbshare\""; if ($smbpassword ne "") { warn("WARNING: smbclient password is visible in PPD file\n"); $postpipe .= " $smbpassword"; } if ($smbuser ne "") {$postpipe .= " -U $smbuser";} if ($workgroup ne "") {$postpipe .= " -W $workgroup";} $postpipe .= " -N -P -c 'print -' "; } elsif ($config->{'connect'} =~ m!^ncp://(.*)$!) { my $parameters = $1; # Get the user's login and password from the URI my $ncpuser = ""; my $ncppassword = ""; if ($parameters =~ m!([^@]*)@([^@]+)!) { my $login = $1; $parameters = $2; if ($login =~ m!([^:]*):([^:]*)!) { $ncpuser = $1; $ncppassword = $2; } else { $ncpuser = $login; $ncppassword = ""; } } else { $ncpuser = ""; $ncppassword = ""; } # Get the server and share name my $ncpserver = ""; my $ncpqueue = ""; if ($parameters =~ m!([^/]+)/([^/]+)$!) { $ncpserver = $1; $ncpqueue = $2; } else { die "The \"ncp://\" URI must at least contain the server " . "name and the queue name!\n"; } # Set up the command line for printing on the Netware server $postpipe = "$sysdeps->{'nprint'} -S $ncpserver"; if ($ncpuser ne "") { $postpipe .= " -U $ncpuser"; if ($ncppassword ne "") { warn("WARNING: ncp password is visible in PPD file\n"); $postpipe .= " -P $ncppassword"; } else { $postpipe .= " -n"; } } $postpipe .= " -q $ncpqueue -N - 2>/dev/null"; } elsif ($config->{'connect'} =~ m!^postpipe:(.*)$!) { # Pipe output into a command $postpipe = $1; } elsif ($config->{'connect'} =~ m!^stdout!) { $postpipe = ""; } elsif ($config->{'connect'}) { die ("The URI \"$config->{'connect'}\" is not supported for " . "spooler-less printing or you have\nmistyped.\n"); } else { die "You must specify a connection with -c.\n"; } # Put $postpipe into the data structure, so that it will be # inserted into the PPD file if ($postpipe ne "") { $postpipe = "| $postpipe"; $db->{'dat'}{'postpipe'} = $postpipe; } else { undef $db->{'dat'}{'postpipe'}; } } else { # Keep previous connection type # Use previous $postpipe if (defined($db->{'dat'}{'postpipe'})) { $postpipe = $db->{'dat'}{'postpipe'}; } } # Various file setup mkdir $sysdeps->{'foo-etc'}, 0755; mkdir $sysdeps->{'foo-etc'} . "/direct", 0755; # Add to the config file if a new entry if (!$reconf) { push(@{$pconfig}, $entry); } # Generate/write the PPD file writeppdfile($config, $ppdfile, $rawqueue, $newfoomaticdata); # Write back /etc/foomatic/direct/.config my $pconfigname = $sysdeps->{'direct-config'}; rename $pconfigname, "$pconfigname.old"; open PCONFIG, "> $pconfigname" or die "Cannot write $pconfigname!\n"; print PCONFIG dump_direct_config($pconfig); close PCONFIG; chmod 0644, $pconfigname; return 1; } sub default_direct { my ($config) = $_[0]; my $name = $config->{'queue'}; my $pconfig = load_direct_config(); # Modify the "default" fields of the printers appropriately for (@{$pconfig}) { $_->{'default'} = ($_->{'name'} eq $name); } my @newpconfig = dump_direct_config($pconfig); my $pconfigname = $sysdeps->{'direct-config'}; rename $pconfigname, "$pconfigname.old"; open PCONFIG, "> $pconfigname" or die "Cannot write $pconfigname!\n"; print PCONFIG @newpconfig; close PCONFIG; chmod 0644, $pconfigname; return 1; } sub delete_direct { my ($config) = $_[0]; my $name = $config->{'queue'}; my $pconfig = load_direct_config(); # Overtake all entries except the one of the deleted printer to the # new config file my @newconf; for (@{$pconfig}) { push (@newconf, $_) unless ($_->{'name'} eq $name); } my @newpconfig = dump_direct_config(\@newconf); my $pconfigname = $sysdeps->{'direct-config'}; rename $pconfigname, "$pconfigname.old"; open PCONFIG, "> $pconfigname" or die "Cannot write $pconfigname!\n"; print PCONFIG @newpconfig; close PCONFIG; chmod 0644, $pconfigname; # PPD file name my $ppdfile = sprintf('%s/direct/%s.ppd', $sysdeps->{'foo-etc'}, $config->{'queue'}); # Rename old $ppdfile, if any rename $ppdfile, "$ppdfile.old" if (-f $ppdfile); return 1; } sub query_direct { my ($config) = @_; # User requests data of a printer/driver combo to see the options before # installing a queue if (($opt_P) && ((($config->{'driver'}) && ($config->{'printer'}) && ($config->{'driver'} ne "raw")) || ($config->{'ppdfile'}))) { if ($opt_n) { my $olddatablob = load_direct_datablob($opt_n); print_perl_combo_data($config, $olddatablob); } else { print_perl_combo_data($config); } return; } my $i = $ARGV[0]; if (!defined($i)) {$i = 0;} my $pconf = load_direct_config(); if (defined($opt_r)) {$opt_r = undef;} my $p; if (!$opt_P) { print "\n"; } # Query the default printer my $default; if (!defined($config->{'queue'})) { for $p (@{$pconf}) { if ($p->{'default'}) { $default = $p->{'name'}; if (!$opt_P) { print "$p->{'name'}\n"; } last; } } } for $p (@{$pconf}) { # were we invoked for only one queue? next if (defined($config->{'queue'}) and $config->{'queue'} ne $p->{'name'}); # load the queue data $db->{'dat'} = load_direct_datablob($p->{'name'}); # extract the queue data block my $c = $db->{'dat'}{'queuedata'}; if ($opt_P) { if ($p->{'name'} eq $default) { $db->{'dat'}{'queuedata'}{'default'} = 1; } else { $db->{'dat'}{'queuedata'}{'default'} = 0; } $db->{'dat'}{'queuedata'}{'remote'} = 0; my $asciidata = $db->getascii(); $asciidata =~ s/\$VAR1/\$QUEUES[$i]/g; print $asciidata; $i ++; } else { # and get it to standard output dump_config($c); } } if (!$opt_P) { print "\n"; } return; } ### Functions used by the queue manipulation functions from above sub dump_config { my $c = $_[0]; print sprintf("\n", ($c->{'foomatic'} ? 1 : 0), $c->{'spooler'}), _tag('name',$c->{'queue'}), _tag('printer',$c->{'printer'}), _tag('driver',$c->{'driver'}), _tag('connect',$c->{'connect'}), _tag('location',$c->{'loc'}), _tag('description',$c->{'desc'}), ($c->{'spooler'} eq "cups" ? (_tag('dontdisable',$c->{'dd'}), _tag('attempts',$c->{'att'}), _tag('delay',$c->{'delay'}), (defined($c->{'quotaperiod'}) ? _tag('quotaperiod',$c->{'quotaperiod'}) : ()), (defined($c->{'pagelimit'}) ? _tag('pagelimit',$c->{'pagelimit'}) : ()), (defined($c->{'klimit'}) ? _tag('klimit',$c->{'klimit'}) : ()), (defined($c->{'laststatechange'}) ? _tag('laststatechange',$c->{'laststatechange'}) : ()), (defined($c->{'shared'}) ? _tag('shared',$c->{'shared'}) : ()), (defined($c->{'operationpolicy'}) ? _tag('operationpolicy',$c->{'operationpolicy'}) : ()), (defined($c->{'errorpolicy'}) ? _tag('errorpolicy',$c->{'errorpolicy'}) : ())) : ()), "\n"; return; } sub _tag { my ($t, $v) = @_; return '' if !defined($v); $v =~ s!\&!\&\;!g; $v =~ s!\$v\n"; } sub dump_lpd_printcap { my ($config, $pcap )= @_; my @retval; my $item; my $backslash = "\\"; $backslash = "" if $config->{'spooler'} eq 'lprng'; for $item (@{$pcap}) { for (@{$item->{'comments'}}) { push (@retval, "$_\n"); } if (defined($item->{'names'})) { map { $_ = '' if not defined $_; } @{$item->{'names'}}; push (@retval, (join('|', @{$item->{'names'}}) . ":${backslash}\n")); } for (keys(%{$item->{'str'}})) { # special case of 'tc' items, as there can be more than one if ($_ =~ /^tc\d+$/) { push (@retval, sprintf(" :tc=%s:${backslash}\n", $item->{'str'}{$_})); } else { push (@retval, sprintf(" :$_=%s:${backslash}\n", $item->{'str'}{$_})); } } for (keys(%{$item->{'bool'}})) { if ($item->{'bool'}{$_}) { push (@retval, " :$_:${backslash}\n"); } } for (keys(%{$item->{'num'}})) { push (@retval, sprintf(" :$_#%s:${backslash}\n", $item->{'num'}{$_})); } if( $backslash ){ my $lastline = pop(@retval); $lastline =~ s!:\\!:!; push (@retval, $lastline); } } print "PRINTCAP (spooler '" . $config->{'spooler'} . "') " . Dumper(\@retval) . "\n" if $debug; return @retval; } sub load_lpd_printcap { # list-o-printers, each with comments open PCAP, $sysdeps->{'lpd-pcap'} or die "Cannot read printcap file!\n"; my $pcap = join('', ); close PCAP; print "PC '$pcap'\n" if $debug; # die( "Cannot currently parse lprng style printcaps created by " . # "lprngtool!\n" . # "See the BUGS section in the manpage for details.\n") # if $pcap =~ m/\n\s*(:.*[^\\]\n\s*:)/m; # watch out for comments with \ at end of line - ignore \ $pcap =~ s!^(\s*\#.*\\)$!${1}MEMEMEM!gm; # now we join lines with \ at end $pcap =~ s!\\\n!!gms; # remove \ in comment lines $pcap =~ s!\\MEMEMEM!\\!g; print "AFTER '$pcap'\n" if $debug; my (@comment, @items, @comments_in_pc_entry); my ($pline, $pcentry); $pcentry = ""; for $pline (split('\n',$pcap)) { $pline =~ s/^\s+//; print "LINE '$pline', pcentry '$pcentry'\n" if $debug; next if $pline eq ""; if ($pline =~ m!^\#!) { if( $pcentry ){ push (@comments_in_pc_entry, $pline); } else { push (@comment, $pline); } } elsif ($pline =~ m!^:!) { push( @comment, @comments_in_pc_entry ); @comments_in_pc_entry = (); if( $pcentry ne "" ){ $pcentry .= $pline; } else { die( "bad printcap entry at '$pline'" ); } } elsif( $pcentry ne "" ){ push (@items, { 'itemstr' => $pcentry, 'comments' => [ @comment ] }); @comment = @comments_in_pc_entry; @comments_in_pc_entry = (); $pcentry = $pline; } else { $pcentry = $pline; } } if( $pcentry ){ push( @comment, @comments_in_pc_entry ); @comments_in_pc_entry = (); push (@items, { 'itemstr' => $pcentry, 'comments' => [ @comment ] }); @comment = (); } # Trailing comments get stuck on as empty item later... print "Printcap:\n" . Dumper(\@items ) if $debug; my $p; for $p (@items) { my $item; my $first = 1; my $tci = 0; for $item (split(/:\s*/, $p->{'itemstr'})) { next if $item =~ m!^\s*$!; if ($first) { my $name; for $name (split('\|',$item)) { $name =~ s!\s*(.+)\s*!$1!; push (@{$p->{'names'}}, $name); } $first = 0; } else { if ($item =~ m!^([^=]*)=(.+)!) { # special case of 'tc' items, as there can be more # than one if ($1 eq 'tc') { $p->{'str'}{"tc$tci"} = $2; $tci++; } else { $p->{'str'}{$1} = $2; } } elsif ($item =~ m!^([^\#]*)\#(.+)!) { $p->{'num'}{$1} = $2; } elsif ($item =~ m!^([^\@]*)\@?!) { $p->{'bool'}{$1} = 1; } } } } # Trailing comments from way above... if (scalar(@comment)) { push (@items, {'comments' => [ @comment ]}); } return \@items; } sub load_cups_printersconf { # list-o-printers my @items = (); my $itemshash = {}; if ($< == 0) { # Get info from /etc/cups/printers.conf, works only as "root" and # with locally defined printers my @pconf = (); if (open PCONF, $sysdeps->{'cups-pconf'}) { @pconf = ; close PCONF; } my $line; my $p = {}; my $linecount = 0; for $line (@pconf) { $linecount ++; if (!($line =~ m!^\s*\#!) && (!($line =~ m!^\s*$!))) { if ($line =~ m!^\s*<(.*)Printer\s+([^\s>]+)>\s*$!) { # Beginning of new block $p->{'name'} = $2; $p->{'default'} = ($1 eq "Default"); } elsif ($line =~ m!^\s*\s*$!) { # End of block push (@items, $p); $itemshash->{$p->{name}} = $#items; $p = {}; } elsif (defined($p->{'name'})) { # Inside block if (($line =~ m!^\s*(\S+)\s+(\S.*)$!) and ($1 ne '')) {$p->{$1} = $2}; } else { # Outside block die "Line $linecount in $sysdeps->{'cups-pconf'} " . "invalid!\n"; } } } } if (($< != 0) || (($opt_r) && (($opt_Q) || ($opt_P)))) { # Get info with the "lpstat" command, works for normal users and for # remote printers. open LPSTAT, "$sysdeps->{'cups-lpstat'} -l -d -p -v |" or die "Cannot execute \"lpstat\".\n"; my @lpstat = ; close LPSTAT; my $line; my $linecount = 0; my $defaultprinter = ''; my $currentitem = -1; for $line (@lpstat) { chomp ($line); $linecount ++; if (!($line =~ m!^\s*$!)) { if ($line =~ m!^\s*system\s+default\s+destination:\s+(\S+)\s*$!) { # Default printer $defaultprinter = $1; } elsif ($line =~ m!^printer\s+(\S+)\s+(\S.*)$!) { # Beginning of new printer's entry my $name = $1; my $state = $2; $state =~ s/\s+-$//; if (!defined($itemshash->{$name})) { push(@items, {}); $itemshash->{$name} = $#items; # If we are root and didn't see this entry # in /etc/cups/printers.conf, this printer # is remotely defined if ($< == 0) { $items[$itemshash->{$name}]{'remote'} = 1; } } $currentitem = $itemshash->{$name}; $items[$currentitem]{'name'} ||= $name; $items[$currentitem]{'State'} ||= $state; $items[$currentitem]{'default'} = ($name eq $defaultprinter); } elsif ($line =~ m!^\s+Description:\s+(\S.*)$!) { # Description field if ($currentitem != -1) { $items[$currentitem]{'Info'} ||= $1; } } elsif ($line =~ m!^\s+Location:\s+(\S.*)$!) { # Location field if ($currentitem != -1) { $items[$currentitem]{'Location'} ||= $1; } } elsif ($line =~ m!^\s+Connection:\s+remote!) { # Remote printer, only keep it when the "-r" option is # given if (!$opt_r) { # "delete" does not work on arrays with Perl 5.0.x # Thanks to Olaf Till (i7tiol@t-online.de) who # contributed this fix splice(@items, $currentitem, 1); #delete($items[$currentitem]); $currentitem = -1; } else { if ($currentitem != -1) { $items[$currentitem]{'remote'} = 1; } } } elsif ($line =~ m!^device\s+for\s+(\S+):\s+(\S.*)$!) { # "device for ..." line, extract URI my $name = $1; my $uri = $2; if (defined($itemshash->{$name})) { if ($uri !~ /:/) {$uri = "file:" . $uri}; $currentitem = $itemshash->{$name}; if (($currentitem <= $#items) && ($items[$currentitem]{'name'} eq $name)) { $items[$currentitem]{'DeviceURI'} ||= $uri; } } } } } } return \@items; } sub dump_pdq_printrc { my $printrc = $_[0]; my @retval; my $item; for $item (@{$printrc}) { if (defined($item->{'name'})) { # $item is a "printer" block push (@retval, "printer \"$item->{'name'}\" \{\n"); for my $key (keys(%{$item})) { if (($key ne 'name') && ($key ne 'others')) { push (@retval, "\t$key $item->{$key}\n"); } } push (@retval, "\}\n"); } elsif (defined($item->{'others'})) { # $item is not a "printer" block push (@retval, $item->{'others'}); } } # Check whether there is a already a 'try_include "/etc/foomatic/pdq/*"' # line in the config file if (!(join("", @retval) =~ m!^\s*try_include\s*\"$sysdeps->{'foo-etc'}/pdq/driverdescr/\*\"\s*$!m)) { splice(@retval,0,0,"# Line inserted by $progname\ntry_include " . "\"$sysdeps->{'foo-etc'}/pdq/driverdescr/*\"\n\n"); } # De-activate old line from Foomatic 2.0.x ($_ =~ s!^\s*try_include\s*\"$sysdeps->{'foo-etc'}/pdq/\*\"\s*$!\#$&!m) foreach @retval; return @retval; } sub load_pdq_printrc { # list-o-printers, with storage of non-printer-specific lines open PRINTRC, $sysdeps->{'pdq-printrc'} or die "Cannot read printrc file!\n"; my @printrc = ; close PRINTRC; my @items; my @others; my $line; my $p; my $linecount = 0; my $inprinterblock = 0; my $nonprinterlines = 0; for $line (@printrc) { $linecount ++; if ($line =~ m!^\s*printer\s+\"(.+)\"\s*{\s*$!) { if ($inprinterblock == 1) { die "New printer block started without previous one " . "being closed!\nLine $linecount in " . "$sysdeps->{'pdq-printrc'}.\n"; } # Beginning of new "printer" block # Store all non-printer-block stuff at first if ($nonprinterlines == 1) { push (@items, {'others' => join ("", @others )}); $nonprinterlines = 0; @others = (); } # Read printer block name $inprinterblock = 1; $p->{'name'} = $1; } elsif ($inprinterblock == 1) { # Inside "printer" block if ($line =~ m!^\s*}\s*$!) { # End of "printer" block $inprinterblock = 0; push (@items, $p); $p = {}; } elsif ($line =~ m!^\s*(\S+)\s*(\S+.*)$!) { $p->{$1} = $2; } elsif ((!($line =~ m!^\s*\#!)) && (!($line =~ m!^\s*$!))) { die "Line $linecount in $sysdeps->{'pdq-printrc'} " . "invalid!\n"; } } else { # Outside "printer" block push(@others, $line); $nonprinterlines = 1; } } # Trailing non-printer lines get stuck on as empty item if ($nonprinterlines == 1) { my $lines = join ("", @others); # Make sure that the last line line ends with a newline character if (!($lines =~ m!\n$!s)) {$lines .= "\n";} push (@items, {'others' => $lines}); } return \@items; } sub load_ppr_printers_conf { # Check whether there is a group named "default" to see what is the # default printer. my $defaultfromgroup = " "; if (open SHOWDEFAULTGROUP, "$sysdeps->{'ppr-ppad'} group show default 2>/dev/null |"){ for my $line () { chomp $line; if ($line =~ /\s*Members:\s*([^\s,]+)\s*$/) { $defaultfromgroup = $1; last; } } close SHOWDEFAULTGROUP; } # list-o-printers my @items = (); my $itemshash = {}; if ($< == 0) { # Get info from /etc/ppr/printers/, works only as # "root" opendir PCONFDIR, "$sysdeps->{'ppr-etc'}/printers" or die "Cannot read $sysdeps->{'ppr-etc'}/printers directory!\n"; my $name; while ($name = readdir(PCONFDIR)) { # Do not consider "." and ".." as a printer queue next if ($name =~ /^\./); my $line; my $p = {}; $p->{'name'} = $name; $p->{'default'} = (($name eq "default") || ($name eq $defaultfromgroup)); @{$p->{'Bins'}} = (); my $linecount = 0; open PCONFFILE, "$sysdeps->{'ppr-etc'}/printers/$name" or die "Cannot read $sysdeps->{'ppr-etc'}/printers/$name!\n"; for my $line () { chomp $line; $linecount ++; if (!($line =~ m!^\s*\#!) && (!($line =~ m!^\s*$!))) { if (($line =~ m!^\s*([^\s:]+)\s*:\s*(\S.*)$!) || ($line =~ m!^\s*([^\s:]+)\s*:\s*()$!)) { # : ... my $keyword = $1; my $values = $2; if (($values) && ($values ne "")) { # If the value is enclosed in double quotes, # remove the quotes $values =~ s/^\"(.*)\"$/$1/; if ($keyword eq "Bin") { push (@{$p->{'Bins'}}, $values); } else { $p->{$keyword} = $values; } } } else { warn "Line $linecount in " . "$sysdeps->{'ppr-etc'}/printers/$name " . "corrupted:\n $line\n"; } } } close PCONFFILE; push (@items, $p); $itemshash->{$p->{'name'}} = $#items; } } if ($< != 0) { # Get info with the "ppop"/"ppad" commands, works for normal users, # but needs installed and running PPR printing system open PPOP_DEST, "$sysdeps->{'ppr-ppop'} destination all |" or die "Cannot execute \"ppop\".\n"; my @ppop_dest = ; close PPOP_DEST; my $line; my $linecount = 0; my $currentitem = -1; for $line (@ppop_dest) { chomp ($line); $linecount ++; if (($line !~ m!^\s*-+\s*$!) && ($line !~ m!^\s*Destination\s+Type\s+Status\s+Charge\s*$!)){ if ($line =~ m!^\s*(\S+)\s+printer!) { my $name = $1; open PPAD_SHOW,"$sysdeps->{'ppr-ppad'} show $name |" or die "Cannot execute \"ppad\".\n"; my $lcount = 0; if (!defined($itemshash->{$name})) { push(@items, {}); $itemshash->{$name} = $#items; #print Dumper($itemshash); } $currentitem = $itemshash->{$name}; $items[$currentitem]{'name'} ||= $name; $items[$currentitem]{'default'} = (($name eq "default") || ($name eq $defaultfromgroup)); for my $line () { chomp $line; $lcount ++; if ((!($line =~ m!^\s*\#!)) && (!($line =~ m!^\s*$!))) { if ($line =~ m!^\s*([^\s:][^:]*)\s*:\s*(.*)$!) { # : ... my $keyword = $1; my $values = $2; if (($values) && ($values ne "")) { # If the value is enclosed in double # quotes, remove the quotes $values =~ s/^\"(.*)\"$/$1/; if ($keyword eq "Bins") { @{$items[$currentitem]{'Bins'}} = split(", ", $values); } else { if ($keyword eq "Switchset") { $values =~ s/ -(\S) /\|$1/g; $values =~ s/-(\S) /$1/g; $values =~ s/\'//g; $values =~ s/^|//g; } $items[$currentitem]{$keyword} = $values; } } } else { warn "Line $lcount in \"ppad show " . "$name\" corrupted:\n $line\n"; } } } close PPAD_SHOW; } } } } return \@items; } sub dump_direct_config { my $config = $_[0]; my @retval; my $defaultprinter = undef; my $item; for $item (@{$config}) { if (defined($item->{'name'})) { if (defined($item->{'desc'})) { push (@retval, "$item->{'name'} desc:$item->{'desc'}\n"); } if (defined($item->{'loc'})) { push (@retval, "$item->{'name'} loc:$item->{'loc'}\n"); } if ($item->{'default'}) { $defaultprinter = $item->{'name'}; } } } if (defined($defaultprinter)) { unshift(@retval, "default: $defaultprinter\n"); } return @retval; } sub load_direct_config { # list-o-printers my @items = (); my $itemshash = {}; # Configured printers are represented by PPD files in /etc/foomatic/ opendir PCONFDIR, "$sysdeps->{'foo-etc'}/direct" or die "Cannot read $sysdeps->{'foo-etc'}/direct directory!\n"; my $name; while ($name = readdir(PCONFDIR)) { # Files beginning with a dot or ending with a tilde are never # printers next if (($name =~ /^\./) || ($name =~ /~$/)); # Only ".ppd" files are printer descriptions. next unless ($name =~ /\.ppd$/i); $name =~ s/\.ppd$//i; # Do not make two entries when there is both a ".ppd" AND ".PPD" # file for the same printer name. next if (defined($itemshash->{$name})); my $p = {}; $p->{'name'} = $name; push (@items, $p); $itemshash->{$p->{'name'}} = $#items; } # Get additional info from /etc/foomatic/direct/.config (default # printer, description, location if (open CONFIG, "< $sysdeps->{'direct-config'}") { while (my $line = ) { chomp $line; if ($line =~ /^default\s*:\s*([^:\s]+)\s*$/) { my $currentitem = $itemshash->{$1}; $items[$currentitem]{'default'} = 1; } elsif ($line =~ /^\s*([^:\s]+)\s+([^:\s]+)\s*:(.*)$/) { my $currentitem = $itemshash->{$1}; $items[$currentitem]{$2} = $3; } } close CONFIG; } return \@items; } sub cups_correct_ptal_uri { # HPOJ 0.9 uses "ptal:..." URIs with one slash # ("ptal:/mlc:usb:dj450") and the current CVS of HPOJ uses two # slashes ("ptal://mlc:usb:dj450"). Correct the user-supplied URI # according to what "lpinfo -v" reports. my ($uri) = @_; $uri =~ m!^ptal://?([^/].*)$!; my $device = $1; # PTAL URIs listed by "lpinfo -v" open F, "$sysdeps->{'cups-lpinfo'} -v |" or return (@_); while (my $line = ) { chomp($line); my $d = quotemeta($device); if ($line =~ m!(ptal://?$d)$!) { my $realdevice = $1; close F; return $realdevice; } } close F; # Nothing found, do not correct the input return @_; } sub cups_generate_usb_device_lists { # Generate two lists: One of the actual USB device files in the # file system, another of the USB URIs listed by CUPS' "lpinfo -v" # Actual devices my @usbdevices; for my $pattern ("/dev/usb/lp*", "/dev/usb/usblp*") { open F, "ls -1 $pattern 2>/dev/null |" or next; @usbdevices = sort { Foomatic::DB::normalizename($a) cmp Foomatic::DB::normalizename($b) } grep { chomp } ; close F; last if $#usbdevices >= 0; } return ([], []) if $#usbdevices < 0; # USB URIs listed by "lpinfo -v" open F, "$sysdeps->{'cups-lpinfo'} -v |" or return ([], []); my @usburis = grep { s!^direct usb:!! and chomp } ; close F; return ([], []) if $#usburis < 0; # Results return (\@usbdevices, \@usburis); } sub cups_usb_device_uri_to_printer_uri { # Transfer a device file name into a printer-bound CUPS URI for # the printer currently connected my ($device) = @_; return $device if $device =~ m!^//!; my @devicelists = cups_generate_usb_device_lists(); return $device if (($#{$devicelists[0]} < 0) || ($#{$devicelists[1]} < 0)); for (my $i = 0; $i <= $#{$devicelists[0]}; $i ++) { last if !$devicelists[1][$i]; if ($device eq $devicelists[0][$i]) { return $devicelists[1][$i]; } } return $device; } sub cups_usb_printer_uri_to_device_uri { # Transfer a device file name into a printer-bound CUPS URI for # the printer currently connected my ($device) = @_; return $device if $device =~ m!^/[^/]!; $device =~ s/ /\%20/g; my @devicelists = cups_generate_usb_device_lists(); return $device if (($#{$devicelists[0]} < 0) || ($#{$devicelists[1]} < 0)); for (my $i = 0; $i <= $#{$devicelists[1]}; $i ++) { last if !$devicelists[0][$i]; if ($device eq $devicelists[1][$i]) { return $devicelists[0][$i]; } } return $device; } sub load_datablob { my ($spooler, $queue) = @_; my $spoolersubdir; my $datablob; if (($spooler eq "lpd") || ($spooler eq "lprng")) { $datablob = load_lpd_datablob($queue); $spoolersubdir = 'lpd'; } elsif ($spooler eq "cups") { $datablob = load_cups_datablob($queue); $spoolersubdir = 'cups'; } elsif ($spooler eq "pdq") { $datablob = load_pdq_datablob($queue); $spoolersubdir = 'pdq'; } elsif ($spooler eq "ppr") { $datablob = load_ppr_datablob($queue); $spoolersubdir = 'ppr'; } elsif ($spooler eq "direct") { $datablob = load_direct_datablob($queue); $spoolersubdir = 'direct'; } else { die "Unsupported spooler: $spooler\n"; } # Is the given queue a valid queue? if (!$datablob) { return undef; } return ($datablob); } sub load_lpd_datablob { my ($queue) = $_[0]; # Load the PPD file my $ppdfile = sprintf('%s/lpd/%s.ppd', $sysdeps->{'foo-etc'}, $queue); my $dat = ppdtoperl($ppdfile); if (defined($dat)) { $dat->{'ppdfile'} = $ppdfile; } my $postpipe = (defined($dat) ? $dat->{'postpipe'} : ""); # Get additional info from /etc/printcap my $pcap = load_lpd_printcap(); my $p; for $p (@{$pcap}) { # enpty end entry for trailing comments next if !defined($p->{'names'}); # Search for the correct queue next if ($queue ne $p->{'names'}[0]); # Collect values my $c = {}; my $name = $c->{'queue'} = $p->{'names'}[0]; $c->{'desc'} = $p->{'names'}[1] if $p->{'names'}[1]; $c->{'loc'} = $p->{'names'}[3] if $p->{'names'}[3]; $c->{'foomatic'} = 0; my $if = ($p->{'str'}{'if'} || ""); if ($if =~ m!foomatic-rip$!) { $c->{'foomatic'} = 1; $c->{'printer'} = $dat->{'id'}; $c->{'driver'} = $dat->{'driver'}; } if (!$p->{'bool'}{'force_localhost'}) { # LPD $c->{'spooler'} = 'lpd'; } else { # LPRng $c->{'spooler'} = 'lprng'; } # TODO Raw queue for LPD # if (0 and $p->{'str'}{'if'} eq $file) { # Raw queue with $postpipe # if (open FILE, "$file") { # # The first line is #!/bin/sh # $line = ; # # The second line is a comment # $line = ; # # The remaining line(s) are the $postpipe # $line = join('', ); # chomp $line; # $postpipe = "| $line"; # close FILE; # } # } if (defined($postpipe)) { if ($postpipe =~ m!^\s*\|\s*($sysdeps->{'cat'}|cat)\s+-?\s*>\s*([^\s]+)\s*$!) { my $file = $2; if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) || ($file =~ m!^/dev/ptal-printd/(.+)$!) || ($file =~ m!^/var/run/ptal-printd/(.+)$!)) { # Translate device for ptal-printd to ptal URI my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $c->{'connect'} = "ptal:/$devname"; } elsif (($file =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) || ($file =~ m!^/var/mtink/(.+)$!)) { # Translate device for mtinkd to mtink URI $c->{'connect'} = "mtink:/$1"; } elsif ($file =~ m!usb!i) { $c->{'connect'} = "usb:$file"; } elsif ($file =~ m!(tty|serial)!i) { $c->{'connect'} = "serial:$file"; } elsif ($file =~ m!(lp[0-9]|parallel)!i) { $c->{'connect'} = "parallel:$file"; } else { $c->{'connect'} = "file:$file"; } } elsif ($postpipe =~ m!^\s*\|\s*($sysdeps->{'ptal-connect'}|ptal-connect|ptal-print)\s+(-print\s+|)([^\s]+)(\s+-print|)\s*$!){ $c->{'connect'} = "ptal:/$3"; } elsif ($postpipe =~ m!^\s*\|\s*($sysdeps->{'nc'}|netcat|nc)\s+(-w\s*1\s+|)([^\s]+)\s+([^\s]+)\s*$!){ $c->{'connect'} = "socket://$3:$4"; } elsif ($postpipe =~ m!^\s*\|\s*$sysdeps->{'rlpr'}\s.*-P\s*([^\s\\\@]+)\@([^\s\\\@]+)\s*$!) { $c->{'connect'} = "lpd://$2/$1"; } elsif ($postpipe =~ m!^.*\|\s*$sysdeps->{'smbclient'}\s+\"//([^/\s]+)/([^/\s]+)\"\s+(\S.*)$!s) { my $servershare = "$1/$2"; my $parameters = $3; my $password = ""; if ($parameters =~ m!^([^-]\S*)\s+(\S.*)$!) { $password = $1; $parameters = $2; } my $username = ""; if ($parameters =~ m!^-U\s+(\S*)\s+(\S.*)$!) { $username = $1; $parameters = $2; } my $workgroup = ""; if ($parameters =~ m!^-W\s+(\S*)\s+(\S.*)$!) { $workgroup = "$1/"; } my $identity = ""; if (($username eq "GUEST") && ($password eq "")) { $identity = ""; } elsif (($username eq "") && ($password eq "")) { $identity = ""; } elsif (($username ne "") && ($password eq "")) { $identity = "$username\@"; } elsif (($username eq "") && ($password ne "")) { $identity = ":$password\@"; } else { $identity = "$username:$password\@"; } $c->{'connect'} = "smb://$identity$workgroup$servershare"; } elsif ($postpipe =~ m!^\s*\|\s*$sysdeps->{'nprint'}\s+(\S.*)$!s) { my $parameters = $1; my $server = ""; if ($parameters =~ m!^-S\s+(\S*)\s+(\S.*)$!) { $server = $1; $parameters = $2; } my $username = ""; if ($parameters =~ m!^-U\s+(\S*)\s+(\S.*)$!) { $username = $1; $parameters = $2; } my $password = ""; if ($parameters =~ m!^-P\s+(\S*)\s+(\S.*)$!) { $password = $1; $parameters = $2; } if ($parameters =~ m!^-n\s+(\S.*)$!) { $parameters = $1; } my $queue = ""; if ($parameters =~ m!^-q\s+(\S*)\s+(\S.*)$!) { $queue = $1; } my $identity = ""; if (($username eq "") && ($password eq "")) { $identity = ""; } elsif (($username ne "") && ($password eq "")) { $identity = "$username\@"; } elsif (($username eq "") && ($password ne "")) { $identity = ":$password\@"; } else { $identity = "$username:$password\@"; } $c->{'connect'} = "ncp://$identity$server/$queue"; } elsif( $postpipe ){ $postpipe =~ m!\s*\|\s*(\S.*)$!; $c->{'connect'} = "postpipe:\"$1\""; } } else { my $lp = $p->{'str'}{'lp'}; if (defined($lp) and $lp and $lp ne '/dev/null') { if (($lp =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) || ($lp =~ m!^/dev/ptal-printd/(.+)$!) || ($lp =~ m!^/var/run/ptal-printd/(.+)$!)) { # Translate device for ptal-printd to ptal URI my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $c->{'connect'} = "ptal:/$devname"; } elsif (($lp =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) || ($lp =~ m!^/var/mtink/(.+)$!)) { # Translate device for mtinkd to mtink URI $c->{'connect'} = "mtink:/$1"; } elsif ($lp =~ m!^\w+:!i) { $c->{'connect'} = $lp; } else { $c->{'connect'} = "file:$lp"; } } my ($rm, $rp) = ($p->{'str'}{'rm'}, $p->{'str'}{'rp'}); if (defined($rm) and defined($rp)) { $c->{'connect'} = "lpd://$rm/$rp"; } } $dat->{'queuedata'} = $c; } if (!defined($dat->{'queuedata'})) {$dat = undef}; return $dat; } sub load_cups_datablob { my ($queue) = $_[0]; # Load the PPD file my $ppdfile = sprintf('%s/ppd/%s.ppd', $sysdeps->{'cups-etc'}, $queue); #my $ppdfile = sprintf('%s/%s.ppd', # $sysdeps->{'foo-etc'}, # $queue); my $dat = ppdtoperl($ppdfile); if (defined($dat)) { $dat->{'ppdfile'} = $ppdfile; } # Get additional info from /etc/cups/printers.conf my $pconf = load_cups_printersconf(); my $p; for $p (@{$pconf}) { # were we invoked for only one queue? next if ($queue ne $p->{'name'}); # Collect values my $c = {}; $c->{'spooler'} = 'cups'; $c->{'queue'} = $p->{'name'}; $c->{'foomatic'} = 0; if (defined($dat->{'id'}) and defined($dat->{'driver'})) { $c->{'foomatic'} = 1; $c->{'printer'} = $dat->{'id'}; $c->{'driver'} = $dat->{'driver'}; } $c->{'desc'} = $p->{'Info'}; $c->{'loc'} = $p->{'Location'}; my $uri = $p->{'DeviceURI'}; # Is the beh (Backend Error Handler) wrapper backend in use? # If yes, read out its parameters and isolate the original URI. if ($uri =~ m!^beh:/(\d+)/(\d+)/(\d+)/(\S+)$!) { $c->{'dd'} = $1; $c->{'att'} = $2; $c->{'delay'} = $3; $uri = $4; } else { $c->{'dd'} = 0; $c->{'att'} = 1; $c->{'delay'} = 30; } if (($uri =~ m!^file:$sysdeps->{'ptal-pipes'}/(.+)$!) || ($uri =~ m!^file:/dev/ptal-printd/(.+)$!) || ($uri =~ m!^file:/var/run/ptal-printd/(.+)$!)) { # Translate URI for ptal-printd to ptal URI my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $uri = "ptal:/$devname"; } elsif (($uri =~ m!^file:$sysdeps->{'mtink-pipes'}/(.+)$!) || ($uri =~ m!^file:/var/mtink/(.+)$!)) { # Translate URI for mtinkd to mtink URI $uri = "mtink:/$1"; } $c->{'connect'} = $uri; # CUPS-specific extra info $c->{'quotaperiod'} = $p->{'QuotaPeriod'} if defined($p->{'QuotaPeriod'}); $c->{'pagelimit'} = $p->{'PageLimit'} if defined($p->{'PageLimit'}); $c->{'klimit'} = $p->{'KLimit'} if defined($p->{'KLimit'}); # CUPS 1.2-specific settings $c->{'laststatechange'} = $p->{'StateTime'} if defined($p->{'StateTime'}); $c->{'shared'} = $p->{'Shared'} if defined($p->{'Shared'}); $c->{'operationpolicy'} = $p->{'OpPolicy'} if defined($p->{'OpPolicy'}); $c->{'errorpolicy'} = $p->{'ErrorPolicy'} if defined($p->{'ErrorPolicy'}); $dat->{'queuedata'} = $c; } if (!defined($dat->{'queuedata'})) {$dat = undef}; return $dat; } sub load_pdq_datablob { my ($queue) = $_[0]; # Load the PPD file my $ppdfile = sprintf('%s/pdq/%s.ppd', $sysdeps->{'foo-etc'}, $queue); my $dat = ppdtoperl($ppdfile); if (defined($dat)) { $dat->{'ppdfile'} = $ppdfile; } if (defined($dat)) { my $printrc = load_pdq_printrc(); my $p; my $pdqopts; my $pdqargs; for $p (@{$printrc}) { # Omit non-printer-block items next if (!(defined($p->{'name'}))); # Search the current queue next if ($queue ne $p->{'name'}); $pdqopts = $p->{'driver_opts'}; $pdqargs = $p->{'driver_args'}; } my @printrcdefaults = split(",", $pdqopts); push (@printrcdefaults, split(",", $pdqargs)); my $c; @{$c->{'options'}} = (); for my $option (@printrcdefaults) { if ($option =~ m!^\s*\{?\s*\"(OPT_|)(.+?)\"\s*=\s*\"(.*)\"\s*\}?\s*$!) { push (@{$c->{'options'}}, "$2=$3"); } elsif ($option =~ m!^\s*\{?\s*\"(OPT_|)([^_]+?)_(.+?)\"\s*\}?\s*$!) { push (@{$c->{'options'}}, "$2=$3"); } elsif ($option =~ m!^\s*\{?\s*\"(OPT_|)(.+?)\"\s*\}?\s*$!) { push (@{$c->{'options'}}, "$2"); } } set_default_options($c, $dat); } # Get additional info from printrc my $printrc = load_pdq_printrc(); my $p; for $p (@{$printrc}) { # Omit non-printer-block items next if (!(defined($p->{'name'}))); # Search for the appropriate queue next if ($queue ne $p->{'name'}); my $c = {}; $c->{'spooler'} = 'pdq'; $c->{'queue'} = $p->{'name'}; $c->{'foomatic'} = 0; if (defined($dat->{'id'}) and defined($dat->{'driver'})) { $c->{'foomatic'} = 1; $c->{'printer'} = $dat->{'id'}; $c->{'driver'} = $dat->{'driver'}; } if (defined($p->{'model'})) { my $desc = $p->{'model'}; $desc =~ s!^\"!!; $desc =~ s!\"$!!; if ($desc ne '') {$c->{'desc'} = $desc;} } if (defined($p->{'location'})) { my $loc = $p->{'location'}; $loc =~ s!^\"!!; $loc =~ s!\"$!!; if ($loc ne '') {$c->{'loc'} = $loc;} } if ($p->{'interface'} =~ m!local-port!) { # Local printer $p->{'interface_args'} =~ m!\"?PORT\"?\s*=\s*\"?([^\"\s]+)\"?!; my $file = $1; if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) || ($file =~ m!^/dev/ptal-printd/(.+)$!) || ($file =~ m!^/var/run/ptal-printd/(.+)$!)) { # Translate device for ptal-printd to ptal URI my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $c->{'connect'} = "ptal:/$devname"; } elsif (($file =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) || ($file =~ m!^/var/mtink/(.+)$!)) { # Translate device for mtinkd to mtink URI $c->{'connect'} = "mtink:/$1"; } elsif ($file =~ m!usb!i) { $c->{'connect'} = "usb:$file"; } elsif ($file =~ m!(tty|serial)!i) { $c->{'connect'} = "serial:$file"; } elsif ($file =~ m!(lp[0-9]|parallel)!i) { $c->{'connect'} = "parallel:$file"; } else { $c->{'connect'} = "file:$file"; } } elsif ($p->{'interface'} =~ m!bsd-lpd!) { # Remote LPD $p->{'interface_args'} =~ m!\"?REMOTE_HOST\"?\s*=\s*\"?([^\"\s]+)\"?!; my $remhost = $1; $p->{'interface_args'} =~ m!\"?QUEUE\"?\s*=\s*\"?([^\"\s]+)\"?!; my $remqueue = $1; $c->{'connect'} = "lpd://$remhost/$remqueue"; } elsif ($p->{'interface'} =~ m!tcp-port!) { # Socket $p->{'interface_args'} =~ m!\"?REMOTE_HOST\"?\s*=\s*\"?([^\"\s]+)\"?!; my $remhost = $1; $p->{'interface_args'} =~ m!\"?REMOTE_PORT\"?\s*=\s*\"?([^\"\s]+)\"?!; my $remport = $1; $c->{'connect'} = "socket://$remhost:$remport"; } $dat->{'queuedata'} = $c; } if (!defined($dat->{'queuedata'})) {$dat = undef}; return $dat; } sub load_ppr_datablob { my ($queue) = $_[0]; # Load the PPD file my $ppdfile = sprintf('%s/ppr/%s.ppd', $sysdeps->{'foo-etc'}, $queue); my $dat = ppdtoperl($ppdfile); if (defined($dat)) { $dat->{'ppdfile'} = $ppdfile; } # Get additional info from /etc/ppr/* my $pconf = load_ppr_printers_conf(); my $p; for $p (@{$pconf}) { # were we invoked for only one queue? next if ($queue ne $p->{'name'}); # Collect values my $c = {}; $c->{'spooler'} = 'ppr'; $c->{'queue'} = $p->{'name'}; $c->{'foomatic'} = 0; if (defined($dat->{'id'}) and defined($dat->{'driver'})) { $c->{'foomatic'} = 1; $c->{'printer'} = $dat->{'id'}; $c->{'driver'} = $dat->{'driver'}; } $c->{'desc'} = $p->{'Comment'}; $c->{'loc'} = $p->{'Location'}; if (defined($dat)) { my @printerdefaults = split('|', $p->{'Switchset'}); my $o; @{$o->{'options'}} = (); for my $option (@printerdefaults) { if (($option =~ /^F\s*\*([^\*\s=:]+)\s+([^\*\s=:]+)\s*$/) || ($option =~ /^F\s*([^\*\s=:]+)\s*=\s*([^\*\s=:]+)\s*$/)) { push (@{$o->{'options'}}, "$1=$2"); } elsif (($option =~ /^F\s*\*([^\*\s=:]+)\s*$/) || ($option =~ /^F\s*([^\*\s=:]+)\s*$/)) { push (@{$o->{'options'}}, "$1"); } } set_default_options($o, $dat); } my $address = $p->{'Address'}; my $interface = $p->{'Interface'}; my $interface_options = $p->{'Options'}; if (($interface eq "foomatic-rip") || ($interface eq "ppromatic")) { if ($interface_options =~ /backend=(\S+)/) { $interface = $1; $interface_options =~ s/backend=(\S+)//; if ($interface_options =~ /^\s*$/) { $interface_options = ""; } } else { $interface = ""; } } my $uri = ""; if (($interface eq "simple") || ($interface eq "parallel") || ($interface eq "serial") || ($interface eq "dummy")) { # local printer if (($address =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) || ($address =~ m!^/dev/ptal-printd/(.+)$!) || ($address =~ m!^/var/run/ptal-printd/(.+)$!)) { # Translate device for ptal-printd to ptal URI my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $uri = "ptal:/$devname"; } elsif (($address =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) || ($address =~ m!^/var/mtink/(.+)$!)) { # Translate device for mtinkd to mtink URI $uri = "mtink:/$1"; } elsif ($address =~ m!^\w+:!i) { $c->{'connect'} = $address; } else { $uri = "file:$address"; } } elsif ($interface eq "lpr") { # Remote LPD if ($address =~ /^([^\@]+)\@([^\@]+)$/) { my $remhost = $2; my $remqueue = $1; $uri = "lpd://$remhost/$remqueue"; } else { die "Remote LPD configuration of the queue $p->{'name'} " . "broken!\n"; } } elsif ($interface eq "tcpip") { # Socket (AppSocket/HP JetDirect) $uri = "socket://$address"; } elsif ($interface eq "smb") { # SMB (Printer on Windows server) if ($address =~ m!^//([^/]+)/([^/]+)$!) { my $smbserver = $1; my $smbshare = $2; my $smbuser = ""; if ($interface_options =~ /smbuser=(\S+)/) { $smbuser = $1; } else { # The PPR interface for SMB uses the user name "ppr" # when no user name is given. $smbuser = "ppr"; } my $smbpassword = ""; if ($interface_options =~ /smbpassword=(\S+)/) { $smbpassword = $1; } if (($smbpassword ne "") && ($smbuser eq "")) { $smbuser = "GUEST"; } $uri = "$smbserver/$smbshare"; if ($smbuser ne "") { if ($smbpassword ne "") { $smbuser .= ":$smbpassword"; } $uri = "$smbuser\@$uri"; } $uri = "smb://$uri"; } else { die "SMB configuration of the queue $p->{'name'} broken!\n"; } } else { # Interface not supported by Foomatic $uri = "$interface:$address"; } $c->{'connect'} = $uri; $dat->{'queuedata'} = $c; } if (!defined($dat->{'queuedata'})) {$dat = undef}; return $dat; } sub load_direct_datablob { my ($queue) = $_[0]; # Load the PPD file my $ppdfile = sprintf('%s/direct/%s.ppd', $sysdeps->{'foo-etc'}, $queue); my $dat = ppdtoperl($ppdfile); if (defined($dat)) { $dat->{'ppdfile'} = $ppdfile; } my $postpipe = (defined($dat) ? $dat->{'postpipe'} : ""); # Get additional info from /etc/foomatic/direct/.config my $config = load_direct_config(); my $p; for $p (@{$config}) { # invalid entry next if !defined($p->{'name'}); # Search for the correct queue next if ($queue ne $p->{'name'}); # Collect values my $c = {}; my $name = $c->{'queue'} = $p->{'name'}; $c->{'desc'} = $p->{'desc'}; $c->{'loc'} = $p->{'loc'}; $c->{'foomatic'} = 0; if (defined($dat->{'id'}) and defined($dat->{'driver'})) { $c->{'foomatic'} = 1; $c->{'printer'} = $dat->{'id'}; $c->{'driver'} = $dat->{'driver'}; } $c->{'spooler'} = 'direct'; if (defined($postpipe)) { if ($postpipe =~ m!^\s*\|\s*($sysdeps->{'cat'}|cat)\s+-?\s*>\s*([^\s]+)\s*$!) { my $file = $2; if (($file =~ m!^$sysdeps->{'ptal-pipes'}/(.+)$!) || ($file =~ m!^/dev/ptal-printd/(.+)$!) || ($file =~ m!^/var/run/ptal-printd/(.+)$!)) { # Translate device for ptal-printd to ptal URI my $devname = $1; $devname =~ s/_/:/; $devname =~ s/_/:/; $c->{'connect'} = "ptal:/$devname"; } elsif (($file =~ m!^$sysdeps->{'mtink-pipes'}/(.+)$!) || ($file =~ m!^/var/mtink/(.+)$!)) { # Translate device for mtinkd to mtink URI $c->{'connect'} = "mtink:/$1"; } elsif ($file =~ m!usb!i) { $c->{'connect'} = "usb:$file"; } elsif ($file =~ m!(tty|serial)!i) { $c->{'connect'} = "serial:$file"; } elsif ($file =~ m!(lp[0-9]|parallel)!i) { $c->{'connect'} = "parallel:$file"; } else { $c->{'connect'} = "file:$file"; } } elsif ($postpipe =~ m!^\s*\|\s*($sysdeps->{'ptal-connect'}|ptal-connect|ptal-print)\s+(-print\s+|)([^\s]+)(\s+-print|)\s*$!){ $c->{'connect'} = "ptal:/$3"; } elsif ($postpipe =~ m!^\s*\|\s*($sysdeps->{'nc'}|netcat|nc)\s+(-w\s*1\s+|)([^\s]+)\s+([^\s]+)\s*$!){ $c->{'connect'} = "socket://$3:$4"; } elsif ($postpipe =~ m!^\s*\|\s*$sysdeps->{'rlpr'}\s.*-P\s*([^\s\\\@]+)\@([^\s\\\@]+)\s*$!) { $c->{'connect'} = "lpd://$2/$1"; } elsif ($postpipe =~ m!^.*\|\s*$sysdeps->{'smbclient'}\s+\"//([^/\s]+)/([^/\s]+)\"\s+(\S.*)$!s) { my $servershare = "$1/$2"; my $parameters = $3; my $password = ""; if ($parameters =~ m!^([^-]\S*)\s+(\S.*)$!) { $password = $1; $parameters = $2; } my $username = ""; if ($parameters =~ m!^-U\s+(\S*)\s+(\S.*)$!) { $username = $1; $parameters = $2; } my $workgroup = ""; if ($parameters =~ m!^-W\s+(\S*)\s+(\S.*)$!) { $workgroup = "$1/"; } my $identity = ""; if (($username eq "GUEST") && ($password eq "")) { $identity = ""; } elsif (($username eq "") && ($password eq "")) { $identity = ""; } elsif (($username ne "") && ($password eq "")) { $identity = "$username\@"; } elsif (($username eq "") && ($password ne "")) { $identity = ":$password\@"; } else { $identity = "$username:$password\@"; } $c->{'connect'} = "smb://$identity$workgroup$servershare"; } elsif ($postpipe =~ m!^\s*\|\s*$sysdeps->{'nprint'}\s+(\S.*)$!s) { my $parameters = $1; my $server = ""; if ($parameters =~ m!^-S\s+(\S*)\s+(\S.*)$!) { $server = $1; $parameters = $2; } my $username = ""; if ($parameters =~ m!^-U\s+(\S*)\s+(\S.*)$!) { $username = $1; $parameters = $2; } my $password = ""; if ($parameters =~ m!^-P\s+(\S*)\s+(\S.*)$!) { $password = $1; $parameters = $2; } if ($parameters =~ m!^-n\s+(\S.*)$!) { $parameters = $1; } my $queue = ""; if ($parameters =~ m!^-q\s+(\S*)\s+(\S.*)$!) { $queue = $1; } my $identity = ""; if (($username eq "") && ($password eq "")) { $identity = ""; } elsif (($username ne "") && ($password eq "")) { $identity = "$username\@"; } elsif (($username eq "") && ($password ne "")) { $identity = ":$password\@"; } else { $identity = "$username:$password\@"; } $c->{'connect'} = "ncp://$identity$server/$queue"; } else { $postpipe =~ m!\s*\|\s*(\S.*)$!; $c->{'connect'} = "postpipe:\"$1\""; } } else { $c->{'connect'} = "stdout"; } $dat->{'queuedata'} = $c; } if (!defined($dat->{'queuedata'})) {$dat = undef}; return $dat; } sub overtake_defaults { # overtake the option default settings from $olddatablob my ($olddatablob) = $_[0]; my $c; @{$c->{'options'}} = (); for my $opt (@{$olddatablob->{'args'}}) { push (@{$c->{'options'}}, "$opt->{'name'}=$opt->{'default'}"); } set_default_options($c, $db->{'dat'}); } sub set_default_options { # Set the default printing options by doing changes on the Perl # structure produced by "getdat", before the spooler-specific # datafile is generated my ($config) = $_[0]; my ($dest) = $_[1]; if ($#{$config->{'options'}} >= 0) { for (@{$config->{'options'}}) { my $option = $_; if ($option =~ m!^\s*([^=]+)=([^=]*)\s*$!) { # evaluated or numerical option, boolean option with # value "True", "False", "Yes", "No", "On", "Off", "1", "0" # given my $optname = $1; my $optvalue = $2; if (defined($dest->{'args_byname'}{$optname})) { if ($dest->{'args_byname'}{$optname}{'type'} eq 'bool') { if ((lc($optvalue) eq 'true') || (lc($optvalue) eq 'on') || (lc($optvalue) eq 'yes')) { $optvalue = '1'; } elsif ((lc($optvalue) eq 'false') || (lc($optvalue) eq 'off') || (lc($optvalue) eq 'no')) { $optvalue = '0'; } if (($optvalue eq '1') || ($optvalue eq '0')) { $dest->{'args_byname'}{$optname}{'default'} = $optvalue; } } elsif (($dest->{'args_byname'}{$optname}{'type'} eq 'int') || ($dest->{'args_byname'}{$optname}{'type'} eq 'float')) { if (($optvalue =~ m!^\s*[\+\-]?\s*[0-9]*\.?[0-9]*\s*$!) && ($optvalue >= $dest->{'args_byname'}{$optname}{'min'}) && ($optvalue <= $dest->{'args_byname'}{$optname}{'max'})) { $dest->{'args_byname'}{$optname}{'default'} = $optvalue; } } elsif (($dest->{'args_byname'}{$optname}{'type'} eq 'string') || ($dest->{'args_byname'}{$optname}{'type'} eq 'password')) { $optvalue = Foomatic::DB::checkoptionvalue ($dest, $optname, $optvalue, 0); $dest->{'args_byname'}{$optname}{'default'} = $optvalue if defined($optvalue); } else { if (defined($dest->{'args_byname'}{$optname}{'vals_byname'}{$optvalue})) { $dest->{'args_byname'}{$optname}{'default'} = $optvalue; } } } } else { if (($option =~ /^no(.+?)$/) && (defined($dest->{'args_byname'}{$1})) && ($dest->{'args_byname'}{$1}{'type'} eq 'bool')) { $dest->{'args_byname'}{$1}{'default'} = '0'; } elsif ((defined($dest->{'args_byname'}{$option})) && ($dest->{'args_byname'}{$option}{'type'} eq 'bool')) { $dest->{'args_byname'}{$option}{'default'} = '1'; } } } } } sub print_perl_combo_data { my ($config, $olddatablob) = @_; # Get the data if ($config->{'ppdfile'}) { # From PPD file my $dat = ppdtoperl($config->{'ppdfile'}); if (!defined($dat)) { die ("Unable to open PPD file \'$config->{'ppdfile'}\'\n"); } $db->{'dat'} = $dat; } else { # From Foomatic XML database my $possible = $db->getdat($config->{'driver'}, $config->{'printer'}); die "That printer and driver combination is not possible.\n" if (!$possible); die "There is neither a custom PPD file nor the driver database entry contains sufficient data to build a PPD file.\n" if (!$db->{'dat'}{'cmd'}) && (!$db->{'dat'}{'ppdfile'}); # Generate the PPD and extract it to Perl again (to get in the # composite options) my $ppd = $db->getppd($config->{'shortgui'}); delete ($db->{'dat'}); $db->{'dat'} = ppdfromvartoperl([split(/\n/, $ppd)]); } # The data can be viewed with the option defaults of an existing # queue set if ($olddatablob) { my $c; @{$c->{'options'}} = (); for my $opt (@{$olddatablob->{'args'}}) { push (@{$c->{'options'}}, "$opt->{'name'}=$opt->{'default'}"); } set_default_options($c, $db->{'dat'}); } # User can view the data of the combo also with options given on the # command line set_default_options($config, $db->{'dat'}); # Put it out my $asciidata = $db->getascii(); $asciidata =~ s/\$VAR1/\$COMBODATA/g; print $asciidata; return; } sub detect_spooler { # If tcp/localhost:631 opens, cups CUPS is the most sophisticated # spooler, if it is running, it is usually the primary printing # system my $page = ($db->getpage('http://localhost:631/', 1) || ""); if ($page =~ m!Common UNIX Printing System!) { return 'cups'; } # PPR is also very sophisticated so check for this spooler if there is # no CUPS running. if (-x $sysdeps->{'ppr-ppr'}) { # There's a /usr/bin/ppr return 'ppr'; } # Else if /etc/printcap, some sort of lpd thing if (-f $sysdeps->{'lpd-pcap'}) { # If -f /etc/lpd.conf, lprng if (-f $sysdeps->{'lprng-conf'}) { return 'lprng'; } elsif (-x $sysdeps->{'lpd-bin'}) { # There's a /usr/sbin/lpd return 'lpd'; } } # pdq executable in our path somewhere? for (split(':', $ENV{'PATH'})) { if (-x "$_/pdq") { return 'pdq'; } } # If there is no known spooler, set up printers for direct, spooler-less # printing. return "direct"; } sub unimp { die "Sorry, $action for your spooler is unimplemented...\n"; } sub overview { print $db->get_overview_xml($opt_f); exit(0); } sub get_xml { my $x = undef; if (($opt_p) and ($opt_d)) { $x = $db->get_combo_data_xml($opt_d,$opt_p); } elsif ($opt_p) { $x = $db->get_printer_xml($opt_p); } elsif ($opt_d) { $x = $db->get_driver_xml($opt_d); } else { die "You must specify a -p printer and/or -d driver.\n"; } if (defined($x)) { print $x; } else { die "Unable to find object.\n"; } exit(0); } sub help { print STDERR <