1#! @PERL@ -w
2# Update CUPS PPDs for Gutenprint queues.
3# Copyright (C) 2002-2003 Roger Leigh (rleigh@debian.org)
4#
5# This program is free software; you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation; either version 2, or (at your option)
8# any later version.
9#
10# This program is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13# GNU General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program.  If not, see <https://www.gnu.org/licenses/>.
17
18use strict;
19use Getopt::Long;
20use Fcntl qw(:mode);
21use FileHandle;
22use IPC::Open2;
23
24sub parse_options ();
25sub get_driver_version ();
26sub update_ppd ($); # Original PPD filename
27sub get_ppd_fh ($$$$$); # Return contents of desired PPD
28sub find_ppd ($$$$); # Gutenprint Filename, driver, language (e.g. en, sv),
29		     # region (e.g. GB, DE)
30sub get_ppd_data (*$$$$$); # Source PPD FH
31
32our $opt_d; # Debug mode
33our $opt_h; # Help
34our $opt_n; # No action
35our $opt_q; # Quiet mode
36our $opt_s; # Source PPD location
37our $opt_p; # New PPD location
38our $opt_P; # PPD generator location
39our $opt_v; # Verbose mode
40our $opt_N; # Don't update PPD file options
41our $opt_o; # Output directory
42our $opt_r; # Gutenprint version
43our $opt_i; # Interactive
44our $opt_f; # Force upgrade
45our $opt_l; # Language
46our $opt_x; # Allow update across major.minor version
47
48my $debug = 0;
49my $verbose = 0;   # Verbose output
50my $interactive = 0;
51my $quiet = 0;     # No output
52my $no_action = 0; # Don't output files
53my $reset_defaults = 0;		# Reset options to default settings
54my $version = "@GUTENPRINT_MAJOR_VERSION@.@GUTENPRINT_MINOR_VERSION@";
55my $micro_version = "@GUTENPRINT_VERSION@";
56my $use_static_ppd = "@BUILD_CUPS_PPDS@";
57my $file_version = '"@VERSION@"$';
58
59my $system_ppd_dir = "@cups_conf_serverroot@/ppd";# Location of in-use CUPS PPDs
60my $ppd_dir = $system_ppd_dir; # Location of in-use CUPS PPDs
61my $ppd_root_dir = "@cups_conf_datadir@/model";
62my $ppd_base_dir = "$ppd_root_dir/gutenprint/$version"; # Available PPDs
63my $ppd_out_dir = "";		# By default output into source directory
64my $gzext = ".gz";
65my $updated_ppd_count = 0;
66my $skipped_ppd_count = 0;
67my $failed_ppd_count = 0;
68my $exit_after_parse_args = 0;
69my @languages = qw(Global C @ALL_LINGUAS@);
70
71my $serverdir = "@cups_conf_serverbin@";
72my $driver_bin = "$serverdir/driver/gutenprint.$version";
73my $driver_version = "";
74my $server_multicat = 0;
75my $server_multicat_initialized = 0;
76
77if (-x $driver_bin) {
78    get_driver_version();
79}
80
81my @ppd_files; # A list of in-use Gutenprint PPD files
82
83# Used to convert a language name to its two letter code
84my %languagemappings = (
85			"chinese"    => "cn",
86			"danish"     => "da",
87			"dutch"      => "nl",
88			"english"    => "en",
89			"finnish"    => "fi",
90			"french"     => "fr",
91			"german"     => "de",
92			"greek"      => "el",
93			"hungarian"  => "hu",
94			"italian"    => "it",
95			"japanese"   => "jp",
96			"norwegian"  => "no",
97			"polish"     => "pl",
98			"portuguese" => "pt",
99			"russian"    => "ru",
100			"slovak"     => "sk",
101			"spanish"    => "es",
102			"swedish"    => "sv",
103			"turkish"    => "tr"
104);
105
106
107# Check command-line options...
108
109parse_options();
110
111
112# Set a secure umask...
113
114umask 0177;
115
116
117# Find all in-use Gutenprint PPD files...
118# For case-insensitive filesystems, use only one of .ppd and .PPD
119# (bug 1929738).
120
121if (@ARGV) {
122    my $f;
123    foreach $f (@ARGV) {
124	if (-f $f and ($f =~ /\.ppd$/i or $f =~ /\//)) {
125	    if (-f $f) {
126		push @ppd_files, $f;
127	    } else {
128		print STDERR "Cannot find file $f\n";
129	    }
130	} elsif (-f "$ppd_dir/$f" or
131		 -f "$ppd_dir/$f.ppd" or
132		 -f "$ppd_dir/$f.PPD") {
133	    if (-f "$ppd_dir/$f") {
134		push @ppd_files, "$ppd_dir/$f";
135	    } elsif (-f "$ppd_dir/$f.ppd") {
136		push @ppd_files, "$ppd_dir/$f.ppd";
137	    } elsif (-f "$ppd_dir/$f.PPD") {
138		push @ppd_files, "$ppd_dir/$f.PPD";
139	    }
140	}  else {
141	    print STDERR "Cannot find file $ppd_dir/$f, $ppd_dir/$f.ppd, or $ppd_dir/$f.PPD\n";
142	}
143    }
144} else {
145    my @ppdtmp = glob("$ppd_dir/*.{ppd,PPD}");
146    my (%ppd_map);
147    map { $ppd_map{$_} = 1 } @ppd_files;
148    foreach my $f (@ppdtmp) {
149	if ($f =~ /\.PPD$/) {
150	    my ($g) = $f;
151	    $g =~ s/\.PPD$/.ppd/;
152	    if (! $ppd_map{$g}) {
153		push @ppd_files, $f;
154	    }
155	} else {
156	    push @ppd_files, $f;
157	}
158    }
159}
160
161# Update each of the Gutenprint PPDs, where possible...
162
163foreach (@ppd_files) {
164    my ($status) = update_ppd($_);
165    last if ($status == -2);
166    $failed_ppd_count++ if ($status == 0);
167    $updated_ppd_count++ if ($status == 1);
168    $skipped_ppd_count++ if ($status == -1);
169}
170
171if (!$quiet || $verbose) {
172    if (!@ppd_files) {
173	print STDOUT "No Gutenprint PPD files to update.\n";
174    } elsif ($updated_ppd_count > 0) {
175	my $plural = $updated_ppd_count == 1 ? "" : "s";
176	print STDOUT "Updated $updated_ppd_count PPD file${plural}";
177	if ($failed_ppd_count > 0) {
178	    print STDOUT ", $failed_ppd_count failed";
179	}
180	if ($skipped_ppd_count > 0) {
181	    print STDOUT ", $skipped_ppd_count skipped";
182	}
183	print STDOUT ".";
184	if ($ppd_out_dir eq $system_ppd_dir ||
185	    ($ppd_dir eq $system_ppd_dir && $ppd_out_dir eq "")) {
186	    print STDOUT "  Restart cupsd for the changes to take effect.";
187	}
188	print STDOUT "\n";
189    } else {
190	if ($failed_ppd_count > 0) {
191	    print STDOUT "Failed to update any PPD files\n";
192	} else {
193	    print STDOUT "Did not update any PPD files\n";
194	}
195    }
196}
197exit ($failed_ppd_count > 0);
198
199sub HELP_MESSAGE($;$$$) {
200    my ($fh) = @_;
201    print $fh "Usage: $0 [OPTION]... [PPD_FILE]...\n";
202    print $fh "Update CUPS+Gutenprint PPD files.\n\n";
203    print $fh "  -d flags    Enable debugging\n";
204    print $fh "  -h          Display this help text\n";
205    print $fh "  -n          No-action.  Don't overwrite any PPD files.\n";
206    print $fh "  -q          Quiet mode.  No messages except errors.\n";
207    print $fh "  -s ppd_dir  Use ppd_dir as the source PPD directory.\n";
208    print $fh "  -p ppd_dir  Update PPD files in ppd_dir.\n";
209    print $fh "  -P driver   Use the specified driver binary to generate PPD files.\n";
210    print $fh "  -v          Verbose messages.\n";
211    print $fh "  -N          Reset options to defaults.\n";
212    print $fh "  -o out_dir  Output PPD files to out_dir.\n";
213    print $fh "  -r version  Use PPD files for Gutenprint major.minor version.\n";
214    print $fh "  -f          Ignore new PPD file safety checks.\n";
215    print $fh "  -i          Prompt (interactively) for each PPD file.\n";
216    print $fh "  -x          Allow update across major Gutenprint releases.\n";
217    print $fh "  -l language Language choice (Gutenprint 5.1 or below).\n";
218    print $fh "              Choices: " . join(" ", @languages) . "\n";
219    print $fh "              Or -loriginal to preserve original language\n";
220    print $fh "                 with Gutenprint 5.2 or above\n";
221    exit(0);
222}
223
224# Getopt::Std calls VERSION_MESSAGE followed by HELP_MESSAGE if --help
225# is passed.  If --version is passed, it calls only VERSION_MESSAGE.
226# So we have to make sure to exit, but we want to allow --help to
227# print out the help message.
228sub VERSION_MESSAGE($;$$$) {
229    my ($fh) = @_;
230    print "cups-genppdupdate from Gutenprint $micro_version\n";
231    $exit_after_parse_args = 1;
232}
233
234sub help() {
235    HELP_MESSAGE(\*STDOUT);
236}
237
238sub check_multicat() {
239}
240
241sub get_driver_version() {
242    open(DBIN, "$driver_bin org.gutenprint.extensions 2>/dev/null |") or return 0;
243    my ($line);
244    $server_multicat = 0;
245    while ($line = <DBIN>) {
246	if ($line =~ /^org.gutenprint.multicat$/) {
247	    $server_multicat = 1;
248	    last;
249	}
250    }
251    close DBIN;
252    $driver_version = `$driver_bin VERSION`;
253    chomp $driver_version;
254}
255
256sub parse_options () {
257    Getopt::Long::Configure("bundling");
258    if (!GetOptions("d=i" => \$opt_d,
259                    "h" => \$opt_h,
260                    "n" => \$opt_n,
261                    "q" => \$opt_q,
262                    "s=s" => \$opt_s,
263                    "p=s" => \$opt_p,
264                    "P=s" => \$opt_P,
265                    "v" => \$opt_v,
266		    "x" => \$opt_x,
267                    "N" => \$opt_N,
268                    "o=s" => \$opt_o,
269                    "r=s" => \$opt_r,
270                    "f" => \$opt_f,
271                    "i" => \$opt_i,
272                    "l=s" => \$opt_l,
273                    "version" => sub { VERSION_MESSAGE(\*STDOUT) },
274                    "help" => sub { VERSION_MESSAGE(\*STDOUT); HELP_MESSAGE(\*STDOUT) })) {
275	help();
276    }
277    if ($opt_n) {
278	$no_action = 1;
279    }
280    if ($opt_d) {
281	$debug = $opt_d;
282    }
283    if ($opt_v) {
284	$verbose = 1;
285	$quiet = 0;
286    }
287    if ($opt_q) {
288	$verbose = 0;
289	$quiet = 1;
290    }
291    if ($opt_N) {
292	$reset_defaults = 1;
293    }
294    if ($opt_o) {
295	if (-d $opt_o) {
296	    $ppd_out_dir = "$opt_o";
297	}
298	else {
299	    die "$opt_o: invalid directory: $!\n";
300	}
301    }
302    if ($opt_r) {
303	if ($version ne $opt_r) {
304	    $version = $opt_r;
305	    if ($opt_s) {
306		if (-d $opt_s) {
307		    $ppd_base_dir = "$opt_s";
308		    $driver_bin = "";
309		    $server_multicat = 0;
310		    $use_static_ppd = "yes";
311		} else {
312		    die "$opt_s: invalid directory: $!\n";
313		}
314	    } else {
315		$ppd_base_dir = "$ppd_root_dir/gutenprint/$version";
316		$driver_bin = "$serverdir/driver/gutenprint.$version";
317	    }
318	    $driver_version = "";
319	    # If user specifies version, we're not going to be able to check
320	    # for an exact match.
321	    $file_version = "\"$version";
322	    if (-x $driver_bin) {
323		get_driver_version();
324		$use_static_ppd = "no";
325		$file_version = "\"$driver_version\"\$";
326	    } elsif (! -d $ppd_base_dir && ! -l $ppd_base_dir) {
327		die "Gutenprint $version does not appear to be installed!\n";
328	    }
329	}
330    }
331    if ($opt_s) {
332	if (-d $opt_s) {
333	    $ppd_base_dir = "$opt_s";
334	    $driver_bin = "";
335	    $server_multicat = 0;
336	    $driver_version = "";
337	    $use_static_ppd = "yes";
338	}
339	else {
340	    die "$opt_s: invalid directory: $!\n";
341	}
342    }
343    if ($opt_p) {
344	if (-d $opt_p) {
345	    $ppd_dir = "$opt_p";
346	}
347	else {
348	    die "$opt_p: invalid directory: $!\n";
349	}
350    }
351    if ($opt_P) {
352	if (-x $opt_P) {
353	    $driver_bin = "$opt_P";
354	    get_driver_version();
355	    $use_static_ppd = "no";
356	}
357	else {
358	    die "$opt_P: invalid executable: $!\n";
359	}
360    }
361    if ($opt_h) {
362	help();
363    }
364    if ($opt_l && lc $opt_l ne "original" && ! grep { $_ eq $opt_l } @languages) {
365	print STDERR "Unknown language '$opt_l'\n";
366	help();
367    }
368    if ($opt_i) {
369	$interactive = 1;
370    }
371    if ($exit_after_parse_args) {
372	exit(0);
373    }
374    if ($verbose && $driver_version ne "") {
375	print STDOUT "Updating PPD files from Gutenprint $driver_version\n";
376    }
377}
378
379sub get_ppd_fh($$$$$) {
380    my ($ppd_source_filename, $filename, $driver, $locale, $region) = @_;
381
382    my $source_data;
383    my ($new_ppd_filename);
384
385    if ($use_static_ppd eq "no" && $driver_version ne "") {
386	my ($simplified);
387	if ($filename =~ m,.*/([^/]*)(.sim)(.ppd)?(.gz)?$,) {
388	    $simplified = "simple";
389	} else {
390	    $simplified = "expert";
391	}
392	my ($url);
393	my (@url_list);
394	if (((defined $opt_r && $opt_r < 5.2) ||
395	     (defined $opt_l && $opt_l ne "")) &&
396	    $locale ne "") {
397	    if ($region) {
398		push @url_list, "gutenprint.$version://$driver/$simplified/${locale}_${region}";
399	    }
400	    push @url_list, "gutenprint.$version://$driver/$simplified/${locale}";
401	}
402	push @url_list, "gutenprint.$version://$driver/$simplified";
403	foreach $url (@url_list) {
404	    $new_ppd_filename = $url;
405	    if ($debug & 8) {
406		print "Trying ", (! $server_multicat ? "$driver_bin cat " : ""), "$url for $driver, $simplified, $locale, $region\n";
407	    }
408	    if ($server_multicat) {
409		if (! $server_multicat_initialized) {
410		    my ($pid) = open2(*Reader, *Writer, "$driver_bin org.gutenprint.multicat");
411		    $server_multicat_initialized = 1;
412		}
413		print Writer "$url\n";
414		return ($new_ppd_filename, \*Reader);
415	    }
416	    if (open PPD, "$driver_bin cat $url |") {
417		return ($new_ppd_filename, \*PPD);
418	    }
419	}
420	# Otherwise fall through and try to find a static PPD
421    }
422
423    # Search for a PPD matching our criteria...
424
425    $new_ppd_filename = find_ppd($filename, $driver, $locale, $region);
426    if (!defined($new_ppd_filename)) {
427        # There wasn't a valid source PPD file, so give up.
428        print STDERR "$ppd_source_filename: no valid candidate for replacement.  Skipping\n";
429        print STDERR "$ppd_source_filename: please upgrade this PPD manually\n";
430	return ("", undef);
431    }
432    if ($debug & 1) {
433	print "Candidate PPD: $new_ppd_filename\n";
434    }
435
436    my $suffix = "\\" . $gzext; # Add '\', so m// matches the '.'.
437    if ($new_ppd_filename =~ m/.gz$/) { # Decompress input buffer
438	open GZIN, "gunzip -c $new_ppd_filename |"
439	    or die "$_: can't open for decompression: $!";
440	return ($new_ppd_filename, \*GZIN);
441    } else {
442	open SOURCE, $new_ppd_filename
443	    or die "$new_ppd_filename: can't open source file: $!";
444	binmode SOURCE;
445	return ($new_ppd_filename, \*SOURCE);
446    }
447}
448
449# Update the named PPD file.
450sub update_ppd ($) {
451    my $ppd_source_filename = $_;
452    my $ppd_dest_filename = $ppd_source_filename;
453    if ($ppd_out_dir) {
454	$ppd_dest_filename =~ s;(.*)/([^/]+);$2;;
455	$ppd_dest_filename = "$ppd_out_dir/$ppd_dest_filename";
456    }
457
458    open ORIG, $_ or die "$_: can't open PPD file: $!";
459    seek (ORIG, 0, 0) or die "can't seek to start of PPD file: $!";
460    my @orig_metadata = stat(ORIG);
461    if ($debug & 1) {
462	print "Source Filename: $ppd_source_filename\n";
463    }
464    my ($filename) = "";
465    my ($driver) = "";
466    my ($gutenprintdriver) = "";
467    my ($locale) = "";
468    my ($lingo) = "";
469    my ($region) = "";
470    my ($valid) = 0;
471    my ($orig_locale) = "";
472    while (<ORIG>) {
473	if (/\*StpLocale:/) {
474	    ($locale) = m/^\*StpLocale:\s*\"(.*)\"$/;
475	    $orig_locale = $locale;
476	    $valid = 1;
477	} elsif (/^\*LanguageVersion/) {
478	    ($lingo) = m/^\*LanguageVersion:\s*(.*)$/;
479	} elsif (/^\*StpDriverName:/ ) {
480	    ($driver) = m/^\*StpDriverName:\s*\"(.*)\"$/;
481	    $valid = 1;
482	} elsif (/\*%End of / && $driver eq "") {
483	    ($driver) = m/^\*%End of\s*(.*).ppd$/;
484	} elsif (/^\*StpPPDLocation:/ ) {
485	    ($filename) = m/^\*StpPPDLocation:\s*\"(.*)\"$/;
486	    $valid = 1;
487	} elsif (/^\*%Gutenprint Filename:/) {
488	    $valid = 1;
489	}
490	if ($filename and $driver and $lingo and $locale) {
491	    last;
492	}
493	if (! $valid && /^\*OpenUI/) {
494	    last;
495	}
496    }
497    if (! $valid) {
498#	print STDERR "Skipping $ppd_source_filename: not a Gutenprint PPD file\n";
499	return -1;
500    }
501    if (defined $opt_l && $opt_l ne "" && lc $opt_l ne "original") {
502	$locale = $opt_l;
503	$orig_locale = $locale;
504    }
505    if ($debug & 2) {
506	print "Gutenprint Filename: $filename\n";
507	if ($opt_l) {
508	    print "Locale: $locale (from -l)\n";
509	} else {
510	    print "Locale: $locale\n";
511	}
512	print "Language: $lingo\n";
513	print "Driver: $driver\n";
514    }
515    if ($locale) {
516	# Split into the language and territory.
517	($locale, $region) = split(/_/, $locale);
518    } else {
519	# Split into the language and territory.
520	($locale, $region) = split(/_/, $lingo);
521	# Convert language into language code.
522	$locale = $languagemappings{"\L$lingo"};
523	if (!defined($locale)) {
524	    $locale = "C"; # Fallback if there isn't one.
525	}
526    }
527    if (! defined($region)) {
528	$region = "";
529    }
530    if ($debug & 2) {
531	print "Base Locale: $locale\n";
532	print "Region: $region\n";
533    }
534
535    # Read in the new PPD, decompressing it if needed...
536
537    my ($new_ppd_filename, $source_fd) =
538	get_ppd_fh($ppd_source_filename, $filename, $driver, $locale, $region);
539
540    if (! defined $source_fd) {
541	print "Unable to retrieve PPD file for $ppd_source_filename!\n";
542	close ORIG;
543	return 0;
544    }
545
546    my ($ndt, $nopt, $nres, $ndef, $source_data, $new_fileversion) = get_ppd_data($source_fd, 1, 1, 1, 1, 1);
547    my $new_majversion = $new_fileversion;
548    $new_majversion =~ s/^([[:digit:]]+\.[[:digit:]]).*/$1/;
549    if (! defined $ndt) {
550	print "Unable to retrieve PPD file for $ppd_source_filename!\n";
551	close ORIG;
552	return 0;
553    }
554
555    # Extract the default values from the original PPD...
556
557    seek(ORIG, 0, 0);
558
559    my ($odt, $oopt, $ores, $odef, $ignore, $old_fileversion) = get_ppd_data(ORIG, 1, 0, 1, 1, 0);
560    my $old_majversion = $old_fileversion;
561    $old_majversion =~ s/^([[:digit:]]+\.[[:digit:]]).*/$1/;
562
563    if ($interactive) {
564	if ($old_majversion ne $new_majversion) {
565	    print "WARNING: Current PPD file $ppd_source_filename has different version ($old_majversion)\n";
566	    print "         from new PPD file $new_ppd_filename ($new_majversion).\n";
567	}
568	print "Update PPD $ppd_source_filename from $new_ppd_filename [nyq]? ";
569	my $input = readline(*STDIN);
570	if ($input =~ /^q/i) {
571	    close $source_fd if !$server_multicat;
572	    print "Skipping all...\n";
573	    return -2;
574	} elsif (! ($input =~ /^y/i)) {
575	    close $source_fd if !$server_multicat;
576	    print "Skipping...\n";
577	    return -1;
578	}
579    }
580
581    # Close original and temporary files...
582
583    close ORIG;
584    if (! $server_multicat && ! close $source_fd) {
585	print STDERR "Unable to retrieve new PPD file: $!\n";
586	return -1;
587    }
588
589    if (! $opt_x && !$opt_i && $old_majversion ne $new_majversion) {
590	print STDERR "Skipping $ppd_source_filename: mismatched file versions (old $old_majversion, new $new_majversion); will not update without -x!\n";
591	return -1;
592    }
593
594    my %orig_default_types = %$odt;
595    my %new_default_types = %$ndt;
596    my %defaults = %$odef;
597    my %new_defaults = %$ndef;
598    my %options = %$nopt;
599    my %resolution_map = %$nres;
600    my %old_resolution_map = reverse %$ores;
601
602    # Store previous language in the PPD file so that -l original works
603    # correctly.
604
605    if ($orig_locale ne "") {
606	$source_data =~ s/(\*StpLocale:\s*\")(.*)(\")/$1$orig_locale$3/;
607    }
608
609    # PageRegion, PageSize, Imageablearea, and PaperDimension need to match.
610    # ImageableArea and PaperDimension may be broken from cups-genppdupdate
611    # in 5.2.10 and earlier not updating them, but PageRegion and PageSize
612    # should match.  Use PageSize as the default, but warn if PageSize
613    # and PageRegion don't match.
614
615    if ($defaults{"DefaultPageSize"} ne $defaults{"DefaultPageRegion"}) {
616	warn("Warning: DefaultPageSize $defaults{'DefaultPageSize'} and DefaultPageRegion $defaults{'DefaultPageRegion'} don't match.  Using $defaults{'DefaultPageSize'} for both.\n");
617	$defaults{"DefaultPageRegion"} = $defaults{"DefaultPageSize"};
618    }
619    if ($defaults{"DefaultPageSize"} ne $defaults{"DefaultImageableArea"}) {
620	print STDERR "Correcting DefaultImageableArea from $defaults{'DefaultImageableArea'} to $defaults{'DefaultPageSize'}\n";
621	$defaults{"DefaultImageableArea"} = $defaults{"DefaultPageSize"};
622    }
623    if ($defaults{"DefaultPageSize"} ne $defaults{"DefaultPaperDimension"}) {
624	print STDERR "Correcting DefaultPaperDimension from $defaults{'DefaultPaperDimension'} to $defaults{'DefaultPageSize'}\n";
625	$defaults{"DefaultPaperDimension"} = $defaults{"DefaultPageSize"};
626    }
627
628    if ($debug & 4) {
629	print "Options (Old->New Default Type):\n";
630	foreach (sort keys %options) {
631	    my ($old_type) = $orig_default_types{$_};
632	    my ($new_type) = $new_default_types{$_};
633	    if (! defined($old_type)) {
634		$old_type = '(New)';
635	    }
636	    if ($old_type ne $new_type) {
637		print "  $_ ($old_type -> $new_type) :  ";
638	    } else {
639		print "  $_ ($new_type) :  ";
640	    }
641	    my ($def) = $defaults{"Default$_"};
642	    foreach my $opt (@{$options{$_}}) {
643		if (defined $def && $def eq $opt) {
644		    print "*";
645		}
646		print "$opt ";
647	    }
648	    print "\n";
649	}
650	if (keys %resolution_map) {
651	    print "Resolution Map:\n";
652	    foreach (sort keys %resolution_map) {
653		print "   $_: $resolution_map{$_}\n";
654	    }
655	}
656	if (keys %old_resolution_map) {
657	    print "Old Resolution Map:\n";
658	    foreach (sort keys %old_resolution_map) {
659		print "   $_: $old_resolution_map{$_}\n";
660	    }
661	}
662	print "Non-UI Defaults:\n";
663	foreach (sort keys %defaults) {
664	    my ($xkey) = $_;
665	    $xkey =~ s/^Default//;
666	    if (! defined ($options{$xkey})) {
667		print "  $_: $defaults{$_}\n";
668	    }
669	}
670	print "Default Types of dropped options:\n";
671	foreach (sort keys %orig_default_types) {
672	    if (! defined($options{$_})) {
673		print "  $_: $orig_default_types{$_}\n";
674	    }
675	}
676    }
677
678    if ($no_action) {
679	if (!$quiet || $verbose) {
680	    if ($ppd_dest_filename eq $ppd_source_filename) {
681		print STDOUT "Would update $ppd_source_filename using $new_ppd_filename\n";
682	    } else {
683		print STDOUT "Would update $ppd_source_filename to $ppd_dest_filename using $new_ppd_filename\n";
684	    }
685	}
686	return -1;
687    }
688
689    if  (! $reset_defaults) {
690	# Update source buffer with old defaults...
691
692	# Loop through each default in turn.
693default_loop:
694	foreach my $default_option (sort keys %defaults) {
695	    my $option;
696	    my $default_option_value = $defaults{$default_option};
697	    ($option = $default_option) =~ s/Default//; # Strip off `Default'
698	    # Check method is valid
699	    my $orig_method = $orig_default_types{$option};
700	    my $new_method = $new_default_types{$option};
701	    my $new_default = $new_defaults{$default_option};
702	    if ((!defined($orig_method) || !defined($new_method)) ||
703		$orig_method ne $new_method) {
704		$source_data =~ s/^\*($default_option).*/*$1: $default_option_value/m;
705		next;
706	    }
707	    if (defined($new_default) &&
708		$default_option_value eq $new_default) {
709		if ($verbose) {
710		    print "$ppd_source_filename: Preserve *$default_option ($default_option_value)\n";
711		}
712		next;
713	    }
714	    if ($new_method eq "PickOne") {
715		# Check the old setting is valid
716		foreach my $opt (@{$options{$option}}) {
717		    my $def_option = $default_option_value;
718		    my $odef_option = $def_option;
719		    if ($option eq "Resolution" &&
720			defined $old_resolution_map{$def_option}) {
721			if ($debug & 4) {
722			    print "Intermapping old resolution $def_option to $old_resolution_map{$def_option}\n";
723			}
724			$def_option = $old_resolution_map{$def_option};
725		    }
726		    my @dopts = ($def_option);
727		    if ($def_option ne $odef_option) {
728			push @dopts, $odef_option;
729		    }
730
731		    foreach my $dopt (@dopts) {
732			if (($dopt eq $opt) ||
733			    ($option eq "Resolution" &&
734			     (defined $resolution_map{$dopt}) &&
735			     ($dopt = $resolution_map{$dopt}) eq $opt)) { # Valid option
736			    # Set the option in the new PPD
737			    $source_data =~ s/^\*($default_option).*/*$1: $dopt/m;
738			    if ($verbose) {
739				print "$ppd_source_filename: Set *$default_option to $dopt\n";
740			    }
741			    next default_loop;
742			}
743		    }
744		}
745		warn "Warning: $ppd_source_filename: Invalid option: *$default_option: $defaults{$default_option}.  Using default setting $new_defaults{$default_option}.\n";
746		next;
747	    }
748	    warn "Warning: $ppd_source_filename: PPD OpenUI method $new_default_types{$default_option} not understood.\n";
749	}
750    }
751
752    # Write new PPD...
753
754    my $tmpnew = "${ppd_dest_filename}.new";
755    if (! open NEWPPD, "> $tmpnew") {
756	warn "Can't create $tmpnew: $!\n";
757	return 0;
758    }
759    print NEWPPD $source_data;
760    if (! close NEWPPD) {
761	warn "Can't write to $tmpnew: $!\n";
762	unlink $tmpnew;
763	return 0;
764    }
765
766    if (! rename $tmpnew, $ppd_dest_filename) {
767	warn "Can't rename $tmpnew to $ppd_dest_filename: $!\n";
768	unlink $tmpnew;
769	return 0;
770    }
771    chown($orig_metadata[4], $orig_metadata[5], $ppd_dest_filename);
772    chmod(($orig_metadata[2] & 0777), $ppd_dest_filename);
773
774    if (!$quiet || $verbose) {
775	if ($ppd_dest_filename eq $ppd_source_filename) {
776	    print STDOUT "Updated $ppd_source_filename using $new_ppd_filename\n";
777	} else {
778	    print STDOUT "Updated $ppd_source_filename to $ppd_dest_filename using $new_ppd_filename\n";
779	}
780    }
781    return 1;
782    # All done!
783}
784
785# Find a suitable source PPD file
786sub find_ppd ($$$$) {
787    my($gutenprintfilename, $drivername, $lang, $region) = @_;
788    my $file; # filename to return
789    my ($key) = '^\\*FileVersion:[ 	]*' . "$file_version";
790    my ($lingo, $suffix, $base, $basedir);
791    my ($current_best_file, $current_best_time);
792    my ($stored_name, $stored_dir, $simplified);
793    $stored_name = $gutenprintfilename;
794    $stored_name =~ s,.*/([^/]+\.[0-9]+\.[0-9]+)(\.sim)?(\.ppd)?(\.gz)?$,$1,;
795    if ($gutenprintfilename =~ m,.*/([^/]*)(\.sim)(\.ppd)?(\.gz)?$,) {
796	$simplified = ".sim";
797    } else {
798	$simplified = "";
799    }
800    $stored_dir = $gutenprintfilename;
801    $stored_dir =~ s,(.*)/([^/]*)$,$1,;
802
803    $current_best_file = "";
804    $current_best_time = 0;
805    my (@basedirs);
806    if ($opt_s) {
807	@basedirs = ($opt_s);
808    } else {
809	@basedirs = ($ppd_base_dir, $stored_dir, $ppd_root_dir);
810    }
811
812    my (@lingos);
813    if ($region ne "") {
814	push @lingos, "${lang}_${region}/";
815    }
816    push @lingos, "$lang/";
817    if ($lang ne "C") {
818	push @lingos, "C/";
819    }
820    push @lingos, "en/", "";
821    push @lingos, "Global/";
822    my (@bases);
823    push @bases, "stp-${drivername}.$version${simplified}";
824    push @bases, "${drivername}.$version${simplified}";
825    if ($stored_name ne "${drivername}.$version${simplified}" and
826	$stored_name ne "stp-${drivername}.$version${simplified}") {
827	push @bases, $stored_name;
828    }
829    push @bases, $drivername;
830
831    # All possible candidates, in order of usefulness and gzippedness
832    foreach $lingo (@lingos) {
833	foreach $suffix (".ppd$gzext",
834			 ".ppd") {
835	    foreach $base (@bases) {
836		foreach $basedir (@basedirs) {
837                    if ($basedir eq "" || $base eq "") { next; }
838		    my ($fn) = "$basedir/$lingo$base$suffix";
839		    if ($debug & 8) {
840                        print "Trying $fn for $gutenprintfilename, $lang, $region\n";
841                    }
842# Check that it is a regular file, owned by root.root, not writable
843# by other, and is readable by root.  i.e. the file is secure.
844		    my @sb = stat $fn or next;
845		    if ($debug & 8) {
846                        print "  Candidate $fn for $gutenprintfilename, $lang, $region\n";
847                    }
848		    if ($opt_f || (S_ISREG($sb[2]) && ($sb[4] == 0))) {
849			# Check that the file is a valid Gutenprint PPD file
850			# of the correct version.
851			my $new_file_version;
852			if ($fn =~ m/\.gz$/) {
853			    $new_file_version = `gunzip -c $fn | grep '$key'`;
854			} else {
855			    $new_file_version = `cat $fn | grep '$key'`;
856			}
857			if ($new_file_version ne "") {
858                            if ($debug & 8) {
859			        print "   Format valid: time $sb[9] best $current_best_time prev $current_best_file cur $fn!\n";
860			    }
861			    if ($sb[9] > $current_best_time) {
862				$current_best_time = $sb[9];
863				$current_best_file = $fn;
864		                if ($debug & 8) {
865                                    print STDERR "***current_best_file is $fn\n";
866                                }
867			    }
868			} elsif ($debug & 8) {
869			    print "   Format invalid\n";
870			}
871		    }
872		    else {
873			$_ = $fn;
874			if (! -d $fn && ! /\/$/) {
875			    print STDERR "$fn: not a regular file, or insecure ownership and permissions.  Skipped\n";
876			}
877		    }
878		}
879	    }
880	}
881    }
882    if ($current_best_file) {
883        return $current_best_file;
884    }
885# Yikes!  Cannot find a valid PPD file!
886    return undef;
887}
888
889# Return default type, options, resolutions, and default values.
890# More efficient since it takes only one pass over the data.
891sub get_ppd_data(*$$$$$) {
892    my ($fh, $types, $opts, $resolutions, $defaults, $data) = @_;
893    my (%options, %defaults, %resolution_map, %default_types);
894    my ($fileversion_found) = 0;
895    my ($fileversion) = "";
896    my $cur_opt = "";
897    my (@optionlist);
898    my ($source_data) = "";
899    if ($reset_defaults) {
900	$types = 0;
901	$opts = 0;
902	$resolutions = 0;
903	$defaults = 0;
904    }
905
906    if ($resolutions || $types || $opts || $defaults || $data) {
907	while (<$fh>) {
908	    last if $_ eq "*%*%EOFEOF\n";
909	    if (/^\*FileVersion:/) {
910		$fileversion_found = 1;
911		($fileversion) = /^\*FileVersion:\s*"(.*)"$/;
912	    }
913	    $source_data .= $_ if ($data);
914	    chomp;
915	    if (($types || $opts) && m/^\*OpenUI/) {
916		my ($key, $value) = /^\*OpenUI\s\*([[:alnum:]]+).*:\s([[:alnum:]]+)/;
917		if ($key && $value) {
918		    $default_types{$key}=$value;
919		    $cur_opt = $key;
920		}
921	    } elsif ($opts && m/^\*CloseUI/) {
922		if ($cur_opt ne "") {
923		    $options{$cur_opt} = [ @optionlist ];
924		    $cur_opt = "";
925		}
926		@optionlist = ();
927	    } elsif ($opts && m/^\*$cur_opt/) {
928		my ($value) = /^\*$cur_opt\s*([[:alnum:]]+)[\/:]/;
929		if (defined $value && $value) {
930		    push @optionlist, $value;
931		}
932	    } elsif ($resolutions && m/^\*StpResolutionMap:/) {
933		my ($junk, $new, $old) = split;
934		$resolution_map{$old} = $new;
935	    } elsif ($defaults && m/^\*Default/) {
936		my($key, $value) = /^\*([[:alnum:]]+):\s*([[:alnum:]]+)/;
937		if ($key && $value) {
938		    $defaults{$key}=$value;
939		}
940	    }
941	}
942    }
943    return (undef, undef, undef, undef, undef, undef) if (! $fileversion_found);
944    return (\%default_types, \%options, \%resolution_map, \%defaults, $source_data, $fileversion);
945}
946