#!/usr/bin/perl use strict; my(@allowed_referers) = ('www.ghdsa.org','ghdsa.org'); my($html_server_path) = "/home/ghdsa/ghdsa.org/public_html"; my($cgi_server_path) = "/home/ghdsa/ghdsa.org/public_html/cgi-bin"; &check_url; my($page_top_file); my($page_bottom_file); my($language); my(@en_errors); my(@fr_errors); &parse_form; &setup_language; &printer_friendly; exit; sub printer_friendly { my($referer) = $ENV{HTTP_REFERER}; my($content) = ''; my($ref) = ''; # $referer =~ s!^/*(.*?)/*$!$1!; $referer =~ s/\.\.//gi; foreach $ref (@allowed_referers) { $referer =~ s/https?:\/\/([^\/]*)$ref//i; } # If this is a directory root then add index.html if ($referer =~ /.*\/$/) { $referer .= "index.html"; } open R,"<$html_server_path/$referer" or (push (@en_errors, "$!") && push (@fr_errors, "$!") && &error); $content = join '',; close R; print "Content-Type: text/html\n\n$content\n"; } sub check_url { my($check_referer); my($ref); foreach $ref (@allowed_referers) { if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$ref|i) { $check_referer = 1; last; } else { $check_referer = 0; } } # If the HTTP_REFERER was invalid, send back an error if ($check_referer != 1) { push (@en_errors, "You are not authorized to perform this action"); push (@fr_errors, "You are not authorized to perform this action"); &error; } } sub parse_form { my($pair); my(@pairs); if ($ENV{'REQUEST_METHOD'} eq 'GET') { # Split the name-value pairs @pairs = split(/&/, $ENV{'QUERY_STRING'}); } else { push (@en_errors, "You are not authorized to perform this action."); push (@fr_errors, "You are not authorized to perform this action."); &error; } # For each name-value pair: foreach $pair (@pairs) { # Split the pair up into individual variables my($name, $value) = split(/=/, $pair); # Decode the form encoding on the name and value variables $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # If they try to include server side includes, erase them $value =~ s///g; if ($name eq "language") { $language = $value; } } } # Setup Language sub setup_language { if ($language eq "francais") { $page_top_file = "$cgi_server_path/includes/header.cgi"; $page_bottom_file = "$cgi_server_path/includes/footer.cgi"; } else { $page_top_file = "$cgi_server_path/includes/header.cgi"; $page_bottom_file = "$cgi_server_path/includes/footer.cgi"; } } sub error { my(@errors); my($error); my($title); my($please_return); if ($language eq "francais") { @errors = @fr_errors; $title = "Il nous est impossible de procéder à votre demande"; $please_return = ""; } else { @errors = @en_errors; $title = "Unable to process submission"; $please_return = ""; } print "Content-type: text/html\n\n"; print < $title ALL_DONE # Display the header system ("perl \"$page_top_file\" \"no_content_type\" \"$title\""); print < $please_return

    ALL_DONE foreach $error (@errors) { print "
  • $error\n"; } print < ALL_DONE system ("perl \"$page_bottom_file\" \"no_content_type\""); exit; }