JezK
Edit File: foomatic-configure
#!/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 programmatic 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:"<command line>" # 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 = <STDIN>; 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 "<queues>\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 "<defaultqueue>$def_firstname</defaultqueue>\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 "<defaultqueue>$p->{'names'}[0]" . "</defaultqueue>\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 "</queues>\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 "<queues>\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 = <DEFAULT>; close DEFAULT; if ($defaultstr =~ m!\S+:\s+(\S+)$!) { $default = $1; if (!$opt_P) { print "<defaultqueue>$default</defaultqueue>\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 "</queues>\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 = <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 "<queues>\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('', <DEFAULT>); close DEFAULT; if ($defaultstr =~ m!The\s+default\s+printer\s+is\s+(\S+)$!m) { $default = $1; if (!$opt_P) { print "<defaultqueue>$default</defaultqueue>\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 "</queues>\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 = <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 <queue>" 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 <queue>" 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 "<queues>\n"; } # Query the default printer my $default; if (!defined($config->{'queue'})) { for $p (@{$pconf}) { if ($p->{'default'}) { $default = $p->{'name'}; if (!$opt_P) { print "<defaultqueue>$p->{'name'}</defaultqueue>\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 "</queues>\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 "<queues>\n"; } # Query the default printer my $default; if (!defined($config->{'queue'})) { for $p (@{$pconf}) { if ($p->{'default'}) { $default = $p->{'name'}; if (!$opt_P) { print "<defaultqueue>$p->{'name'}</defaultqueue>\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 "</queues>\n"; } return; } ### Functions used by the queue manipulation functions from above sub dump_config { my $c = $_[0]; print sprintf("<queue foomatic=\"%d\" spooler=\"%s\">\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'}) : ())) : ()), "</queue>\n"; return; } sub _tag { my ($t, $v) = @_; return '' if !defined($v); $v =~ s!\&!\&\;!g; $v =~ s!\<!\<\;!g; return " <$t>$v</$t>\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('', <PCAP>); 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 = <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 <Printer ...> block $p->{'name'} = $2; $p->{'default'} = ($1 eq "Default"); } elsif ($line =~ m!^\s*</Printer>\s*$!) { # End of <Printer ...> block push (@items, $p); $itemshash->{$p->{name}} = $#items; $p = {}; } elsif (defined($p->{'name'})) { # Inside <Printer ...> block if (($line =~ m!^\s*(\S+)\s+(\S.*)$!) and ($1 ne '')) {$p->{$1} = $2}; } else { # Outside <Printer ...> 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 = <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 = <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 (<SHOWDEFAULTGROUP>) { 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/<queue name>, 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 (<PCONFFILE>) { chomp $line; $linecount ++; if (!($line =~ m!^\s*\#!) && (!($line =~ m!^\s*$!))) { if (($line =~ m!^\s*([^\s:]+)\s*:\s*(\S.*)$!) || ($line =~ m!^\s*([^\s:]+)\s*:\s*()$!)) { # <keyword>: <value1> <value2> ... 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 = <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 (<PPAD_SHOW>) { chomp $line; $lcount ++; if ((!($line =~ m!^\s*\#!)) && (!($line =~ m!^\s*$!))) { if ($line =~ m!^\s*([^\s:][^:]*)\s*:\s*(.*)$!) { # <keyword>: <value1> <value2> ... 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 = <CONFIG>) { 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 = <F>) { 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 } <F>; 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 } <F>; 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 = <FILE>; # # The second line is a comment # $line = <FILE>; # # The remaining line(s) are the $postpipe # $line = join('', <FILE>); # 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 = (getpage('http://localhost:631/', 1) || ""); if ($page =~ m!CUPS!) { 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 <<EOH; Usage: $progname [ -s spooler ] -n queuename \\ [ -N 'Name/Descr.' ] [ -L 'Location Info' ] \\ [ -c connect ] \\ [ -d driver ] [ -p printer ] [ -f ] [ -w ] \\ [ --ppd ppdfile ] \\ [ -o option1=value1 -o option2 ... ] \\ [ --backend-dont-disable=value ] \\ [ --backend-attempts=value ] \\ [ --backend-delay=value ] \\ [ -q ] or $progname -C [ -s spooler ] -n queuename \\ [ sourcespooler ] sourcequeue \\ [ -N 'Name/Descr.' ] [ -L 'Location Info' ] \\ [ -c connect ] \\ [ -d driver ] [ -p printer ] [ -f ] [ -w ] \\ [ --ppd ppdfile ] \\ [ -o option1=value1 -o option2 ... ] \\ [ --backend-dont-disable=value ] \\ [ --backend-attempts=value ] \\ [ --backend-delay=value ] \\ [ -q ] or $progname -D [ -s spooler ] -n queuename [ -q ] or $progname -R [ -s spooler ] -n queuename [ -q ] or $progname -Q [ -s spooler ] [ -n queuename ] [ -q ] [ -r ] or $progname -P [ -s spooler ] [ -n queuename ] [ -q ] [ N ] or $progname -P [ -s spooler ] [ -n queuename ] \\ [ --ppd ppdfile ] [ -d driver -p printer ] \\ [ -o option1=value1 -o option2 ... ] [ -q ] or $progname -O or $progname -X [ -p printer ] [ -d driver ] -n queuename Configure/create/delete/query this print queue -N Name/Descr. Long name/Short Description. An empty string ("") deletes the description. -L Location Short phrase describing this printer's location. An empty string ("") deletes the location. -c connection Printer is connected thusly (ex file:/dev/lp0), must be given when a new queue is created --ppd ppdfile Set up the queue using the PPD file ppdfile (can be a manufacturer-supplied PPD file for a PostScript printer). gzip-compressed PPD files are allowed, they must have the extension ".gz". -d driver Foomatic database name for desired printer driver or "raw" for a raw queue. When a non-raw queue is created, the printer must be specified in addition ("-p" option) -p printer Foomatic id for printer. When a non-raw queue is created, the driver must be specified in addition ("-d" option) -s spooler Explicit spooler type (cups, lpd, lprng, pdq, ppr, direct) -o option=value Use value as the default for option in this queue -o option Set the switch option by default in this queue --backend-dont-disable=value 1: Do not disable CUPS queue when backend fails, 0: Original CUPS behaviour, queue gets disabled when backend fails. Default: 0 (CUPS only) --backend-attempts=value Try that often when backend fails, for infinite retries set the value to zero, for standard CUPS behaviour to 1. Default: 1 (CUPS only) --backend-delay=value Delay in seconds between retries of failed backend. Default: 30 (CUPS only) -C [sourcespooler] sourcequeue Create a copy of a queue. All characteristics including default option settings are overtaken. Additional arguments modify the copy. This facility allows to overtake one's configured queues when one changes the spooler. -D Set this queue as the queue used by default. -R Remove this whole queue entirely (just give -n queuename) -Q Query existing configuration (gives XML summary). Supplying no queue name gives info about all installed queues for the current/selected spooler, including the default queue. -r list also remote queues (CUPS only). -P Query existing configuration (gives Perl data structure of the complete information about the queue, including options, possible choices, default settings, ..., for use by frontends, the output is done as a Perl array, one element per queue), With printer ID and driver name instead of queue name supplied the Perl data structure of the appropriate printer/driver combo is generated, supplied options are entered as default settings then, from a supplied queue the option default settings are used. Supplying no queue, printer, and driver gives info about all installed queues for the current/selected spooler. N The first index of the Perl array, default: 0 -O Print XML Overview of all known printer/drivers -X Print XML data for -p printer and/or -d driver object -f Force rebuild of PPD file from database -w Generate PPD which is compatible to the CUPS PostScript driver for Windows (GUI strings are limited to 39 characters). This applies only to PPDs built from the Foomatic database, it has no influence on PPDs supplied with the "--ppd" option. -q Run quietly and non-interactive -h --help Show this help message EOH #'# Fix emacs syntax highlighting exit 0; }