#!/usr/bin/perl

# info_on_file.cgi ... RJM Programming - September, 2014

print "Content-type:text/html\n\n";

$emailpassword = "";
$filesz = "";
$thing = "file";
$suffix = "";
$valerr = "";
$warnerr = "";
$ourfile = "";
$ourcontents = "";
$yourorigin = $ENV{'HTTP_REFERER'};
$ourdomain = $ENV{SERVER_NAME};

if ($yourorigin =~ m#^http://www.rjmprogramming.com.au/#) {   # Please be accessing the proper way ... 

 if ($ENV{'REQUEST_METHOD'} eq "GET") {    # GET mode of use ... 
   @yourpairs = split(/&/, $ENV{'QUERY_STRING'});
   foreach $yourpair (@yourpairs) {
     ($yourname, $yourvalue) = split(/=/, $yourpair);
     $yourvalue =~ tr/+/ /;
     $yourvalue =~ s/%([\dA-Fa-f]{2})/pack("C", hex($1))/eg;
     $getdata{$yourname} = $yourvalue;
     if ($yourname eq "file" || $yourname eq "file:") {
       $ourfile = $yourvalue;
     } else {
       $suffix = "$suffix $yourname = $yourvalue";
     }   
   
   }
 } else {  # POST from a form mode of use ...

   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
   @ourpairs = split(/&/, $buffer);

   foreach $ourpair (@ourpairs) {
     ($ourname, $ourvalue) = split(/=/, $ourpair);
     $ourvalue =~ tr/+/ /;
     $ourvalue =~ s/%([\dA-Fa-f]{2})/pack("C", hex($1))/eg;
     $formdata{$ourname} = $ourvalue;
     if ($ourname eq "file" || $ourname eq "file:") {
       $ourfile = $ourvalue;
     } else {
       $suffix = "$suffix $ourname = $ourvalue";
     }   
   }   
 }
 
 if ($valerr ne "") {
    print "<p>$valerr</p>";  
 } elsif ($ourfile ne "") {
   if (-e $ourfile) {
    if (-d $ourfile) {
      $thing = "directory";  
    } else {
      $filesz = -s "$ourfile";
      $suffix = "$suffix Size = $filesz";
    }
    print "<p>The $thing $ourfile exists.</p><br>";  
    if (-r $ourfile) {
      print "<p>The $thing $ourfile is readable.</p><br>";  
    }
    if (-w $ourfile) {
      print "<p>The $thing $ourfile is writable.</p><br>";  
    }
   } else {
    print "<p>The $thing $ourfile does not exist.</p><br>";  
   }
 } else {
   print "<p>No $thing to tell you about.</p><br>";  
 }
 if ($suffix ne "") {
   print "<p> $suffix </p><br>";  
 }
}

sub OurErrorMessage {
   print "<p>Server has a problem with this.</p>";  
   exit; 
}