#!/usr/bin/perl #!perl # ############################################################################## #Doug Rice, Copyright 2002,2003 ############################################################################## # # # # # require "/home/pi/www/cgi-bin/gbtxtInclude.pl"; require "./gbtxtInclude.pl"; if ( $ENV{'CONTENT_TYPE'} ){ } else { #200 OK #Content-Type: text/html; charset=utf-8 #Content-Disposition: attachment; filename="cool.html" #Content-Length: 21 # #Save me! #multiline string contents # # # Using the ones from require "./gbtxtInclude.pl"; # # # my $headerNew =<<'END'; Thank You - test

Thank You For your interest.

It has not been possible to proceed, this time.

END my $footerNew =<<'END'; END my $bodyNew =<<'END';

This is text

END $bodyText =<<'END';

This webpage uses a PERL require to load common header and footer text

END # else print a page to thank form submission. # Print Beginning of HTML # for CSV files print "Content-Type: text/html\n" ; # for CSV files # print "Content-Type: text/csv\n" ; # print "Content-Disposition: attachment; filename=test.csv\n" ; # need a blank line print "\n"; # use common strings print $header; # print $body; print $body2; print "

"; 
  print "1,2,3,4"."\n"; 
  print "1,2,3,4"."\n";
  print "1,2,3,4"."\n";
  print "10,2,3,4"."\n";
  print "

"; print $bodyText; $bodyText =<<'END';

This is a multiline string

END print <<'END';

This webpage uses a PERL require to load common header and footer text, and multiline strings.

HTTP headers

  # Print Beginning of HTML
Content-Type: text/html

  # for CSV files
Content-Type: text/csv
Content-Disposition: attachment; filename=test.csv

  # need a blank line at the end of the HTTP
  print "\n";

<!DOCTYPE html>
<html>
<head>
<title>Thank You - test</title></head>
<head><link rel="stylesheet" type="text/css" href="/patrickpi_styles.css"></head>
<body>


END


  print $bodyText;

  print $footer;
  exit;
}




# Alternatively code like:
# uncomment line below to view compiler errors 
#
#BEGIN { 
#$| = 1; 
#open (STDERR, ">&STDOUT"); 
#print "Content-type: text/html\n\n\n"; 
#} 


# Use Socket to reverse DNS IP address 
use Socket;

#
# Try and reverse lookup IP address.
#
($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr( inet_aton( $ENV{'REMOTE_ADDR'} ), PF_INET );




# specify  the path to the guestbook file  gbookFXXXX.js
# XXXX is value of hidden form field:  guestbook 
#
# Ensure that gbookFXXXX.js has write permissions
#
# if the directory has execute permissions, this script will create gbookFXXXX.js


# You cannot include the file from the cgi-bin directory: 
# /usr/lib/cgi-bin

# Save the file in:
# /var/www/html/gb
# Webpage would include the guestbook from the cgi webserver address
#


# so save in an adjacent branch 
# or the relative path to a directory called gb
#$guestbookjsf  = './../gb/gbookF';

#
# Find out where the documents are stored. 
# One should work.
#
# On  CGI servers I can use: $ENV{'C_DOCUMENT_ROOT'}
# On plus.net CGI server I had to use: $ENV{'C_DOCUMENT_ROOT'}
#
$doc_root = $ENV{'DOCUMENT_ROOT'}.$ENV{'C_DOCUMENT_ROOT'};
$doc_root = '/home/pi/www';


$guestbookjsf  = $doc_root.'/gb/gbookF';

#
#
# =============================================
# SEC 2.0 - process FORM fields sent using POST
# =============================================
#
# Get the input, i.e the form fields pushed up to the CGI script. 
#
# If POST read STDIN
# If GET  decode QUERY_STRING
#

# Get the input, i.e the form fields pushed up to the CGI script.
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

#Combine the query string and form fields
# Split the name-value pairs
@pairs = split(/&/, $ENV{'QUERY_STRING'}."&".$buffer );

foreach $pair (@pairs) {

   ($name, $value) = split(/=/, $pair);

   # Un-Webify plus signs and %-encoding
   $value =~ tr/+/ /;
   # Leave the value mostly escaped as JavaScript can unescape easily.

   # Convert CR LF and LF to 
\ at the end of the line
   $value =~ s/%0D//g;
   $value =~ s/%0A/
\\\n/g;


   # Convert \ " and ''
   $value =~ s/%5C/\\\\/g;
   $value =~ s/%22/\\"/g;
   $value =~ s/%27/\\'/g;

   $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
   $FORMJS{$name} = $value;
}


  #
  # Use email to validate user and filter spam 
  #
  $unlock = 'lock'; 

  if ( $FORMJS{'email'} eq 'dem0@dem0' ){
    $unlock = 'unlock';
    # blank off email to hide what worked
    $FORMJS{'email'}     = '';

    # force to one guest book
    # $FORMJS{'guestbook'} = 'XXX';
  }

  #if ( $FORMJS{'email'} eq 'env' ){
  #  print "\n" . '========== @ENV - foreach =========='."\n";
  #  foreach $key (sort(keys %ENV)) {
  #    print "\n$key," . '=' .  $ENV{ $key } ;
  #  }  
  #}


  if ( $unlock eq 'unlock' ){

	# If unlock make guestbook files RW
    #
    # print `chmod 660 ../public/gb/gbook*.js` ; 
    # print `chmod 660 /var/www/html/gb/gbook*.js` ;
    # run chmod on server to make files read write   
    # print `$unlockcmd $guestbookjsf$FORMJS{'guestbook'}.js` ;     
  }

$date ="26 oct 2002 09:00;"; # date formatted so that JavaScript can parse it
&setDate();

  # take form fields and wrap them in the JavaScript Function call and append it onto the end of "gbookF$FORMJS{'guestbook'}.js"
  # Take the form fields and output them wrapped in the format:

  #gbF( 
  #"name","email"," sun 23/Jun/2002 at 20: 52: 0 ","127.0.0.1",
  #"userfield1",
  #"userfield2",
  #"userfield3",
  #"userfield4",
  #"comments"
  #);

  $N = $FORMJS{'guestbook'};

  open (GUESTFJS,">>$guestbookjsf$N.js") || &file_error( GUESTJS, "$guestbookjsf$N.js" ); 

  #Lock file while updating file to prevent race conddition update.
  # This has not been a big problem as the script does not take long.
  # A simple edit was needed to remove corrupted posts.
  
  # This blocks if file is locked, and removed when script ends.

  flock GUESTFJS, 2 || &file_error( GUESTJS, "lock: $guestbookjsf$N.js" );
  # get time stamp 
  &setDate();

  # record which page and what browser was used.
  print GUESTFJS "// Added by gbook.pl  $ENV{'HTTP_REFERER'} \n";
  print GUESTFJS "// HTTP_USER_AGENT:  $ENV{'HTTP_USER_AGENT'} \n";


  print GUESTFJS "gbF( \n";
  print GUESTFJS "\"$FORMJS{'name'}\",";
  print GUESTFJS "\"$FORMJS{'email'}\",";
  print GUESTFJS "\"$date\",";
  print GUESTFJS "\"$ENV{'REMOTE_ADDR'}\",\n";
  print GUESTFJS "\"$FORMJS{'userfield1'}\",\n";
  print GUESTFJS "\"$FORMJS{'userfield2'}\",\n";
  print GUESTFJS "\"$FORMJS{'userfield3'}\",\n";
  print GUESTFJS "\"$FORMJS{'userfield4'}\",\n";
  print GUESTFJS "\"$FORMJS{'comments'}\"\n";
  print GUESTFJS ");\n";
  close (GUESTFJS);



  if ( $FORMJS{'loadnextpage'} ){

    # Print Out Initial Output Location Heading
    print "Location: $FORMJS{'nextpage'}\n\n";
    exit;
  }


  # =============================================
  # SEC 2.0 - Exit  inline code
  # =============================================

  #
  # Exit script and reload page submitting form
  # 
  # remove ?query string and send a new one which can indicate problems
  # if URL ends 
  # ?ok  - successfull
  # 
  ($fromURL, $fromQuerystring) = split(/\?/,$ENV{'HTTP_REFERER'} );
  $qs = "?ok";
  
  # WARNING: Location: ?ok   Do not allow this. It spun Edge and filled up log file and MAXED out DiskQuota !

  #print "Location: $fromURL$qs \n\n";
  #exit;





  # else print a page to thank form submission.
  # Print Beginning of HTML
  print "Content-Type: text/html\n\n";
  print "Thank You\n";
  print ''."\n";
  print ''."\n";
  print "\n";
  print "\n";
  print ''."\n";



  print "Thank You For your submission\n";
  

#  print "from stdin:".$buffer;

#  print "ENV{'HTTP_REFERER': $ENV{'HTTP_REFERER'} ";
#  print "ENV{'CONTENT_TYPE'}:$ENV{'CONTENT_TYPE'} ";
  
#  print "\n" . '========== @ENV - foreach =========='."\n";
#  foreach $key (sort(keys %ENV)) {
#    print "\n$key," . '=' .  $ENV{ $key } ;
#  }

  print " return... 
";
  print '';

  exit;


#######################
# Subroutines

# file_error - call if problems opening files
sub file_error {

    local($FH, $fileName) = @_; 


    #
    # Exit script and reload page submitting form
    # 
    # remove ?query string and send a new one which can indicate problems
    # if URL ends 
    # ?ok  - successfull
    # 
    # WARNING 
    # I had an idea to use HTTP_REFERER and append ?ok to return to the calling page and add an exit code.
    #
    # if I called 192.168.1.x/gb.php there is no HTTP_REFERER and I got too many redirects
    #  - Edge does not like Location: ?ok 
    #


    ($fromURL, $fromQuerystring) = split(/\?/,$ENV{'HTTP_REFERER'} );
    $qs = "?error:file:$fileName ";
  
#    print "Location: $fromURL$qs \n\n";
#    exit;


    # Print Beginning of HTML
    print "Content-Type: text/html\n\n";
    print "Thank You\n";
    print "Error Opening File $fileName:, press back \n";
    print "Your data has not been added, press back \n";

    print "If you can log into the server, check file permissions\n";
    print '';
    exit;
}

################################################################
# setDate setup $date to string that javascript can parse using:  now= new Date( postedOn )
#

sub setDate {

# Get the Date for Entry
# output date so that the web pages can be use the javascript:  now= new Date( postedOn )

#IE 5 formats toUTCString():		Tue, 25 Jun 2002 05:47:32 UTC
#Netscape Navigator toUTCString():	Tue, 25 Jun 2002 05:49:59 GMT

#($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);		   
#  0     1     2    3     4     5    6     7     8
@t = localtime();
@days=  ('Sun','Mon','Tue','Wed','Thu','Fri','Sat','Sun');
@months=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
$fullYear=1900+$t[5];
#toUTCString():		#Tue, 25 Jun 2002 05:47:32 UTC
$date = "$days[$t[6]], $t[3] $months[$t[4]] $fullYear ".substr("0".$t[2],-2,2).":".substr("0".$t[1],-2,2).":".substr("0".$t[0],-2,2)." UTC+0100";

}