#!/usr/bin/perl
#^^^^^^^^^^^^^^^^^^^^ Update pathname appropriately to where you have Perl installed
# And update the path below of the configuration file as appropriate.
$lpinfo_ph = "/usr/local/lprng/info/lpinfo.ph"; 


#-------------- Should be fairly boilerplate from here on out --------------
# lpinfo_lprm - a Perl script to allow httpd to lprm selected jobs
# Copyright 1997, 1998, 1999, 2000 by Alek Komarnitsky, 
# Use and distribution of this software is covered by the GNU GPL license.  
# Please see the LICENSE file and http://www.gnu.org/
# Note: this will only work if the print server is running LPRng ...

$debug = 0; 

require 5.002;
use Socket;

&ReadParse;
print "Content-type: text/html\n\n\n" ;
print $meta_tags if ( defined($meta_tags)); 

#Grab stuff from lpinfo.ph ...
if ( -r "$lpinfo_ph" ) { 
   require "$lpinfo_ph";
} else {
   print "could not open $lpinfo_ph - serious error ... \n";
   exit(2);
}

$| = 1; 
$printer = $in{'printer'};
$jobnumber = $in{'jobnumber'};
if ( defined($in{'printserver'})) {
   $printserver = $in{'printserver'};
} else {
   $printserver = "unix";
}
$queue_is_nt = $in{'queue_is_nt'} if ( defined($in{'queue_is_nt'})) ; 
$adminmode = 0;
$_ = get_env_variable("^SCRIPT_NAME");
if ( $_ eq $lprmURLadmin ) {
   $_ = get_env_variable("^REMOTE_USER");
   $adminmode = $_;
}
print "adminmode is $adminmode <br> " if ($debug);

$browserhost="localhost";
$_ = get_env_variable("^REMOTE_ADDR");
print "We got $_ as the REMOTE ADDR <br> " if ($debug);
if ( $queue_is_nt) { 
   $browserhost = $_; 
} else {
   if ( $_ ne "" ) {
      s/^.*=//s;
      @iplist = split(/\./,$_);
      $ip = pack('C4',@iplist);
      $browserhost = gethostbyaddr($ip,AF_INET);
   }
}
$browserhost = get_env_variable("^REMOTE_ADDR") if ( $browserhost eq "");

print "We got $browserhost as the browserhost <br> " if ($debug);
if ( (! defined($in{'printer'}) ) || (! defined($in{'jobnumber'}) )) {
   close_er_out ("Did not get everything in that we needed ... <br> printer was $printer and $jobnumber was $jobnumber and browserhost was $browserhost and adminmode was $adminmode"); 
   exit(); 
}
print "<br><br> printer is $printer and jobnumber is $jobnumber and browserhost is $browserhost and printserver is $printserver and queue_is_nt is $queue_is_nt end <br>" if ( $debug ); 
$findjob = &find_job; 
if ( $findjob =~ "FAILED" ) {
   &close_er_out("$findjob"); 
}

print "<br>sending $lprm_suid $adminmode $browserhost $printer $printserver $jobnumber\n" if ($debug); 
$lprmout = `$lprm_suid $adminmode $browserhost $printer $printserver $jobnumber`;


print "<br><br>from lprm_suid, we got $lprmout <br> " if ($debug);
if ( $lprmout eq "" ) {
   &close_er_out("FAILED: lprm returned nothing, which typically means it failed");
} else {
   #Lets see if it really got removed ...
   if ($lprmout =~ /Queue Purged/ ) { 
      $findjob = "Could not find any job";
   } else {
      $findjob = &find_job; 
   }
   print "<br>second findjob shows $findjob <br>" if ($debug);
   if ("$findjob" =~ "Could not find any job" ) { 
      close_er_out("SUCCESS: Print job $jobnumber \@ $jobhost on $printer removed"); 
   } else {
      close_er_out("FAILED: lprm of job $jobnumber \@ jobhost on $printer failed from $browserhost"); 
   }
} 
print "at the end</html>";
exit(); 



sub find_job {
   local(@lpqout,@jobs,$foundrank,$foundjob);
   if ( defined($in{'queue_is_nt'})) {
      $command = "$lpq_nt $printer $printserver" ;
   } else {
      $command = "$lpq -P$printer $jobnumber"; 
   }
   print "executing $command <br> " if ($debug);
   @lpqout = `$command`; 
   # Parse output and stuff everything below "Rank   Owner/ID" into @jobs
   foreach $_ (@lpqout) { 
      next if ($_ =~ /^\s*$/); 
      if ($foundrank ) { 
         push (@jobs,$_); 
      } 
      $foundrank = 1 if ( $_ =~ "Rank   Owner/ID") ; 
      if ($queue_is_nt) { 
         $foundrank = 1 if ( $_ =~ /--------------------/) ;
      }
   }
   # Make sure that we can find the job ... in case user goofs we can tell them that ...
   foreach $_ (@jobs) { 
      ($rank,$owner,$class,$job,$misc) = split(); 
      print "<br>rank is $rank owner is $owner class is $class job is $job misc is $misc\n" if ($debug); 
      $foundjob = 1 if (($queue_is_nt) && ( $jobnumber eq "all"));
      if ( $job eq $jobnumber ) { 
         $foundjob = 1; 
         last;
      } 
   } 
   if ( ($jobnumber eq "all") && ( $foundrank) ) {
      return("SUCCESS: all found some jobs");
   }
   if (! $foundjob ) { 
      return ("FAILED: Could not find any job $jobnumber in $printer"); 
   }
   # Lets see if it truly comes from your machine ...
   $_ = $owner;
   s/^.*@(.*)\+.*$/$1/s;
   tr/A-Z/a-z/;
   $jobhost = $_; 
   print "jobhost is $jobhost \n" if ( $debug ); 
   if (($jobhost ne $browserhost ) && ( ! ($adminmode) ) ){
      close_er_out("FAILED: Print job $jobnumber on $printer came from $jobhost, not your machine $browserhost"); 
   } 
   return ("at the end of findjob");
}



sub close_er_out {
   print "<br><br> @_ "; 
   if ( $adminmode ) { 
      print "<form method=\"post\" action=\"$thisURLadmin?printer=$printer\" target=bottom>"; 
   } else {
      print "<form method=\"post\" action=\"$thisURL?printer=$printer\" target=bottom>"; 
   }
   print "<input type=\"hidden\" name=\"printer\" value=\"$printer\">";
   print "<input type=\"hidden\" name=\"auto\" value=\"0\">";

   print "<br><br><center><input type=\"submit\" value=\"Go back to queue status\">";
   print "</form></html>";
   exit(); 
}



# HTML parsing ...
sub ReadParse {
   if (@_) { local (*in) = @_; }
   local ($i, $loc, $key, $val);
   # Read in text
   if ($ENV{'REQUEST_METHOD'} eq "GET") {
      $in = $ENV{'QUERY_STRING'};
   } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
      for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
         $in .= getc;  }
   }
   @in = split(/&/,$in);
   foreach $i (0 .. $#in) {
      # Convert plus's to spaces
      $_ = $in[$i];
      $in[$i] = &sanitize($_);
      $in[$i] =~ s/\+/ /g;
      # Convert %XX from hex numbers to alphanumeric
      $in[$i] =~ s/%(..)/pack("c",hex($1))/ge;
      # Split into key and value.
      $loc = index($in[$i],"=");
      $key = substr($in[$i],0,$loc);
      $val = substr($in[$i],$loc+1);
      $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
      $in{$key} .= $val;
  }
}



# Added per CERT advistory - send Alek EMail if you want changes here ...
sub sanitize {
   local ($OK_CHARS);
   $OK_CHARS='-a-zA-Z0-9_.@=?+/ \s';
   s/[^$OK_CHARS]/_/go;
   return $_;
}



sub get_env_variable{
   $env_variable = @_[0];
   @env = `env`;
   @array=();
   push(@array,grep(/$env_variable/,@env));
   chomp($_ = $array[0]);
   $_ = &sanitize($_);
   s/^.*=//s;
   return $_;
}