home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / printer.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  10.9 KB  |  649 lines
  1. package printer;
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20.  
  21.  
  22.  
  23.  
  24.  
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39. use Data::Dumper;
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47. use common qw(:common :system);
  48. use commands;
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226. my $prefix = "";
  227.  
  228.  
  229. my $PRINTER_DB_FILE    = "/usr/lib/rhs/rhs-printfilters/printerdb";
  230. my $PRINTER_FILTER_DIR = "/usr/lib/rhs/rhs-printfilters";
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243. %printer_type = (
  244.     __("Local printer")     => "LOCAL",
  245.     __("Remote lpd")        => "REMOTE",
  246.     __("SMB/Windows 95/98/NT") => "SMB",
  247.     __("NetWare")           => "NCP",
  248. );
  249. %printer_type_inv = reverse %printer_type;
  250. $printer_type_default = "Local printer";
  251.  
  252. %fields = (
  253.     STANDARD => [qw(QUEUE SPOOLDIR IF)],
  254.     SPEC     => [qw(DBENTRY RESOLUTION PAPERSIZE BITSPERPIXEL CRLF)],
  255.     LOCAL    => [qw(DEVICE)],
  256.     REMOTE   => [qw(REMOTEHOST REMOTEQUEUE)],
  257.     SMB      => [qw(SMBHOST SMBHOSTIP SMBSHARE SMBUSER SMBPASSWD SMBWORKGROUP AF)],
  258.     NCP      => [qw(NCPHOST NCPQUEUE NCPUSER NCPPASSWD)],
  259. );
  260. @papersize_type = qw(letter legal ledger a3 a4);
  261. $spooldir       = "/var/spool/lpd";
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271. sub set_prefix($) { $prefix = $_[0]; }
  272.  
  273.  
  274.  
  275.  
  276.  
  277.  
  278. sub read_printer_db(;$) {
  279.     my $dbpath = $prefix . ($_[0] || $PRINTER_DB_FILE);
  280.  
  281.     %thedb and return;
  282.  
  283.     my %available_devices; 
  284.     local *AVAIL; open AVAIL, "chroot ". ($prefix || '/') ." /usr/bin/gs --help |";
  285.     foreach (<AVAIL>) {
  286.     if (/^Available devices:/ ... /^\S/) {
  287.         @available_devices{split /\s+/, $_} = () if /^\s+/;
  288.     }
  289.     }
  290.     delete $available_devices{''};
  291.     @available_devices{qw/POSTSCRIPT TEXT/} = (); 
  292.     close AVAIL;
  293.  
  294.     local $_; 
  295.     local *DBPATH; 
  296.     open DBPATH, $dbpath or die "An error has occurred on $dbpath : $!";
  297.  
  298.     while (<DBPATH>) {
  299.     if (/^StartEntry:\s(\w*)/) {
  300.         my $entryname = $1;
  301.         my $entry;
  302.  
  303.         $entry->{ENTRY} = $entryname;
  304.  
  305.       WHILE :
  306.           while (<DBPATH>) {
  307.         SWITCH: {
  308.               /GSDriver:\s*(\w*)/      and do { $entry->{GSDRIVER} = $1; last SWITCH };
  309.               /Description:\s*{(.*)}/  and do { $entry->{DESCR}    = $1; last SWITCH };
  310.               /About:\s*{(.*)}/        and do { $entry->{ABOUT}    = $1; last SWITCH };
  311.               /About:\s*{(.*)/
  312.             and do
  313.               {
  314.                   my $string = "$1\n";
  315.                   while (<DBPATH>) {
  316.                   /(.*)}/ and do { $entry->{ABOUT} = $string; last SWITCH };
  317.                   $string .= $_;
  318.                   }
  319.               };
  320.               /Resolution:\s*{(.*)}\s*{(.*)}\s*{(.*)}/
  321.             and do { push @{$entry->{RESOLUTION}}, { XDPI => $1, YDPI => $2, DESCR => $3 }; last SWITCH };
  322.               /BitsPerPixel:\s*{(.*)}\s*{(.*)}/
  323.             and do { push @{$entry->{BITSPERPIXEL}}, {DEPTH => $1, DESCR => $2}; last SWITCH };
  324.  
  325.               /EndEntry/ and last WHILE;
  326.           }
  327.           }
  328.         if (exists $available_devices{$entry->{GSDRIVER}}) {
  329.         $thedb{$entryname} = $entry;
  330.         $thedb_gsdriver{$entry->{GSDRIVER}} = $entry;
  331.         }
  332.     }
  333.     }
  334.  
  335.     @entries_db_short     = sort keys %printer::thedb;
  336.     @entry_db_description = map { $printer::thedb{$_}{DESCR} } @entries_db_short;
  337.     %descr_to_db          = map { $printer::thedb{$_}{DESCR}, $_ } @entries_db_short;
  338.     %db_to_descr          = reverse %descr_to_db;
  339.  
  340. }
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350. sub create_spool_dir($) {
  351.     my ($queue_path) = @_;
  352.     my $complete_path = "$prefix/$queue_path";
  353.  
  354.     unless (-d $complete_path) {
  355.     mkdir "$complete_path", 0755
  356.       or die "An error has occurred - can't create $complete_path : $!";
  357.     }
  358.  
  359.     
  360.     my $gid_lp = (getpwnam("lp"))[3];
  361.     chown 0, $gid_lp, $complete_path
  362.       or die "An error has occurred - can't chgrp $complete_path to lp $!";
  363. }
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371. sub create_config_file($$%) {
  372.     my ($inputfile, $outputfile, %toreplace) = @_;
  373.     template2file("$prefix/$inputfile", "$prefix/$outputfile", %toreplace);
  374. }
  375.  
  376.  
  377.  
  378.  
  379.  
  380. sub copy_master_filter($) {
  381.     my ($queue_path) = @_;
  382.     my $complete_path = "$prefix/$queue_path/filter";
  383.     my $master_filter = "$prefix/$PRINTER_FILTER_DIR/master-filter";
  384.  
  385.     eval { commands::cp('-f', $master_filter, $complete_path) }; 
  386.     $@ and die "Can't copy $master_filter to $complete_path $!";
  387. }
  388.  
  389.  
  390.  
  391.  
  392.  
  393. my $intro_printcap_test = "
  394. #
  395. # Please don't edit this file directly unless you know what you are doing!
  396. # Look at the printcap(5) man page for more info.
  397. # Be warned that the control-panel printtool requires a very strict format!
  398. # Look at the printcap(5) man page for more info.
  399. #
  400. # This file can be edited with the printtool in the control-panel.
  401. #
  402.  
  403. ";
  404.  
  405. sub read_configured_queue($) {
  406.     my ($entry) = @_;
  407.     my $current = undef;
  408.  
  409.     
  410.     local *PRINTCAP; open PRINTCAP, "$prefix/etc/printcap" or die "Can't open printcap file $!";
  411.     foreach (<PRINTCAP>) {
  412.     chomp;
  413.     my $p = '(?:\{(.*?)\}|(\S+))';
  414.     if (/^##PRINTTOOL3##\s+$p\s+$p\s+$p\s+$p\s+$p\s+$p\s+$p(?:\s+$p)?/) {
  415.         if ($current) {
  416.         add2hash($entry->{configured}{$current->{QUEUE}} ||= {}, $current);
  417.         $current = undef;
  418.         }
  419.         $current = {
  420.             TYPE => $1 || $2,
  421.             GSDRIVER => $3 || $4,
  422.             RESOLUTION => $5 || $6,
  423.             PAPERSIZE => $7 || $8,
  424.             
  425.             DBENTRY => $11 || $12,
  426.             BITSPERPIXEL => $13 || $14,
  427.             CRLF => $15 || $16,
  428.                };
  429.     } elsif (/^([^:]*):\\/) {
  430.         $current->{QUEUE} = $1;
  431.     } elsif (/^\s+:sd=([^:]*):\\/) {
  432.         $current->{SPOOLDIR} = $1;
  433.     } elsif (/^\s+:lp=([^:]*):\\/) {
  434.         $current->{DEVICE} = $1;
  435.     } elsif (/^\s+:rm=([^:]*):\\/) {
  436.         $current->{REMOTEHOST} = $1;
  437.     } elsif (/^\s+:rp=([^:]*):\\/) {
  438.         $current->{REMOTEQUEUE} = $1;
  439.     }
  440.     }
  441.     if ($current) {
  442.     add2hash($entry->{configured}{$current->{QUEUE}} ||= {}, $current);
  443.     $current = undef;
  444.     }
  445.  
  446.     
  447.     foreach (values %{$entry->{configured}}) {
  448.     if ($_->{TYPE} eq 'SMB') {
  449.         my $config_file = "$prefix$_->{SPOOLDIR}/.config";
  450.         local *F; open F, "$config_file" or die "Can't open $config_file $!";
  451.         foreach (<F>) {
  452.         chomp;
  453.         if (/^\s*share='\\\\(.*?)\\(.*?)'/) {
  454.             $_->{SMBHOST} = $1;
  455.             $_->{SMBSHARE} = $2;
  456.         } elsif (/^\s*hostip=(.*)/) {
  457.             $_->{SMBHOSTIP} = $1;
  458.         } elsif (/^\s*user='(.*)'/) {
  459.             $_->{SMBUSER} = $1;
  460.         } elsif (/^\s*password='(.*)'/) {
  461.             $_->{SMBPASSWD} = $1;
  462.         } elsif (/^\s*workgroup='(.*)'/) {
  463.             $_->{SMBWORKGROUP} = $1;
  464.         }
  465.         }
  466.     } elsif ($_->{TYPE} eq 'NCP') {
  467.         my $config_file = "$prefix$_->{SPOOLDIR}/.config";
  468.         local *F; open F, "$config_file" or die "Can't open $config_file $!";
  469.         foreach (<F>) {
  470.         chomp;
  471.         if (/^\s*server=(.*)/) {
  472.             $_->{NCPHOST} = $1;
  473.         } elsif (/^\s*user='(.*)'/) {
  474.             $_->{NCPUSER} = $1;
  475.         } elsif (/^\s*password='(.*)'/) {
  476.             $_->{NCPPASSWD} = $1;
  477.         } elsif (/^\s*queue='(.*)'/) {
  478.             $_->{NCPQUEUE} = $1;
  479.         }
  480.         }
  481.     }
  482.     }
  483. }
  484.  
  485. sub configure_queue($) {
  486.     my ($entry) = @_;
  487.  
  488.     $entry->{SPOOLDIR} ||= "$spooldir";
  489.     $entry->{IF}       ||= "$spooldir/$entry->{QUEUE}/filter";
  490.     $entry->{AF}       ||= "$spooldir/$entry->{QUEUE}/acct";
  491.  
  492.     my $queue_path      = "$entry->{SPOOLDIR}";
  493.     create_spool_dir($queue_path);
  494.  
  495.     my $get_name_file = sub {
  496.     my ($name) = @_;
  497.     ("$PRINTER_FILTER_DIR/$name.in", "$entry->{SPOOLDIR}/$name")
  498.     };
  499.     my ($filein, $file);
  500.     my %fieldname = ();
  501.     my $dbentry = $thedb{($entry->{DBENTRY})} or die "no dbentry";
  502.  
  503.  
  504.     ($filein, $file) = &$get_name_file("general.cfg");
  505.     $fieldname{ascps_trans} = ($dbentry->{GSDRIVER} eq "POSTSCRIPT") ? "YES" : "NO";
  506.     $fieldname{desiredto}   = ($dbentry->{GSDRIVER} ne "TEXT") ? "ps" : "asc";
  507.     $fieldname{papersize}   = $entry->{PAPERSIZE} ? $entry->{PAPERSIZE} : "letter";
  508.     $fieldname{printertype} = $entry->{TYPE};
  509.     create_config_file($filein, $file, %fieldname);
  510.  
  511.     
  512.     ($filein, $file) = &$get_name_file("postscript.cfg");
  513.     %fieldname = ();
  514.     $fieldname{gsdevice}       = $dbentry->{GSDRIVER};
  515.     $fieldname{papersize}      = $entry->{PAPERSIZE} ? $entry->{PAPERSIZE} : "letter";
  516.     $fieldname{resolution}     = $entry->{RESOLUTION};
  517.     $fieldname{color}          = $entry->{BITSPERPIXEL} ne "Default" &&
  518.       (($dbentry->{GSDRIVER} ne "uniprint" && "-dBitsPerPixel=") . $entry->{BITSPERPIXEL});
  519.     $fieldname{reversepages}   = "NO";
  520.     $fieldname{extragsoptions} = "";
  521.     $fieldname{pssendeof}      = $entry->{AUTOSENDEOF} ? ($dbentry->{GSDRIVER} eq "POSTSCRIPT" ? "YES" : "NO") : "NO";
  522.     $fieldname{nup}            = "1";
  523.     $fieldname{rtlftmar}       = "18";
  524.     $fieldname{topbotmar}      = "18";
  525.     create_config_file($filein, $file, %fieldname);
  526.  
  527.     
  528.     ($filein, $file) = &$get_name_file("textonly.cfg");
  529.     %fieldname = ();
  530.     $fieldname{textonlyoptions} = "";
  531.     $fieldname{crlftrans}       = $entry->{CRLF} ? "YES" : "";
  532.     $fieldname{textsendeof}     = $entry->{AUTOSENDEOF} ? ($dbentry->{GSDRIVER} eq "POSTSCRIPT" ? "NO" : "YES") : "NO";
  533.     create_config_file($filein, $file, %fieldname);
  534.  
  535.     if ($entry->{TYPE} eq "SMB") {
  536.     
  537.     my $config_file = "$prefix$queue_path/.config";
  538.     local *F;
  539.     open F, ">$config_file" or die "Can't create $config_file $!";
  540.     print F "share='\\\\$entry->{SMBHOST}\\$entry->{SMBSHARE}'\n";
  541.     print F "hostip=$entry->{SMBHOSTIP}\n";
  542.     print F "user='$entry->{SMBUSER}'\n";
  543.     print F "password='$entry->{SMBPASSWD}'\n";
  544.     print F "workgroup='$entry->{SMBWORKGROUP}'\n";
  545.     } elsif ($entry->{TYPE} eq "NCP") {
  546.     
  547.     my $config_file = "$prefix$queue_path/.config";
  548.     local *F;
  549.     open F, ">$config_file" or die "Can't create $config_file $!";
  550.     print F "server=$entry->{NCPHOST}\n";
  551.     print F "queue=$entry->{NCPQUEUE}\n";
  552.     print F "user=$entry->{NCPUSER}\n";
  553.     print F "password=$entry->{NCPPASSWD}\n";
  554.     }
  555.  
  556.     copy_master_filter($queue_path);
  557.  
  558.     
  559.     local *PRINTCAP;
  560.     if ($::testing) {
  561.     *PRINTCAP = *STDOUT;
  562.     } else {
  563.     open PRINTCAP, ">$prefix/etc/printcap" or die "Can't open printcap file $!";
  564.     }
  565.  
  566.     print PRINTCAP $intro_printcap_test;
  567.     foreach (values %{$entry->{configured}}) {
  568.     my $db_ = $thedb{($_->{DBENTRY})} or die "no dbentry";
  569.  
  570.     printf PRINTCAP "##PRINTTOOL3##  %s %s %s %s %s %s %s%s\n",
  571.       $_->{TYPE} || '{}',
  572.         $db_->{GSDRIVER} || '{}',
  573.           $_->{RESOLUTION} || '{}',
  574.         $_->{PAPERSIZE} || '{}',
  575.           '{}',
  576.             $db_->{ENTRY} || '{}',
  577.               $_->{BITSPERPIXEL} || '{}',
  578.             $_->{CRLF} ? " 1" : "";
  579.  
  580.     print PRINTCAP "$_->{QUEUE}:\\\n";
  581.     print PRINTCAP "\t:sd=$_->{SPOOLDIR}:\\\n";
  582.     print PRINTCAP "\t:mx#0:\\\n\t:sh:\\\n";
  583.  
  584.     if ($_->{TYPE} eq "LOCAL") {
  585.         print PRINTCAP "\t:lp=$_->{DEVICE}:\\\n";
  586.     } elsif ($_->{TYPE} eq "REMOTE") {
  587.         print PRINTCAP "\t:rm=$_->{REMOTEHOST}:\\\n";
  588.         print PRINTCAP "\t:rp=$_->{REMOTEQUEUE}:\\\n";
  589.     } else {
  590.         
  591.         print PRINTCAP "\t:lp=/dev/null:\\\n";
  592.         print PRINTCAP "\t:af=$_->{SPOOLDIR}/acct\\\n";
  593.     }
  594.  
  595.     
  596.     print PRINTCAP "\t:if=$_->{SPOOLDIR}/filter:\n";
  597.     print PRINTCAP "\n";
  598.     }
  599. }
  600.  
  601.  
  602.  
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609. sub test {
  610.     $::testing = 1;
  611.     $printer::prefix="";
  612.  
  613.     read_printer_db();
  614.  
  615.     print "the dump\n";
  616.     print Dumper(%thedb);
  617.  
  618.  
  619.     #
  620.     #eval { printer::create_spool_dir("/tmp/titi/", ".") };
  621.     #print $@;
  622.     #eval { printer::copy_master_filter("/tmp/titi/", ".") };
  623.     #print $@;
  624.     #
  625.     #
  626.     #eval { printer::create_config_file("files/postscript.cfg.in", "files/postscript.cfg","./",
  627.     #                    (
  628.     #                     gsdevice   => "titi",
  629.     #                     resolution => "tata",
  630.     #                    ));
  631.     #   };
  632.     #print $@;
  633.     #
  634.     #
  635.     #
  636.     #printer::configure_queue(\%printer::ex_printcap_entry, "/");
  637. }
  638.  
  639.  
  640.  
  641.  
  642. 1; #
  643.  
  644.  
  645.  
  646.  
  647.  
  648.  
  649.