#!/usr/local/bin/perl

# read the lpd.conf file, and set up values from it

use strict;
use FileHandle;
use Sys::Hostname;
use Socket;
use Getopt::Std;

sub FixStrVals( $ \% );
sub Setup_pc_entry( $ \% \% \%);
sub Real_printer( $ \% );
sub MatchHost( \@ $ );
sub MakeMask( $ );
sub Read_printcap_file( $ \% \% $ $ \@ );
sub CheckRecurse( $ \% \% $ $ \@ );
sub Read_pc_entry( $ );
sub Dump_index( $ \% );
sub Dump_pc( $ \% );
sub Read_conf( $ \% );
sub Dump_conf( $ \% );
sub Fix_value( $ );
sub trimall( $ );

# permanent values
# Debug level
my($Debug) = 0;
#
# %Init_hash: lpd.conf file values
# %Pc_hash:   printcap entries
# %Pc_index:  printcap entry names
# @Hostname:  hostname information, used for 'oh' printcap information
# %pc:        current printcap information
# %Args:      command line arguments, processed by getopt
# $Printer:   selected or current printer
# 

my(%Init_hash, %Pc_hash,%Pc_index,@Hostname,%Keyvals,$Pc_value,%Args);
my($Printer);

# maximum depth of recursion for printcap file lookup
my($Max_depth) = 10;

sub trimall( $ )
{
	my($line) = @_;
	$line ||= "";
	$line =~ s/^\s+//;
	$line =~ s/\s+$//;
	return( $line );
}

# convert a printcap or config file value into
# a corresponding string or integer value

sub Fix_value( $ )
{
	my($value) = @_;
	if( $value =~ /^=/ or $value =~ /^#/ ){
		$value = trimall( substr( $value, 1 ) );
	} elsif ( $value =~ /^\@/ ){
		$value = 0;
	} else {
		$value = 1;
	}
	return $value;
}

# sub Read_conf( $conf_file, \%conf_values )
# Read a configuration file
#  $conf_file = configuration file
#  $conf_values = hash to store values in
#


sub Dump_conf( $ \% )
{
	my($title, $hash) = @_;
	my($key);
	print "$title config\n";
	foreach $key (sort keys %$hash ){
		print "  '$key'='". $hash->{$key} . "'\n";
	}
}

sub Read_conf( $ \% )
{
	my($conf_file,$conf_values) = @_;
	my($file,$key,$value,$line);

	# open the conf file
	$file = new FileHandle;
	if( not defined( $file->open("<$conf_file")) ){
		return "cannot open $conf_file - $!";
	}
	while( defined( $line = <$file>) ){
		chomp $line;
		next if not $line or $line =~ /^\s*#/;
		($key,$value) = ($line =~ /^\s*([\w-]*)(.*)/);
		$value = trimall($value);
		($key = trimall($key)) =~ s/-/_/g;
		print "key '$key'='$value'\n" if $Debug > 2;
		$conf_values->{$key} = Fix_value( $value );
		print "set key '$key'='" . $conf_values->{$key} . "'\n" if $Debug > 2;
	}
	$file->close;
	Dump_conf( "Read_conf", %$conf_values ) if $Debug > 1;
	return "";
}

# Dump_pc( $title, %Pc_hash )
#  dump the printcap hash 
#

sub Dump_pc( $ \% )
{
	my($title, $hash) = @_;
	my($key, $name);
	$name = ();
	$name = \@{$hash->{'NAME'}};
	print "Dump_pc: $title pc '". join( "','",@$name) . "'\n";
	foreach $key (sort keys %$hash ){
		print "  '$key'='". $hash->{$key} . "'\n";
	}
}

sub Dump_index( $ \% )
{
	my($title, $hash) = @_;
	my($key);
	print "Dump_index: $title index\n";
	foreach $key (sort keys %$hash ){
		print "  '$key'='". $hash->{$key} . "'\n";
	}
}

# sub Read_pc_entry( $file )
#  $file = filehandle
#  find and read a printcap entry
#

my($lastline);

sub Read_pc_entry( $ )
{
	my($file) = @_;
	my($hash,$state,$escape,$line,@lines,$len,$i,@names);
	my($key,$value,$add_next);
	$state = "";
	$hash = ();
	$add_next = 0;
	print "Read_pc_entry: starting\n" if $Debug > 1;
	while( $lastline or defined( $lastline = <$file> ) ){
		$line = trimall( $lastline );
		print "line '$line'\n" if $Debug > 3;
		if( not $line or $line =~ /^\s*#/ ){
			$lastline = "";
			next;
		}
		# beginning of next entry?
		last if not $add_next and $line =~ /^\s*\w/ and $state ne "";
		# we get rid of escapes at the end of the line
		$lastline = "";
		$add_next = 0;
		($line, $escape) = ($line =~ /^(.*?)(\\*)$/);
		if( defined( $escape ) ){
			print "escape '$escape'\n" if $Debug > 3;
			$len = length($escape);
			if( $len % 2 ){
				$escape = substr($escape,0,$len-1);
				$add_next = 1;
			}
			$line .= $escape;
		}
		last if( not $state and $line =~ /^\s*include\s/ );
		$state .= $line;
		print "state '$state'\n" if $Debug > 3;
	}
	print "Read_pc_entry: final state '$state'\n" if $Debug > 2;
	if( $state eq "" ){
		return undef;
	}
	@lines = split( /\s*:+/,$state);
	if( $Debug > 3 ){
		print "Read_pc_entry: split values=\n";
		for( $i = 0 ; $i < @lines; ++$i ){
			print "[$i] '$lines[$i]'\n";
		}
	}
	@names = split( /\s*\|+/, shift(@lines));
	@names = map { trimall($_) } @names;
	@{$hash->{'NAME'}} = @names;
	foreach $line (@lines){
		($key,$value) = ($line =~ /^\s*([\w-]*)(.*)/);
		$value = trimall($value);
		($key = trimall($key)) =~ s/-/_/g;
		print "  key '$key'='$value'\n" if $Debug > 3;
		$hash->{$key} = Fix_value( $value );
		print "  set key '$key'='" . $hash->{$key} . "'\n" if $Debug > 3;
	}
	Dump_pc( "Read_pc_entry: final value", %$hash ) if $Debug > 1;
	return $hash;
}

sub CheckRecurse( $ \% \% $ $ \@ )
{
	if( defined $lastline ){
		my($v,$file) = split( ' ', $lastline );
		if( $v eq 'include' ){
			$lastline = "";
			print "CheckRecurse: file '$file'\n" if $Debug>0;
			my( $pc_file, $Pc_hash, $Pc_index, $server, $depth, $hostname ) = @_;
			Read_printcap_file($file, %$Pc_hash, %$Pc_index, $server, $depth, @$hostname );
		}
	}
}

# sub Read_printcap_file(
#  $pc_file - file name
#  %Pc_hash - hash to store printcap values in
#  %Pc_index - index of all printcap names
#  $server   - if $server != 0 then a server, and use server printcap entries
#  $depth    - recursion depth
#  @Hostname - hostname information
#
#   read the printcap file and produce a
#   hash with pointers to hashes of printcap vars
#
# Algorithm:
#   open file
#   while (read a printcap entry){
#     decode the printcap entry
#     if printcap values exist then
#        merge values
#     else
#        create printcap entry
#     endif
#   endwhile

sub Read_printcap_file( $ \% \% $ $ \@ )
{
	my( $pc_file, $Pc_hash, $Pc_index, $server, $depth, $hostname ) = @_;
	my($file,$file_name,$hash,$key,$value,$names,$first,$name);
	my($i,@n,@Hostentry);

	# open the conf file
	$file = new FileHandle;
	++$depth;
	print "Read_printcap_file: file '$pc_file', depth $depth\n" if $Debug>0;
	if( $depth > $Max_depth ){
		return "nesting too deep for '$pc_file'";
	}
	# get either file or filter
	$file_name = trimall($pc_file);
	if( ($file_name =~ s/^\|//) ){
		$file_name = $file_name . '|';
	} else {
		$file_name = '<' . $file_name;
	}
	$file_name = FixStrVals( $file_name, %Keyvals );
	print "Read_printcap_file: opening '$file_name'\n" if $Debug>0;
	if( not defined( $file->open($file_name)) ){
		return "cannot open '" . $file_name . "' - $!";
	}
	for(; defined( $hash = Read_pc_entry($file) );
			CheckRecurse($pc_file, %$Pc_hash, %$Pc_index, $server, $depth, @$hostname ) ){
		Dump_pc( "Read_printcap_file: checking", %$hash ) if $Debug > 1;
		if( $hash->{'server'} and not $server ){
			print "Read_printcap_file: " .
				"server=(pc '$hash->{server}', need '$server')\n"
				if $Debug>1;
			next;
		}
		if( $hash->{'oh'} and not MatchHost( @$hostname, $hash->{'oh'} ) ){
			print "Read_printcap_file: " .
				"oh '$hash->{oh}' not matched\n" if $Debug>1;
			next;
		}
		$names = $hash->{'NAME'};
		$first = $names->[0]; 
		# find out if we need to add or merge printcap
		# entries
		my(%k) = ();
		for( $i = 1; $i < @$names; ++$i ){
			$name = $names->[$i];
			$k{$name} = $name;
		}
		$value = $Pc_hash->{$first}->{'NAME'};
		if( defined @$value ){
			for( $i = 1; $i < @$value; ++$i ){
				$name = $value->[$i];
				$k{$name} = $name;
			}
		}
		@n = ( $first, sort keys %k );
		@{$Pc_hash->{$first}->{'NAME'}} = @n;
		foreach $key (keys %$hash){
			$value = $hash->{$key};
			if( $key ne 'NAME' ){
				$Pc_hash->{$first}->{$key} = $value;
			}
		}
		foreach $name (@$names){
			$Pc_index->{$name} = $first;
		}
		if( not $Pc_index->{'FIRST'} ){
			$Pc_index->{'FIRST'} = $first;
		}
		if( $Debug > 1 ){
			Dump_index( "Read_printcap_file: after adding '$first'", %$Pc_index );
			foreach $name (sort keys %$Pc_hash){
				Dump_pc( "Read_printcap_file: after adding '$first'", %{$Pc_hash->{$name}} );
			}
		}
	}
	if( $Debug > 0 ){
		Dump_index( "Read_printcap_file: after '$pc_file'", %$Pc_index );
		foreach $name (sort keys %$Pc_hash){
			Dump_pc( "Read_printcap_file: after '$pc_file'", %{$Pc_hash->{$name}} );
		}
	}
}

sub MakeMask( $ )
{
	my($mask) = @_;
	my($mnum,$v,@v,$x,$i,$j,@d);
	if( defined $mask ){
		if( $mask =~ /\./ ){
			$mnum = inet_aton( $mask );
		} else {
			if( $mask < 32 and $mask >= 0 ){
				$v = pack( "N", (1 << $mask ) - 1);
				@v = reverse split( '', unpack( "B32", $v ));
				for( $i = 0; $i < 4; ++$i ){
					$x = 0;
					for( $j = 0; $j < 8; ++$j ){
						$x *= 2;
						$x += $v[$i*8+$j];
					}
					$d[$i] = $x;
				}
				$i = join(".", @d );
				#print "MakeMask: generated $mask = '$i'\n" if $Debug > 5;
				$mnum = inet_aton( $i );
			} else {
				$mnum = inet_aton( "255.255.255.255" );
			}
		}
	} else {
		$mnum = inet_aton( "255.255.255.255" );
	}
	print "MakeMask: $mask = '" . inet_ntoa( $mnum ) . "'\n" if $Debug > 5;
	return $mnum;
}

# sub MatchHost( @Hostinfo, $matches )
#   @Hostinfo is value returned by gethostbyname()
#    ($name, $alises, $addrtype, $length, @addrs )
#      0      1        2          3       4
#   matches has format:  ((glob|ip/mask),)*

sub MatchHost( \@ $ )
{
	my($hostinfo,$matches) = @_;
	my(@list,$value,$addr,$mask,$anum,$mnum,$null,@v,$i,$ipaddr);
	@list = split( '[,\s]', $matches );
	foreach $value ( @list ){
		print "Matchhost: '$value' to $hostinfo->[0]\n" if $Debug>2;
		if( $value =~ /^\d/ ){
			# we have addr/mask
			$null = inet_aton("0.0.0.0");
			($addr,$mask) = split( '/',$value );
			$anum = inet_aton( $addr );
			$mnum = MakeMask( $mask );
			print "Matchhost: addr '" . inet_ntoa($anum) . "', mask '"
				. inet_ntoa($mnum) . "'\n" if $Debug>3;
			for($i = 4; $i < @$hostinfo; ++$i ){
				$ipaddr = $hostinfo->[$i];
				print "Matchhost: ipaddr '" . inet_ntoa($ipaddr) . "'\n" if $Debug>3;
				$ipaddr = ($ipaddr ^ $anum) & $mnum;
				print "Matchhost: result '" . inet_ntoa($ipaddr) . "'\n" if $Debug>3;
				if( $ipaddr eq $null ){
					print "Matchhost: found '".inet_ntoa( $hostinfo->[$i])."'\n" if $Debug>3;
					return 1;
				}
			}
		} else {
			# we have glob str
			$value =~ s/\./\\./g;
			$value =~ s/\*/.*/g;
			print "Matchhost: new value '$value'\n" if $Debug>3;
			if( $hostinfo->[0] =~ /$value/ ){
				print "Matchhost: found\n" if $Debug>3;
				return 1;
			}
		}
	}
	return 0;
}

# sub Setup_pc_entry( $name )
#  1. look up the pc entry
#  2. set the initial values to configuration defaults
#  3. combine the pc values
# returns: hash of combined values

sub Real_printer( $ \% )
{
	my($name, $Pc_index) = @_;
	$name = $Pc_index->{$name};
	return $name;
}

sub Setup_pc_entry( $ \% \% \%)
{
	my($name, $Pc_hash, $Pc_index, $Init_hash ) = @_;
	my($real, %hash, $value, $key );
	$real = Real_printer( $name, %$Pc_index );
	if( not $real ){
		return undef;
	}
	print "Setup_pc_entry: pr '$name', using real '$real'\n" if $Debug > 2;
	%hash = %$Init_hash;
	Dump_pc( "Setup_pc_entry: after init", %hash ) if $Debug > 3;
		
	$value = $Pc_hash->{$real};
	Dump_pc( "Setup_pc_entry: pc value for '$real'", %$value ) if $Debug > 3;
	foreach $key (keys %$value){
		print "Setup_pc_entry: setting '$key'='$value->{$key}'\n" if $Debug > 5;
		$hash{$key} = $value->{$key};
	}
	Dump_pc( "Setup_pc_entry: pr '$name', real '$real'; result", %hash ) if $Debug > 1;
	return \%hash;
}

sub FixStrVals( $ \% )
{
	my($str, $hash ) = @_;
	my( $key, $val );
	while( $str =~ /%(.)/ ){
		$key = $1;
		print "FixStrVals: fixing '$key' in '$str'\n" if $Debug > 5;
		$val = $hash->{$key};
		$val = "" if( not defined $val );
		$str =~ s/%$key/$val/g;
	}
	print "FixStrVals: final '$str'\n" if $Debug > 5;
	return $str;
}

sub Get_printer_name( \% \% \%)
{
	my($args,$pc_index,$config) = @_;
	my($printer);
	$printer ||= $args->{'P'};
	$printer ||= $pc_index->{'FIRST'};
	$printer ||= $config->{'default_printer'};
	print "Get_printer_name: '$printer'\n" if $Debug>0;
	return( $printer );
}

# working values
my($pc_path,$file);

$| = 1;
$Debug = 0;


# get the command line options
die "bad command line options" unless getopts('P:',\%Args);
# get the hostname information
@Hostname = gethostbyname( hostname() );
print "hostname '" . join( "','", @Hostname ) . "'\n";
# set up the key values
$Keyvals{'H'} = $Hostname[0];

Read_conf("/var/tmp/LPD/lpd.conf", %Init_hash);

$pc_path = "/etc/printcap";
if( $Init_hash{'printcap_path'} ){
	$pc_path = $Init_hash{'printcap_path'};
}

foreach $file ( split( '[:,]', $pc_path ) ){
	$file = FixStrVals( $file, %Keyvals );
	Read_printcap_file($file, %Pc_hash, %Pc_index, 1, 0, @Hostname);
}

if( $Debug > 0 ){
	my($name);
	Dump_index( "Main:", %Pc_index );
	foreach $name (sort keys %Pc_hash){
		Dump_pc( "Main:", %{$Pc_hash{$name}} );
	}
}

# get the printer name
$Printer = Get_printer_name( %Args, %Pc_index, %Init_hash );
if( not $Printer ){
	die "missing printer name";
}
$Pc_value = Setup_pc_entry( $Printer, %Pc_hash, %Pc_index, %Init_hash );

print "DONE\n";
exit 0;
%Pc_hash=();
%Pc_index=();
Read_printcap_file("/tmp/printcap", %Pc_hash, %Pc_index, 1, 0, @Hostname);


print "DONE\n";