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