1#!@PERL@
2
3# read the lpd.conf file, and set up values from it
4
5use strict;
6use FileHandle;
7use Sys::Hostname;
8use Socket;
9use Getopt::Std;
10
11sub FixStrVals( $ \% );
12sub Setup_pc_entry( $ \% \% \%);
13sub Real_printer( $ \% );
14sub MatchHost( \@ $ );
15sub MakeMask( $ );
16sub Read_printcap_file( $ \% \% $ $ \@ );
17sub CheckRecurse( $ \% \% $ $ \@ );
18sub Read_pc_entry( $ );
19sub Dump_index( $ \% );
20sub Dump_pc( $ \% );
21sub Read_conf( $ \% );
22sub Dump_conf( $ \% );
23sub Fix_value( $ );
24sub trimall( $ );
25
26# permanent values
27# Debug level
28my($Debug) = 0;
29#
30# %Init_hash: lpd.conf file values
31# %Pc_hash:   printcap entries
32# %Pc_index:  printcap entry names
33# @Hostname:  hostname information, used for 'oh' printcap information
34# %pc:        current printcap information
35# %Args:      command line arguments, processed by getopt
36# $Printer:   selected or current printer
37# 
38
39my(%Init_hash, %Pc_hash,%Pc_index,@Hostname,%Keyvals,$Pc_value,%Args);
40my($Printer);
41
42# maximum depth of recursion for printcap file lookup
43my($Max_depth) = 10;
44
45sub trimall( $ )
46{
47	my($line) = @_;
48	$line ||= "";
49	$line =~ s/^\s+//;
50	$line =~ s/\s+$//;
51	return( $line );
52}
53
54# convert a printcap or config file value into
55# a corresponding string or integer value
56
57sub Fix_value( $ )
58{
59	my($value) = @_;
60	if( $value =~ /^=/ or $value =~ /^#/ ){
61		$value = trimall( substr( $value, 1 ) );
62	} elsif ( $value =~ /^\@/ ){
63		$value = 0;
64	} else {
65		$value = 1;
66	}
67	return $value;
68}
69
70# sub Read_conf( $conf_file, \%conf_values )
71# Read a configuration file
72#  $conf_file = configuration file
73#  $conf_values = hash to store values in
74#
75
76
77sub Dump_conf( $ \% )
78{
79	my($title, $hash) = @_;
80	my($key);
81	print "$title config\n";
82	foreach $key (sort keys %$hash ){
83		print "  '$key'='". $hash->{$key} . "'\n";
84	}
85}
86
87sub Read_conf( $ \% )
88{
89	my($conf_file,$conf_values) = @_;
90	my($file,$key,$value,$line);
91
92	# open the conf file
93	$file = new FileHandle;
94	if( not defined( $file->open("<$conf_file")) ){
95		return "cannot open $conf_file - $!";
96	}
97	while( defined( $line = <$file>) ){
98		chomp $line;
99		next if not $line or $line =~ /^\s*#/;
100		($key,$value) = ($line =~ /^\s*([\w-]*)(.*)/);
101		$value = trimall($value);
102		($key = trimall($key)) =~ s/-/_/g;
103		print "key '$key'='$value'\n" if $Debug > 2;
104		$conf_values->{$key} = Fix_value( $value );
105		print "set key '$key'='" . $conf_values->{$key} . "'\n" if $Debug > 2;
106	}
107	$file->close;
108	Dump_conf( "Read_conf", %$conf_values ) if $Debug > 1;
109	return "";
110}
111
112# Dump_pc( $title, %Pc_hash )
113#  dump the printcap hash 
114#
115
116sub Dump_pc( $ \% )
117{
118	my($title, $hash) = @_;
119	my($key, $name);
120	$name = ();
121	$name = \@{$hash->{'NAME'}};
122	print "Dump_pc: $title pc '". join( "','",@$name) . "'\n";
123	foreach $key (sort keys %$hash ){
124		print "  '$key'='". $hash->{$key} . "'\n";
125	}
126}
127
128sub Dump_index( $ \% )
129{
130	my($title, $hash) = @_;
131	my($key);
132	print "Dump_index: $title index\n";
133	foreach $key (sort keys %$hash ){
134		print "  '$key'='". $hash->{$key} . "'\n";
135	}
136}
137
138# sub Read_pc_entry( $file )
139#  $file = filehandle
140#  find and read a printcap entry
141#
142
143my($lastline);
144
145sub Read_pc_entry( $ )
146{
147	my($file) = @_;
148	my($hash,$state,$escape,$line,@lines,$len,$i,@names);
149	my($key,$value,$add_next);
150	$state = "";
151	$hash = ();
152	$add_next = 0;
153	print "Read_pc_entry: starting\n" if $Debug > 1;
154	while( $lastline or defined( $lastline = <$file> ) ){
155		$line = trimall( $lastline );
156		print "line '$line'\n" if $Debug > 3;
157		if( not $line or $line =~ /^\s*#/ ){
158			$lastline = "";
159			next;
160		}
161		# beginning of next entry?
162		last if not $add_next and $line =~ /^\s*\w/ and $state ne "";
163		# we get rid of escapes at the end of the line
164		$lastline = "";
165		$add_next = 0;
166		($line, $escape) = ($line =~ /^(.*?)(\\*)$/);
167		if( defined( $escape ) ){
168			print "escape '$escape'\n" if $Debug > 3;
169			$len = length($escape);
170			if( $len % 2 ){
171				$escape = substr($escape,0,$len-1);
172				$add_next = 1;
173			}
174			$line .= $escape;
175		}
176		last if( not $state and $line =~ /^\s*include\s/ );
177		$state .= $line;
178		print "state '$state'\n" if $Debug > 3;
179	}
180	print "Read_pc_entry: final state '$state'\n" if $Debug > 2;
181	if( $state eq "" ){
182		return undef;
183	}
184	@lines = split( /\s*:+/,$state);
185	if( $Debug > 3 ){
186		print "Read_pc_entry: split values=\n";
187		for( $i = 0 ; $i < @lines; ++$i ){
188			print "[$i] '$lines[$i]'\n";
189		}
190	}
191	@names = split( /\s*\|+/, shift(@lines));
192	@names = map { trimall($_) } @names;
193	@{$hash->{'NAME'}} = @names;
194	foreach $line (@lines){
195		($key,$value) = ($line =~ /^\s*([\w-]*)(.*)/);
196		$value = trimall($value);
197		($key = trimall($key)) =~ s/-/_/g;
198		print "  key '$key'='$value'\n" if $Debug > 3;
199		$hash->{$key} = Fix_value( $value );
200		print "  set key '$key'='" . $hash->{$key} . "'\n" if $Debug > 3;
201	}
202	Dump_pc( "Read_pc_entry: final value", %$hash ) if $Debug > 1;
203	return $hash;
204}
205
206sub CheckRecurse( $ \% \% $ $ \@ )
207{
208	if( defined $lastline ){
209		my($v,$file) = split( ' ', $lastline );
210		if( $v eq 'include' ){
211			$lastline = "";
212			print "CheckRecurse: file '$file'\n" if $Debug>0;
213			my( $pc_file, $Pc_hash, $Pc_index, $server, $depth, $hostname ) = @_;
214			Read_printcap_file($file, %$Pc_hash, %$Pc_index, $server, $depth, @$hostname );
215		}
216	}
217}
218
219# sub Read_printcap_file(
220#  $pc_file - file name
221#  %Pc_hash - hash to store printcap values in
222#  %Pc_index - index of all printcap names
223#  $server   - if $server != 0 then a server, and use server printcap entries
224#  $depth    - recursion depth
225#  @Hostname - hostname information
226#
227#   read the printcap file and produce a
228#   hash with pointers to hashes of printcap vars
229#
230# Algorithm:
231#   open file
232#   while (read a printcap entry){
233#     decode the printcap entry
234#     if printcap values exist then
235#        merge values
236#     else
237#        create printcap entry
238#     endif
239#   endwhile
240
241sub Read_printcap_file( $ \% \% $ $ \@ )
242{
243	my( $pc_file, $Pc_hash, $Pc_index, $server, $depth, $hostname ) = @_;
244	my($file,$file_name,$hash,$key,$value,$names,$first,$name);
245	my($i,@n,@Hostentry);
246
247	# open the conf file
248	$file = new FileHandle;
249	++$depth;
250	print "Read_printcap_file: file '$pc_file', depth $depth\n" if $Debug>0;
251	if( $depth > $Max_depth ){
252		return "nesting too deep for '$pc_file'";
253	}
254	# get either file or filter
255	$file_name = trimall($pc_file);
256	if( ($file_name =~ s/^\|//) ){
257		$file_name = $file_name . '|';
258	} else {
259		$file_name = '<' . $file_name;
260	}
261	$file_name = FixStrVals( $file_name, %Keyvals );
262	print "Read_printcap_file: opening '$file_name'\n" if $Debug>0;
263	if( not defined( $file->open($file_name)) ){
264		return "cannot open '" . $file_name . "' - $!";
265	}
266	for(; defined( $hash = Read_pc_entry($file) );
267			CheckRecurse($pc_file, %$Pc_hash, %$Pc_index, $server, $depth, @$hostname ) ){
268		Dump_pc( "Read_printcap_file: checking", %$hash ) if $Debug > 1;
269		if( $hash->{'server'} and not $server ){
270			print "Read_printcap_file: " .
271				"server=(pc '$hash->{server}', need '$server')\n"
272				if $Debug>1;
273			next;
274		}
275		if( $hash->{'oh'} and not MatchHost( @$hostname, $hash->{'oh'} ) ){
276			print "Read_printcap_file: " .
277				"oh '$hash->{oh}' not matched\n" if $Debug>1;
278			next;
279		}
280		$names = $hash->{'NAME'};
281		$first = $names->[0]; 
282		# find out if we need to add or merge printcap
283		# entries
284		my(%k) = ();
285		for( $i = 1; $i < @$names; ++$i ){
286			$name = $names->[$i];
287			$k{$name} = $name;
288		}
289		$value = $Pc_hash->{$first}->{'NAME'};
290		if( defined @$value ){
291			for( $i = 1; $i < @$value; ++$i ){
292				$name = $value->[$i];
293				$k{$name} = $name;
294			}
295		}
296		@n = ( $first, sort keys %k );
297		@{$Pc_hash->{$first}->{'NAME'}} = @n;
298		foreach $key (keys %$hash){
299			$value = $hash->{$key};
300			if( $key ne 'NAME' ){
301				$Pc_hash->{$first}->{$key} = $value;
302			}
303		}
304		foreach $name (@$names){
305			$Pc_index->{$name} = $first;
306		}
307		if( not $Pc_index->{'FIRST'} ){
308			$Pc_index->{'FIRST'} = $first;
309		}
310		if( $Debug > 1 ){
311			Dump_index( "Read_printcap_file: after adding '$first'", %$Pc_index );
312			foreach $name (sort keys %$Pc_hash){
313				Dump_pc( "Read_printcap_file: after adding '$first'", %{$Pc_hash->{$name}} );
314			}
315		}
316	}
317	if( $Debug > 0 ){
318		Dump_index( "Read_printcap_file: after '$pc_file'", %$Pc_index );
319		foreach $name (sort keys %$Pc_hash){
320			Dump_pc( "Read_printcap_file: after '$pc_file'", %{$Pc_hash->{$name}} );
321		}
322	}
323}
324
325sub MakeMask( $ )
326{
327	my($mask) = @_;
328	my($mnum,$v,@v,$x,$i,$j,@d);
329	if( defined $mask ){
330		if( $mask =~ /\./ ){
331			$mnum = inet_aton( $mask );
332		} else {
333			if( $mask < 32 and $mask >= 0 ){
334				$v = pack( "N", (1 << $mask ) - 1);
335				@v = reverse split( '', unpack( "B32", $v ));
336				for( $i = 0; $i < 4; ++$i ){
337					$x = 0;
338					for( $j = 0; $j < 8; ++$j ){
339						$x *= 2;
340						$x += $v[$i*8+$j];
341					}
342					$d[$i] = $x;
343				}
344				$i = join(".", @d );
345				#print "MakeMask: generated $mask = '$i'\n" if $Debug > 5;
346				$mnum = inet_aton( $i );
347			} else {
348				$mnum = inet_aton( "255.255.255.255" );
349			}
350		}
351	} else {
352		$mnum = inet_aton( "255.255.255.255" );
353	}
354	print "MakeMask: $mask = '" . inet_ntoa( $mnum ) . "'\n" if $Debug > 5;
355	return $mnum;
356}
357
358# sub MatchHost( @Hostinfo, $matches )
359#   @Hostinfo is value returned by gethostbyname()
360#    ($name, $alises, $addrtype, $length, @addrs )
361#      0      1        2          3       4
362#   matches has format:  ((glob|ip/mask),)*
363
364sub MatchHost( \@ $ )
365{
366	my($hostinfo,$matches) = @_;
367	my(@list,$value,$addr,$mask,$anum,$mnum,$null,@v,$i,$ipaddr);
368	@list = split( '[,\s]', $matches );
369	foreach $value ( @list ){
370		print "Matchhost: '$value' to $hostinfo->[0]\n" if $Debug>2;
371		if( $value =~ /^\d/ ){
372			# we have addr/mask
373			$null = inet_aton("0.0.0.0");
374			($addr,$mask) = split( '/',$value );
375			$anum = inet_aton( $addr );
376			$mnum = MakeMask( $mask );
377			print "Matchhost: addr '" . inet_ntoa($anum) . "', mask '"
378				. inet_ntoa($mnum) . "'\n" if $Debug>3;
379			for($i = 4; $i < @$hostinfo; ++$i ){
380				$ipaddr = $hostinfo->[$i];
381				print "Matchhost: ipaddr '" . inet_ntoa($ipaddr) . "'\n" if $Debug>3;
382				$ipaddr = ($ipaddr ^ $anum) & $mnum;
383				print "Matchhost: result '" . inet_ntoa($ipaddr) . "'\n" if $Debug>3;
384				if( $ipaddr eq $null ){
385					print "Matchhost: found '".inet_ntoa( $hostinfo->[$i])."'\n" if $Debug>3;
386					return 1;
387				}
388			}
389		} else {
390			# we have glob str
391			$value =~ s/\./\\./g;
392			$value =~ s/\*/.*/g;
393			print "Matchhost: new value '$value'\n" if $Debug>3;
394			if( $hostinfo->[0] =~ /$value/ ){
395				print "Matchhost: found\n" if $Debug>3;
396				return 1;
397			}
398		}
399	}
400	return 0;
401}
402
403# sub Setup_pc_entry( $name )
404#  1. look up the pc entry
405#  2. set the initial values to configuration defaults
406#  3. combine the pc values
407# returns: hash of combined values
408
409sub Real_printer( $ \% )
410{
411	my($name, $Pc_index) = @_;
412	$name = $Pc_index->{$name};
413	return $name;
414}
415
416sub Setup_pc_entry( $ \% \% \%)
417{
418	my($name, $Pc_hash, $Pc_index, $Init_hash ) = @_;
419	my($real, %hash, $value, $key );
420	$real = Real_printer( $name, %$Pc_index );
421	if( not $real ){
422		return undef;
423	}
424	print "Setup_pc_entry: pr '$name', using real '$real'\n" if $Debug > 2;
425	%hash = %$Init_hash;
426	Dump_pc( "Setup_pc_entry: after init", %hash ) if $Debug > 3;
427		
428	$value = $Pc_hash->{$real};
429	Dump_pc( "Setup_pc_entry: pc value for '$real'", %$value ) if $Debug > 3;
430	foreach $key (keys %$value){
431		print "Setup_pc_entry: setting '$key'='$value->{$key}'\n" if $Debug > 5;
432		$hash{$key} = $value->{$key};
433	}
434	Dump_pc( "Setup_pc_entry: pr '$name', real '$real'; result", %hash ) if $Debug > 1;
435	return \%hash;
436}
437
438sub FixStrVals( $ \% )
439{
440	my($str, $hash ) = @_;
441	my( $key, $val );
442	while( $str =~ /%(.)/ ){
443		$key = $1;
444		print "FixStrVals: fixing '$key' in '$str'\n" if $Debug > 5;
445		$val = $hash->{$key};
446		$val = "" if( not defined $val );
447		$str =~ s/%$key/$val/g;
448	}
449	print "FixStrVals: final '$str'\n" if $Debug > 5;
450	return $str;
451}
452
453sub Get_printer_name( \% \% \%)
454{
455	my($args,$pc_index,$config) = @_;
456	my($printer);
457	$printer ||= $args->{'P'};
458	$printer ||= $pc_index->{'FIRST'};
459	$printer ||= $config->{'default_printer'};
460	print "Get_printer_name: '$printer'\n" if $Debug>0;
461	return( $printer );
462}
463
464# working values
465my($pc_path,$file);
466
467$| = 1;
468$Debug = 0;
469
470
471# get the command line options
472die "bad command line options" unless getopts('P:',\%Args);
473# get the hostname information
474@Hostname = gethostbyname( hostname() );
475print "hostname '" . join( "','", @Hostname ) . "'\n";
476# set up the key values
477$Keyvals{'H'} = $Hostname[0];
478
479Read_conf("/var/tmp/LPD/lpd.conf", %Init_hash);
480
481$pc_path = "/etc/printcap";
482if( $Init_hash{'printcap_path'} ){
483	$pc_path = $Init_hash{'printcap_path'};
484}
485
486foreach $file ( split( '[:,]', $pc_path ) ){
487	$file = FixStrVals( $file, %Keyvals );
488	Read_printcap_file($file, %Pc_hash, %Pc_index, 1, 0, @Hostname);
489}
490
491if( $Debug > 0 ){
492	my($name);
493	Dump_index( "Main:", %Pc_index );
494	foreach $name (sort keys %Pc_hash){
495		Dump_pc( "Main:", %{$Pc_hash{$name}} );
496	}
497}
498
499# get the printer name
500$Printer = Get_printer_name( %Args, %Pc_index, %Init_hash );
501if( not $Printer ){
502	die "missing printer name";
503}
504$Pc_value = Setup_pc_entry( $Printer, %Pc_hash, %Pc_index, %Init_hash );
505
506print "DONE\n";
507exit 0;
508%Pc_hash=();
509%Pc_index=();
510Read_printcap_file("/tmp/printcap", %Pc_hash, %Pc_index, 1, 0, @Hostname);
511
512
513print "DONE\n";
514