#! /usr/bin/perl -w
# $Id: cups-genppdupdate.in,v 1.1 2003/01/11 16:57:34 rleigh Exp $
# Update CUPS PPDs for Gimp-Print queues.
# Copyright (C) 2002-2003 Roger Leigh (roger@whinlatter.uklinux.net)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use strict;
use Getopt::Std;
use Compress::Zlib;
use Fcntl qw(:mode);
use File::Temp qw(:POSIX);
use File::Copy qw(mv);

sub parse_options ();
sub update_ppd ($); # Original PPD filename
sub find_ppd ($$$); # PCFileName, language (e.g. en, sv) , region (e.g. GB, DE)
sub get_default_types (*); # Source PPD FH
sub get_defaults (*); # Source PPD FH
sub get_options (*\%); # Source PPD FH, default_types hash ref

our $opt_h; # Help
our $opt_n; # No action
our $opt_q; # Quiet mode
our $opt_s; # Source PPD location
our $opt_v; # Verbose mode

my $debug = 0;     # Set to 1 for debug messages
my $verbose = 0;   # Verbose output
if ($debug) {
    $verbose = 1;
}
my $quiet = 0;     # No output
my $no_action = 0; # Don't output files

my $ppd_dir = "/etc/cups/ppd"; # Location of in-use CUPS PPDs
my $ppd_base_dir = "/usr/share/cups/model/gimp-print"; # Available PPDs
my $gzext = ".gz";

my @ppd_files; # A list of in-use Gimp-Print PPD files

# Used to convert a language name to its two letter code
my %languagemappings = (
			"chinese"    => "cn",
			"danish"     => "da",
			"dutch"      => "nl",
			"english"    => "en",
			"finnish"    => "fi",
			"french"     => "fr",
			"german"     => "de",
			"greek"      => "el",
			"italian"    => "it",
			"japanese"   => "jp",
			"norwegian"  => "no",
			"polish"     => "pl",
			"portuguese" => "pt",
			"russian"    => "ru",
			"slovak"     => "sk",
			"spanish"    => "es",
			"swedish"    => "sv",
			"turkish"    => "tr"
);


# Check command-line options...

parse_options();


# Set a secure umask...

umask 0177;


# Find all in-use Gimp-Print PPD files...

open PPDFILES, "grep -i -l GIMP-print $ppd_dir/*|" or die "can't grep $ppd_dir/*: $!";
while (<PPDFILES>) {
    chomp;
    push @ppd_files,  $_;
}
close PPDFILES or ($! == 0) or die "can't close grep pipe: $!";


# Update each of the Gimp-Print PPDs, where possible...

foreach (@ppd_files) {
    update_ppd($_);

}

if (!$quiet || $verbose) {
    print STDOUT "Reload cupsd for the changes to take effect.\n";
}



sub parse_options () {
    getopts("hnqs:v");

    if ($opt_n) {
	$no_action = 1;
    }
    if ($opt_s) {
	if (-d $opt_s) {
	    $ppd_base_dir = "$opt_s";
	}
	else {
	    die "$opt_s: invalid directory: $!";
	}
    }
    if ($opt_v) {
	$verbose = 1;
	$quiet = 0;
    }
    if ($opt_q) {
	$verbose = 0;
	$quiet = 1;
    }
    if ($opt_h) {
	print "Usage: $0 [OPTION]...\n";
	print "Update CUPS+Gimp-Print PPD files.\n\n";
        print "  -h          Display this help text\n";
	print "  -n          No-action.  Don't overwrite any PPD files.\n";
	print "  -q          Quiet mode.  No messages except errors.\n";
	print "  -s ppd_dir  Use ppd_dir as the source PPD directory.\n";
	print "  -v          Verbose messages.\n";
	exit (0);
    }
}


# Update the named PPD file.
sub update_ppd ($) {
    my $ppd_source_filename = $_;

    open ORIG, $_ or die "$_: can't open PPD file: $!";
    seek (ORIG, 0, 0) or die "can't seek to start of PPD file";
    # Get the `PCFileName'; the new source PPD will have the same name.
    my $filename;
    while (<ORIG>) {
	if ( /^\*PCFileName/ ) {
	    ($filename) = m/^\*PCFileName:\s*"(.*)"/;
	}
    }
    if ($debug) {
	print "PCFileName: $filename\n";
    }

    # Get the `LanguageVersion'; the language of the PPD.
    my $locale;
    seek (ORIG, 0, 0) or die "can't seek to start of PPD file";
    # Get the `PCFileName'; the new source PPD will have the same name.
    while (<ORIG>) {
	if ( /\*LanguageVersion/ ) {
	    ($locale) = m/^\*LanguageVersion:\s*(.*)$/;
	}
    }
    if ($debug) {
	print "LanguageVersion: $locale\n";
    }
    # Split into the language and territory.
    my($langname, $region) = split(/-/, $locale);
    # Convert language into language code.
    my $langcode = $languagemappings{"\L$langname"};
    if (!defined($langcode)) {
	$langcode = "C"; # Fallback if there isn't one.
    }
    if ($debug) {
	print "Language name: $langcode\n";
    }
    # If no territory was specified, make it blank.
    if (!defined($region)) {
	$region = "";
    }
    if ($debug) {
	print "Region: $region\n";
    }


    # Search for a PPD matching our criteria...

    my $source = find_ppd($filename, $langcode, $region);
    if (!defined($source)) {
        # There wasn't a valid source PPD file, so give up.
	print STDERR "$_: no valid candidate for replacement, skipping\n";
	print STDERR "$_: please upgrade this PPD manually\n";
	return;
    }
    if ($debug) {
	print "Candidate PPD: $source\n";
    }


    # Read in the new PPD, decompressing it if needed...

    my $source_data;

    my $suffix = "\\" . $gzext; # Add '\', so m// matches the '.'.
    if ($source =~ m/.gz$/) { # Decompress input buffer
	my $gz = gzopen($source, "rb")
	    or die "$_: can't open for decompression: $gzerrno";
	my $tmp;
	$ source_data .= $tmp while $gz->gzread($tmp);
	die "$_: can't decompress file: $gzerrno" if $gzerrno != Z_STREAM_END ;
	$gz->gzclose();
    }
    else {
	open SOURCE, $source
	    or die "$source: can't open source file: $!";
	binmode SOURCE;
	my $source_size = (stat(SOURCE))[7];
	read (SOURCE, $source_data, $source_size)
	    or die "$source: error reading source: $!";
	close SOURCE or die "$source: can't close file: $!";
    }

    # Save new PPD in a temporary file, for processing...

    my($tmpfile, $tmpfilename) = tmpnam();
    chown(0, 0, $tmpfilename); # root.root
    chmod(0644, $tmpfilename);
    unlink $tmpfilename or die "can'r unlink temporary file $tmpfile: $!";
    print $tmpfile $source_data;




    # Extract the default values from the original PPD...

    my %orig_default_types = get_default_types(ORIG);
    my %new_default_types = get_default_types($tmpfile);
    my %defaults = get_defaults(ORIG);
    my %options = get_options($tmpfile, %new_default_types);


    # Close original and temporary files...

    close ORIG or die "$_: can't close file: $!";
    close $tmpfile or die "can't close temporary file $tmpfile: $!";


    if ($debug) {
	print "Original Default Types:\n";
	foreach (sort keys %orig_default_types) {
	    print "  $_: $orig_default_types{$_}\n";
	}
	print "New Default Types:\n";
	foreach (sort keys %new_default_types) {
	    print "  $_: $new_default_types{$_}\n";
	}
	print "Defaults:\n";
	foreach (sort keys %defaults) {
	    print "  $_: $defaults{$_}\n";
	}
	print "Options:\n";
	foreach (sort keys %options) {
	    print "  $_:  ";
	    foreach my $opt (@{$options{$_}}) {
		print "$opt ";
	    }
	    print "\n";
	}

    }

    # Update source buffer with old defaults...

    # Loop through each default in turn.
default_loop:
    foreach (sort keys %defaults) {
	my $default_option = $_;
	my $option;
	($option = $_) =~ s/Default//; # Strip off `Default'
	# Check method is valid
	my $orig_method = $orig_default_types{$option};
	my $new_method = $new_default_types{$option};
	if ((!defined($orig_method) || !defined($new_method)) ||
	    $orig_method ne $new_method) {
	    next;
	}
	if ($new_method eq "PickOne") {
            # Check the old setting is valid
	    foreach (@{$options{$option}}) {
		if ($defaults{$default_option} eq $_) { # Valid option
		    # Set the option in the new PPD
		    $source_data =~ s/\*($default_option).*/*$1:$defaults{$default_option}/m;
		    if ($verbose) {
			print "$ppd_source_filename: Set *$default_option to $defaults{$default_option}\n";
		    }
		    next default_loop;
		}
	    }
	    printf STDERR
		"$ppd_source_filename: Invalid option: *$default_option: $defaults{$default_option}.  Skipped.\n";
	    next;
	}
	print STDERR
	    "$ppd_source_filename: PPD OpenUI method $new_default_types{$_} not understood.  Skipped\n";
    }


    # Write new PPD...

    # unlinking the original and replace with the new version
    unlink $ppd_source_filename or die "can't unlink $ppd_source_filename: $!";
    open NEWPPD, "> $ppd_source_filename" or die "can't open $ppd_source_filename for writing: $!";
    print NEWPPD $source_data;
    chown(0, 0, $ppd_source_filename);
    chmod(0644, $ppd_source_filename);
    close NEWPPD or die "can't close $ppd_source_filename: $!";

    if (!$quiet || $verbose) {
	print STDOUT "Updated $ppd_source_filename using $source\n";
    }
    # All done!
}

# Find a suitable source PPD file
sub find_ppd ($$$) {
    my($pcfilename, $lang, $region) = @_;
    my $file; # filename to return

    # All possible candidates, in order of usefulness and gzippedness
    foreach ("$ppd_base_dir/${lang}_$region/$pcfilename$gzext",
	     "$ppd_base_dir/${lang}_$region/$pcfilename",
	     "$ppd_base_dir/$lang/$pcfilename$gzext",
	     "$ppd_base_dir/$lang/$pcfilename",
	     "$ppd_base_dir/en/$pcfilename$gzext",
	     "$ppd_base_dir/en/$pcfilename",
	     "$ppd_base_dir/C/$pcfilename$gzext",
	     "$ppd_base_dir/C/$pcfilename",
	     "$ppd_base_dir/$pcfilename$gzext",
	     "$ppd_base_dir/$pcfilename"
	     ) {
        # Check it's a regular file, owned by root.root, not writable
        # by other, and is readable by root.  i.e. the file is secure.
	my @sb = stat or next;
	if (S_ISREG($sb[2]) && ($sb[4] == 0) && ($sb[5] == 0)) {
#	    !(S_IWOTH & $sb[2]) && (S_IRUSR & $sb[2])) {
	    return $_;
	}
	else {
	    print STDERR "$_: not a regular file, or insecure ownership and permissions.  Skipped\n";
	}
    }
# Yikes!  Can't find a valid PPD file!
    return undef;
}

# Return the default options from the given PPD filename
sub get_default_types(*) {
    my $fh = $_[0];
    my %default_types;

    # Read each line of the original PPD file, and store all OpenUI
    # names and their types in a hash...
    seek ($fh, 0, 0) or die "can't seek to start of PPD file";
    while (<$fh>) {
	if ( m/^\*OpenUI/ ) {
	    chomp;
	    my ($key, $value) = /^\*OpenUI\s\*([[:alnum:]]+).*:\s([[:alnum:]]+)/;
	    if ($key && $value) {
		$default_types{$key}=$value;
	    }
	}
    }
    return %default_types;
}


# Return the default options from the given PPD filename
sub get_defaults(*) {
    my $fh = $_[0];
    my %defaults;

    # Read each line of the original PPD file, and store all default
    # names and their values in a hash...
    seek ($fh, 0, 0) or die "can't seek to start of PPD file";
    while (<$fh>) {
	if ( m/^\*Default/ ) {
	    chomp;
	    my($key, $value) = /^\*([[:alnum:]]+):\s*([[:alnum:]]+)/;
	    if ($key && $value) {
		$defaults{$key}=$value;
	    }
	}
    }
    return %defaults;
}


# Return the available options from the given PPD filename
sub get_options(*\%) {
    my $fh = $_[0];
    my $validopts = $_[1];
    my %options;

    # For each valid option name, grab each valid option for that name
    # and store in a hash of arrays...

    foreach (sort keys %$validopts) {
	my $tmp = $_;
	my @optionlist;

	seek ($fh, 0, 0) or die "can't seek to start of PPD file";
	while (<$fh>) {
	    if ( m/^\*$tmp/ ) {
		chomp;
		my ($value) = /^\*$tmp\s*([[:alnum:]]+)[\/:]/;
		if ($value) {
		    push @optionlist, $value;
		}
	    }
	}
	if (@optionlist) {
	    $options{$tmp} = [ @optionlist ];
	}
    }
    return %options;
}
