topical media & game development
[] readme course(s) preface I 1 2 II 3 4 III 5 6 7 IV 8 9 10 V 11 12 afterthought(s) appendix reference(s) example(s) resource(s) _

talk show tell print

lib-ajax-example-relay.cgi / cgi



  #!/usr/bin/perl
  use strict;
  use LWP::UserAgent;
  use HTTP::Request::Common;
  
  # Between the line like this (see below)
  #      my AllowedDomains = <<LIST;
  #   and the line like this,
  #      LIST
  #   list the allowed domain names separated with one
  #   or more white space characters.
  #
  # This is to restrict opportunities for cross site
  #   scripting. Pages can only be retrieved from the
  #   domains listed here.
  #
  # In order to retrieve pages from both example.com and
  #   www.example.com, both domains must be listed.
  
  my AllowedDomains = <<LIST;
  www.cs.vu.nl.com   
  www.few.vu.nl.com
  LIST
  
  # Notes:
  
  # Check for a URL in the query string, as a value in a
  #   GET variable, or as a value in a POST variable. The
  #   first to match is used. If none match, exit.
  
  my url = '';
  if(ENV{QUERY_STRING} and ENV{QUERY_STRING} !~ /=/)
  { url = ENV{QUERY_STRING}; }
  elsif(ENV{QUERY_STRING} and ENV{QUERY_STRING} =~ /^url=(.+)/)
  { url = $1; }
  elsif(ENV{REQUEST_METHOD} eq 'POST')
  {
          my buffer;
          read(STDIN,buffer,ENV{CONTENT_LENGTH});
          if(buffer =~ /^url=(.+)/)
          { url = $1; }
  }
  goto BOTTOM unless url;
  
  # Verify the domain in the URL is allowed. If unable to
  #   verify, exit.
  
  my checkdomain = lc url;
  checkdomain =~ s!^http://!!i;
  checkdomain =~ s!/.*!!;
  my domainokay = '';
  AllowedDomains =~ s/^\s*//s;
  AllowedDomains =~ s/\s*//s;
  for my domain (split /\s+/,AllowedDomains)
  {
          if(checkdomain eq lc(domain))
          {
                  domainokay = 1;
                  last;
          }
  }
  goto BOTTOM unless domainokay;
  
  # Retrieve the page and print it to the browser.
  
  my (content,success) = ();
  my ua = LWP::UserAgent->new;
  ua->agent(ENV{HTTP_USER_AGENT}) if ENV{HTTP_USER_AGENT};
  my r = ua->request(GET url);
  success = r->is_success if r->is_success;
  if(success)
  { content = r->content; }
  else
  { content = 'Something is awry. Status code: '.r->code; }
  print "Content-type: text/html\n\ncontent";
  
  BOTTOM:
  # end of script
[] readme course(s) preface I 1 2 II 3 4 III 5 6 7 IV 8 9 10 V 11 12 afterthought(s) appendix reference(s) example(s) resource(s) _

(C) Æliens 20/2/2008

You may not copy or print any of this material without explicit permission of the author or the publisher. In case of other copyright issues, contact the author.