diff options
Diffstat (limited to 'perl-install/printerdrake.pm')
| -rw-r--r-- | perl-install/printerdrake.pm | 408 |
1 files changed, 181 insertions, 227 deletions
diff --git a/perl-install/printerdrake.pm b/perl-install/printerdrake.pm index 9d7349740..28bcd3b1e 100644 --- a/perl-install/printerdrake.pm +++ b/perl-install/printerdrake.pm @@ -5,116 +5,167 @@ use strict; use common qw(:common :file :functional :system); use detect_devices; +use run_program; use commands; use modules; -use network; use log; use printer; 1; -sub auto_detect { - my ($in) = @_; - { - my $w = $in->wait_message(_("Test ports"), _("Detecting devices...")); - detect_devices::probeUSB() and eval { modules::load("printer"); sleep(1); }; - eval { modules::load("parport_pc"); modules::load("parport_probe"); modules::load("lp"); }; - } - my $b = before_leaving { eval { modules::unload("parport_probe") } }; - detect_devices::whatPrinter(); +sub getinfo($) { + my ($prefix) = @_; + my $entry = {}; + + printer::set_prefix($prefix); + printer::read_configured_queue($entry); + + add2hash($entry, { + want => 0, + complete => 0, + str_type => $printer::printer_type_default, + QUEUE => "lp", + SPOOLDIR => "/var/spool/lpd/lp", + DBENTRY => "PostScript", + PAPERSIZE => "legal", + CRLF => 0, + AUTOSENDEOF => 1, + + DEVICE => "/dev/lp0", + + REMOTEHOST => "", + REMOTEQUEUE => "", + + NCPHOST => "", #-"printerservername", + NCPQUEUE => "", #-"queuename", + NCPUSER => "", #-"user", + NCPPASSWD => "", #-"pass", + + SMBHOST => "", #-"hostname", + SMBHOSTIP => "", #-"1.2.3.4", + SMBSHARE => "", #-"printername", + SMBUSER => "", #-"user", + SMBPASSWD => "", #-"passowrd", + SMBWORKGROUP => "", #-"AS3", + }); + $entry; } +sub copy_printer_params($$) { + my ($from, $to) = @_; -sub setup_local($$$) { - my ($printer, $in, $install) = @_; - - my @port = (); - my @str = (); - my @parport = auto_detect($in); - foreach (@parport) { - push @str, _("A printer, model \"%s\", has been detected on ", $_->{val}{DESCRIPTION}) . $_->{port}; - } - if (@str) { - @port = map { $_->{port} } @parport; - } else { - @port = detect_devices::whatPrinterPort(); + foreach (keys %$from) { + $to->{$_} = $from->{$_} if $_ ne 'configured'; #- avoid cycles. } - $printer->{DEVICE} = $port[0] if $port[0]; - - return if !$in->ask_from_entries_refH(_("Local Printer Device"), - _("What device is your printer connected to -(note that /dev/lp0 is equivalent to LPT1:)?\n") . (join "\n", @str), [ -_("Printer Device") => {val => \$printer->{DEVICE}, list => \@port } ], - ); - - #- select right DBENTRY according to device selected. - foreach (@parport) { - $printer->{DEVICE} eq $_->{port} or next; - $printer->{DBENTRY} = $printer::descr_to_db{common::bestMatchSentence2($parport[0]{val}{DESCRIPTION}, - @printer::entry_db_description)}; - } - 1; } -sub setup_remote($$$) { - my ($printer, $in, $install) = @_; +#- Program entry point. +sub main($$$$) { + my ($prefix, $printer, $in, $install) = @_; - $in->ask_from_entries_refH(_("Remote lpd Printer Options"), -_("To use a remote lpd print queue, you need to supply -the hostname of the printer server and the queue name -on that server which jobs should be placed in."), [ -_("Remote hostname") => \$printer->{REMOTEHOST}, -_("Remote queue") => \$printer->{REMOTEQUEUE}, ], - ); -} + unless ($::testing) { + printer::set_prefix($prefix); + &$install('rhs-printfilters'); + } + printer::read_printer_db(); -sub setup_smb($$$) { - my ($printer, $in, $install) = @_; + $printer->{complete} = 0; + if ($::expert || scalar keys %{$printer->{configured}}) { + $in->ask_from_entries_ref(_("Local Printer Options"), + _("Every print queue (which print jobs are directed to) needs a +name (often lp) and a spool directory associated with it. What +name and directory should be used for this queue?"), + [_("Name of queue:"), _("Spool directory:")], + [\$printer->{QUEUE}, \$printer->{SPOOLDIR}], + changed => sub + { + $printer->{SPOOLDIR} = "$printer::spooldir/$printer->{QUEUE}" unless $_[0]; + }, + ); + } + copy_printer_params($printer->{configured}{$printer->{QUEUE}}, $printer); #- get default parameters from existing queue. + + $printer->{str_type} = + $in->ask_from_list_(_("Select Printer Connection"), + _("How is the printer connected?"), + [ keys %printer::printer_type ], + $printer::printer_type_inv{$printer->{TYPE}}, + ); + $printer->{TYPE} = $printer::printer_type{$printer->{str_type}}; + + if ($printer->{TYPE} eq "LOCAL") { + { + my $w = $in->wait_message(_("Test ports"), _("Detecting devices...")); + eval { modules::load("parport_pc"); modules::load("parport_probe"); modules::load("lp"); }; + } - return if !$in->ask_from_entries_refH( - _("SMB (Windows 9x/NT) Printer Options"), -_("To print to a SMB printer, you need to provide the + my @port = (); + my @parport = detect_devices::whatPrinter(); + eval { modules::unload("parport_probe") }; + my $str; + if ($parport[0]) { + my $port = $parport[0]{port}; + $printer->{DEVICE} = $port; + my $descr = common::bestMatchSentence2($parport[0]{val}{DESCRIPTION}, @printer::entry_db_description); + $printer->{DBENTRY} = $printer::descr_to_db{$descr}; + $str = _("A printer, model \"%s\", has been detected on ", $parport[0]{val}{DESCRIPTION}) . $port; + @port = map { $_->{port}} @parport; + } else { + @port = detect_devices::whatPrinterPort(); + } + $printer->{DEVICE} = $port[0] if $port[0]; + + return if !$in->ask_from_entries_ref(_("Local Printer Device"), + _("What device is your printer connected to \n(note that /dev/lp0 is equivalent to LPT1:)?\n") . $str , + [_("Printer Device:")], + [{val => \$printer->{DEVICE}, list => \@port }], + ); + } elsif ($printer->{TYPE} eq "REMOTE") { + return if !$in->ask_from_entries_ref(_("Remote lpd Printer Options"), + _("To use a remote lpd print queue, you need to supply +the hostname of the printer server and the queue name +on that server which jobs should be placed in."), + [_("Remote hostname:"), _("Remote queue")], + [\$printer->{REMOTEHOST}, \$printer->{REMOTEQUEUE}], + ); + } elsif ($printer->{TYPE} eq "SMB") { + return if !$in->ask_from_entries_ref( + _("SMB (Windows 9x/NT) Printer Options"), + _("To print to a SMB printer, you need to provide the SMB host name (Note! It may be different from its TCP/IP hostname!) and possibly the IP address of the print server, as well as the share name for the printer you wish to access and any -applicable user name, password, and workgroup information."), [ -_("SMB server host") => \$printer->{SMBHOST}, -_("SMB server IP") => \$printer->{SMBHOSTIP}, -_("Share name") => \$printer->{SMBSHARE}, -_("User name") => \$printer->{SMBUSER}, -_("Password") => { val => \$printer->{SMBPASSWD}, hidden => 1 }, -_("Workgroup") => \$printer->{SMBWORKGROUP} ], - complete => sub { - unless (network::is_ip($printer->{SMBHOSTIP})) { - $in->ask_warn('', _("IP address should be in format 1.2.3.4")); - return (1,1); - } - return 0; - }, - ); - &$install('samba'); - 1; -} - -sub setup_ncp($$$) { - my ($printer, $in, $install) = @_; - - return if !$in->ask_from_entries_refH(_("NetWare Printer Options"), -_("To print to a NetWare printer, you need to provide the +applicable user name, password, and workgroup information."), + [_("SMB server host:"), _("SMB server IP:"), + _("Share name:"), _("User name:"), _("Password:"), + _("Workgroup:")], + [\$printer->{SMBHOST}, \$printer->{SMBHOSTIP}, + \$printer->{SMBSHARE}, \$printer->{SMBUSER}, + {val => \$printer->{SMBPASSWD}, hidden => 1}, \$printer->{SMBWORKGROUP} + ], + complete => sub { + unless (network::is_ip($printer->{SMBHOSTIP})) { + $in->ask_warn('', _("IP address should be in format 1.2.3.4")); + return (1,1); + } + return 0; + }, + ); + &$install('samba'); + } elsif ($printer->{TYPE} eq "NCP") { + return if !$in->ask_from_entries_ref(_("NetWare Printer Options"), + _("To print to a NetWare printer, you need to provide the NetWare print server name (Note! it may be different from its TCP/IP hostname!) as well as the print queue name for the printer you -wish to access and any applicable user name and password."), [ -_("Printer Server") => \$printer->{NCPHOST}, -_("Print Queue Name") => \$printer->{NCPQUEUE}, -_("User name") => \$printer->{NCPUSER}, -_("Password") => {val => \$printer->{NCPPASSWD}, hidden => 1} ], - ); - &$install('ncpfs'); - 1; -} +wish to access and any applicable user name and password."), + [_("Printer Server:"), _("Print Queue Name:"), + _("User name:"), _("Password:")], + [\$printer->{NCPHOST}, \$printer->{NCPQUEUE}, + \$printer->{NCPUSER}, {val => \$printer->{NCPPASSWD}, hidden => 1}], + ); + &$install('ncpfs'); + } -sub setup_gsdriver($$$;$) { - my ($printer, $in, $install, $upNetwork) = @_; my $action; my @action = qw(ascii ps both done); my %action = ( @@ -126,21 +177,17 @@ sub setup_gsdriver($$$;$) { do { $printer->{DBENTRY} ||= $printer::thedb_gsdriver{$printer->{GSDRIVER}}{ENTRY}; - eval { $printer->{DBENTRY} = $printer::descr_to_db{ - $in->ask_from_list_with_help_(_("Configure Printer"), - _("What type of printer do you have?"), - [ @printer::entry_db_description ], - { %printer::descr_to_help }, - $printer::db_to_descr{$printer->{DBENTRY}}, - ) + $printer->{DBENTRY} = + $printer::descr_to_db{ + $in->ask_from_list_(_("Configure Printer"), + _("What type of printer do you have?"), + [@printer::entry_db_description], + $printer::db_to_descr{$printer->{DBENTRY}}, + ) }; - }; $@ =~ /^ask_from_list cancel/ and return; my %db_entry = %{$printer::thedb{$printer->{DBENTRY}}}; - #- specific printer driver to install. - &$install('pnm2ppa') if $db_entry{GSDRIVER} eq 'ppa'; - my @list_res = @{$db_entry{RESOLUTION} || []}; my @res = map { "$_->{XDPI}x$_->{YDPI}" } @list_res; my @list_col = @{$db_entry{BITSPERPIXEL} || []}; @@ -149,54 +196,35 @@ sub setup_gsdriver($$$;$) { my %depth_to_col = reverse %col_to_depth; my $is_uniprint = $db_entry{GSDRIVER} eq "uniprint"; - $printer->{PAPERSIZE} ||= "letter"; - $printer->{RESOLUTION} = @res ? $res[0] || "Default" : "Default" unless member($printer->{RESOLUTION}, @res); - $printer->{ASCII_TO_PS} = $db_entry{GSDRIVER} eq 'POSTSCRIPT' unless defined($printer->{ASCII_TO_PS}); - $printer->{CRLF} = $db_entry{DESCR} =~ /HP/ unless defined($printer->{CRLF}); - $printer->{BITSPERPIXEL} = @list_col ? $depth_to_col{$printer->{BITSPERPIXEL}} || $col[0] : "Default"; - $printer->{NUP} = 1 unless member($printer->{NUP}, qw(1 2 4 8)); - $printer->{RTLFTMAR} = 18 unless $printer->{RTLFTMAR} =~ /^\d+$/; - $printer->{TOPBOTMAR} = 18 unless $printer->{TOPBOTMAR} =~ /^\d+$/; - $printer->{EXTRA_GS_OPTIONS} =~ s/^"(.*)"/$1/; - $printer->{TEXTONLYOPTIONS} =~ s/^"(.*)"/$1/; - - return if !$in->ask_from_entries_refH('', _("Printer options"), [ -_("Paper Size") => { val => \$printer->{PAPERSIZE}, type => 'list', not_edit => !$::expert, list => \@printer::papersize_type }, + $printer->{RESOLUTION} = "Default" unless @list_res; + $printer->{CRLF} = $db_entry{DESCR} =~ /HP/; + $printer->{BITSPERPIXEL} = "Default" unless @list_col; + + $printer->{BITSPERPIXEL} = $depth_to_col{$printer->{BITSPERPIXEL}} || $printer->{BITSPERPIXEL}; #- translate. + + $in->ask_from_entries_refH('', _("Printer options"), [ +_("Paper Size") => { val => \$printer->{PAPERSIZE}, type => 'list', , not_edit => !$::expert, list => \@printer::papersize_type }, _("Eject page after job?") => { val => \$printer->{AUTOSENDEOF}, type => 'bool' }, @list_res > 1 ? ( -_("Resolution") => { val => \$printer->{RESOLUTION}, type => 'list', not_edit => !$::expert, list => \@res } ) : (), +_("Resolution") => { val => \$printer->{RESOLUTION}, type => 'list', , not_edit => !$::expert, list => \@res } ) : (), +_("Fix stair-stepping text?") => { val => \$printer->{CRLF}, type => "bool" }, @list_col > 1 ? ( $is_uniprint ? ( -_("Uniprint driver options") => { val => \$printer->{BITSPERPIXEL}, type => 'list', not_edit => 1, list => \@col } ) : ( -_("Color depth options") => { val => \$printer->{BITSPERPIXEL}, type => 'list', not_edit => 1, list => \@col } ), ) : (), -$db_entry{GSDRIVER} ne 'TEXT' && $db_entry{GSDRIVER} ne 'POSTSCRIPT' && $db_entry{GSDRIVER} ne 'ppa' ? ( -_("Print text as PostScript?") => { val => \$printer->{ASCII_TO_PS}, type => 'bool' }, ) : (), -#+_("Reverse page order") => { val => \$printer->{REVERSE_ORDER}, type => 'bool' }, -$db_entry{GSDRIVER} ne 'POSTSCRIPT' ? ( -_("Fix stair-stepping text?") => { val => \$printer->{CRLF}, type => 'bool' }, -) : (), -$db_entry{GSDRIVER} ne 'TEXT' ? ( -_("Number of pages per output pages") => { val => \$printer->{NUP}, type => 'list', not_edit => !$::expert, list => [1,2,4,8] }, -_("Right/Left margins in points (1/72 of inch)") => \$printer->{RTLFTMAR}, -_("Top/Bottom margins in points (1/72 of inch)") => \$printer->{TOPBOTMAR}, -) : (), -$::expert && $db_entry{GSDRIVER} ne 'TEXT' && $db_entry{GSDRIVER} ne 'POSTSCRIPT' ? ( -_("Extra GhostScript options") => \$printer->{EXTRA_GS_OPTIONS}, -) : (), -$::expert && $db_entry{GSDRIVER} ne 'POSTSCRIPT' ? ( -_("Extra Text options") => \$printer->{TEXTONLYOPTIONS}, -) : (), -]); - - $printer->{BITSPERPIXEL} = $col_to_depth{$printer->{BITSPERPIXEL}} || $printer->{BITSPERPIXEL}; #- translate back. +_("Uniprint driver options") => { val => \$printer->{BITSPERPIXEL}, type => 'list', , not_edit => !$::expert, list => \@col } ) : ( +_("Color depth options") => { val => \$printer->{BITSPERPIXEL}, type => 'list', , not_edit => !$::expert, list => \@col } ), ) : () +]);; + + $printer->{BITSPERPIXEL} = $col_to_depth{$printer->{BITSPERPIXEL}} || $printer->{BITSPERPIXEL}; #- translate. $printer->{complete} = 1; - printer::copy_printer_params($printer, $printer->{configured}{$printer->{QUEUE}} ||= {}); + copy_printer_params($printer, $printer->{configured}{$printer->{QUEUE}} ||= {}); printer::configure_queue($printer); $printer->{complete} = 0; - $action = $in->ask_from_list('', _("Do you want to test printing?"), sub { $action{$_[0]} }, \@action, 'done'); + $action = ${{reverse %action}}{$in->ask_from_list('', _("Do you want to test printing?"), + [ map { $action{$_} } @action ], $action{'done'})}; + my $pidlpd; my @testpages; push @testpages, "/usr/lib/rhs/rhs-printfilters/testpage.asc" if $action eq "ascii" || $action eq "both"; @@ -204,103 +232,29 @@ _("Extra Text options") => \$printer->{TEXTONLYOPTIONS}, if $action eq "ps" || $action eq "both"; if (@testpages) { - my @lpq_output; - { - my $w = $in->wait_message('', _("Printing test page(s)...")); + my $w = $in->wait_message('', _(@testpages > 1 ? "Printing tests pages..." : "Printing test page...")); - $upNetwork and do { &$upNetwork(); undef $upNetwork; sleep(1) }; - printer::restart_queue(printer::default_queue($printer->{QUEUE})); - @lpq_output = printer::print_pages(printer::default_queue($printer->{QUEUE}), @testpages); + #- restart lpd with blank spool queue. + foreach (("/var/spool/lpd/$printer->{QUEUE}/lock", "/var/spool/lpd/lpd.lock")) { + $pidlpd = (cat_("$prefix$_"))[0]; kill 'TERM', $pidlpd if $pidlpd; + unlink "$prefix$_"; } + run_program::rooted($prefix, "lprm", "-P$printer->{QUEUE}", "-"); sleep 1; + run_program::rooted($prefix, "lpd"); sleep 1; + + run_program::rooted($prefix, "lpr", "-P$printer->{QUEUE}", $_) foreach @testpages; + + sleep 3; #- allow lpr to send pages. + local *F; open F, "chroot $prefix/ /usr/bin/lpq -P$printer->{QUEUE} |"; + my @lpq_output = grep { !/^no entries/ && !(/^Rank\s+Owner/ .. /^\s*$/) } <F>; + undef $w; #- erase wait message window. if (@lpq_output) { - $action = $in->ask_yesorno('', _("Test page(s) have been sent to the printer daemon. -This may take a little time before printer start. -Printing status:\n%s\n\nDoes it work properly?", "@lpq_output"), 1) ? 'done' : 'change'; + $action = $in->ask_yesorno('', _("Is this correct? Printing status:\n%s", "@lpq_output"), 1) ? 'done' : 'change'; } else { - $action = $in->ask_yesorno('', _("Test page(s) have been sent to the printer daemon. -This may take a little time before printer start. -Does it work properly?"), 1) ? 'done' : 'change'; + $action = $in->ask_yesorno('', _("Is this correct?"), 1) ? 'done' : 'change'; } } } while ($action ne 'done'); $printer->{complete} = 1; } - -#- Program entry point. -sub main($$$;$) { - my ($printer, $in, $install, $upNetwork) = @_; - my ($queue, $continue) = ('', 1); - - while ($continue) { - if ($::beginner || !(scalar keys %{$printer->{configured} || {}})) { - $queue = $printer->{configured}{lp} || $in->ask_yesorno(_("Printer"), - _("Would you like to configure a printer?"), - $printer->{want}) ? 'lp' : 'Done'; - } else { - $queue = $in->ask_from_list_([''], -_("Here are the following print queues. -You can add some more or change the existing ones."), - [ (sort keys %{$printer->{configured} || {}}), __("Add"), __("Done") ], - ); - if ($queue eq 'Add') { - my %queues; @queues{map { split '\|', $_ } keys %{$printer->{configured}}} = (); - my $i = ''; while ($i < 100) { last unless exists $queues{"lp$i"}; ++$i; } - $queue = "lp$i"; - } - } - $queue eq 'Done' and last; - - &$install('rhs-printfilters') unless $::testing; - printer::read_printer_db(); - - printer::copy_printer_params($printer->{configured}{$queue}, $printer) if $printer->{configured}{$queue}; - $printer->{OLD_QUEUE} = $printer->{QUEUE} = $queue; #- keep in mind old name of queue (in case of changing) - - while ($continue) { - $printer->{TYPE} = 'LOCAL' unless $printer::printer_type_inv{$printer->{TYPE}}; - $printer->{str_type} = $printer::printer_type_inv{$printer->{TYPE}}; - if ($::beginner) { - $printer->{str_type} = - $in->ask_from_list_(_("Select Printer Connection"), - _("How is the printer connected?"), - [ keys %printer::printer_type ], - $printer->{str_type}, - ); - } else { - $in->ask_from_entries_refH([_("Select Printer Connection"), _("Ok"), $::beginner ? () : _("Remove queue")], -_("Every print queue (which print jobs are directed to) needs a -name (often lp) and a spool directory associated with it. What -name and directory should be used for this queue and how is the printer connected?"), [ -_("Name of queue") => { val => \$printer->{QUEUE} }, -_("Spool directory") => { val => \$printer->{SPOOLDIR} }, -_("Printer Connection") => { val => \$printer->{str_type}, not_edit => 1, list => [ keys %printer::printer_type ] }, - ], - changed => sub { - $printer->{SPOOLDIR} = "$printer::spooldir/" . - printer::default_queue($printer->{QUEUE}) unless $_[0]; - } - ) or delete $printer->{configured}{$queue}, $continue = 1, last; - } - $printer->{TYPE} = $printer::printer_type{$printer->{str_type}}; - - $continue = 0; - for ($printer->{TYPE}) { - /LOCAL/ and setup_local ($printer, $in, $install) and last; - /REMOTE/ and setup_remote($printer, $in, $install) and last; - /SMB/ and setup_smb ($printer, $in, $install) and last; - /NCP/ and setup_ncp ($printer, $in, $install) and last; - $continue = 1; last; - } - } - - #- configure ghostscript driver to be used. - if (!$continue && setup_gsdriver($printer, $in, $install, $printer->{TYPE} ne 'LOCAL' && $upNetwork)) { - delete $printer->{OLD_QUEUE} - if $printer->{QUEUE} ne $printer->{OLD_QUEUE} && $printer->{configured}{$printer->{QUEUE}}; - $continue = !$::beginner; - } else { - $continue = 1; - } - } -} |