#!/usr/local/bin/perl --
# ------------------------------------------------------------------------
# include-url: <!--#include virtual="/cgi-bin/include-url?url=URL" -->
# DESCRIPTION:
#  Allow SSI include for foreign www server documents.
# REQUIREMENTS:
#  - perl recent version of course
#  - Module CGI (standard perl module)
#  - Module LWP::UserAgent from libwww-perl, a must have.
#  - Module HTTP::Headers
#  - Module HTTP::Request
#  - Module HTTP::Response
# ------------------------------------------------------------------------

#use diagnostics -verbose;
use strict; 
require 5.00502;


# Penser a utiliser le module Safe !!
#use Safe;
#my $compartment = new Safe;

# Utilise le module CGI
use CGI;
use CGI::Carp;

# On cree un nouvel objet CGI
my $CGI = new CGI();

##### variables ##########################################################

# Mes variables a moi
my $VERSION = "1.0";
my $NAME = "Include-Url";


##### main() #############################################################

# On ne bufferise pas la sortie standard
local $| = 1;

# On recupere les infos utiles
my $webmaster  = $ENV{'SERVER_ADMIN'} || 'webmaster';
my $ce_script = $CGI->url( -full => 1 );
my $server = $ENV{'SERVER_NAME'} || `hostname`;chomp $server;

# Header obligatoire pour indiquer que l'on balance du html en sortie
# meme si le script est included, c'est le serveur dans ce cas qui
# a besoin des headers.
print $CGI->header( '-type' => "text/html", 
                    "X_$NAME" => $VERSION );
exit( 1 ) if ( exists $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq 'HEAD' );
my $x_name = uc( "HTTP_X_$NAME" );
if ( exists $ENV{ "$x_name" } ) {
  warn "$ce_script: Recursive call of $NAME with $x_name " . $ENV{ $x_name } . " from " . $ENV{'HTTP_REFERER'};
  print "$ce_script: Recursive call of $NAME not allowed ...\n";
  exit( 1 );
}
if( exists $ENV{'SERVER_PROTOCOL' } && $ENV{'SERVER_PROTOCOL' } eq 'INCLUDED' ) { 
  # Scrpt CGI inclus via SSI
  $ce_script = "http://$server/" . $ENV{'SCRIPT_NAME'};
} else {
  # Script CGI normal
  warn "$ce_script: Should be called from an SSI include directive only...\n";
  print "$ce_script: Should be called from an SSI include directive only...\n";
  exit( 1 );
}

# script args
my $the_url = $CGI->param( 'url' ) || $CGI->param( 'Url' ) || '';
unless ( $the_url ) {
  warn "$ce_script: Should be called with arg url\n";
  print "$ce_script: Should be called with arg url\n";
  exit( 1 );
}
my $timeout = $CGI->param( 'timeout' ) || 0;
if ( $timeout !~ /^\d+$/ || !$timeout ) {
  $timeout = 0;
}

# Init de l'agent
require LWP::UserAgent;
my $ua = new LWP::UserAgent; 
$ua->agent( ($ENV{'HTTP_USER_AGENT'} || "$NAME $VERSION"));
$ua->env_proxy();
if ( $timeout ) {
  $ua->timeout( $timeout );
} else {
  $timeout = $ua->timeout();
}

# La on balance le  html qui apparaitra dans la page appelante
print "\n<!-- included $ce_script -->\n";

# Get the url
my $results = urlget( $ua, $the_url );

# Print the result
print $results;
print "\n<!--/included $ce_script -->\n";

exit 0;


##### subs #############################################################

sub urlget( $$ ) {
  my ($ua, $url) = @_;
  require HTTP::Headers;
  require HTTP::Request;
  require HTTP::Response;
  my $protocol = 'http';
  if ( $url =~ /^(\w+):\/\// ) {
    $protocol = $1;
  } elsif ( $url =~ /^[^\/]\w/ ) {
    $url = "$protocol://$url";
  } elsif ( $url =~ /^\// ) {
    $url = "$protocol://${server}$url";
  }
  if ( $protocol ne 'http' && $protocol ne 'ftp' ) {
    return "Unauthorized protocol: <strong>$protocol</strong> for Url <strong>$url</strong>\n";
  }
  # get infos to pass trought to the remote server
  my $remote_add = $ENV{'REMOTE_ADDR'};
  my $forwarded_for = $ENV{'HTTP_X_FORWARDED_FOR'};
  if ( $forwarded_for ) {
    $forwarded_for .= ",$remote_add";
  } else {
    $forwarded_for = "$remote_add";
  }
  # Build headers for the request
  my $headers = HTTP::Headers->new( 'Referer' => $ENV{'HTTP_REFERER'} || $ce_script, 
                                    'Accept_Language' => $ENV{'HTTP_ACCEPT_LANGUAGE'}, 
                                    'X_Forwarded_For' => $forwarded_for, 
                                    'Via' => "$ce_script, $NAME v$VERSION", 
                                    "X_$NAME" => "$VERSION", 
                                    'Accept' => $ENV{'HTTP_ACCEPT'} || 'text/html', 
                                  );
  # Build the request
  my $req = HTTP::Request->new( 'GET' => $url, $headers );
  # Launch the request
  my $res = $ua->request( $req );
  if ( !defined $res ) {
    return "Problem including Url <strong>$url</strong>\n"; 
  }

  my $status = "<strong>" . $res->status_line() . "</strong>" ;
  if ( $res->is_success ) {
    # Fine we got it
    return $res->content();

  } elsif ( $res->code() == 401 ) {
    # Need auth!!
    return "Url <strong><a href=\"$url\">$url</a></strong> need <b>authentification</b>\n";

  } elsif ( $res->code() == 404 ) {
    # Need auth!!
    return "Url <strong>$url not found</strong>\n";

  } elsif ( $res->is_error ) {
    # Error 
    return "Url <strong>$url</strong> not accessible with timeout <em>${timeout}s</em>: " . 
      $res->error_as_HTML() . "\n"; 
  }
  return "Url <strong>$url</strong> not accessible with timeout <em>${timeout}s</em> ($status)\n";

} # end urlget();


# Voila c'est fini
1;

# include-url ends here  ------------------------------------------------