#!/usr/bin/perl

#
# simple-httpd.pl
#

use HTTP::Daemon; ## Install LWP.
use HTTP::Status;
use strict ;

my $RN = "\015\012" ;

  my $port = 80 ;

  my $HTTPD = HTTP::Daemon->new(
  #LocalAddr => 'localhost' ,
  LocalPort => $port ,
  Listen    => 5 ,
  Reuse     => 1 ,
  Timeout   => 30 ,
  ) ;
  
  if ($HTTPD) { print "Server on port: $port\n\n" ;}
  else { die "Can't open server at port $HTTPD!\n" ;}
  
  open (LOG,">>log.txt") ;
  my $sel = select(LOG) ; $|=1 ; select($sel) ;
  
  while( (my $connection = $HTTPD->accept) || 1 ) {
    if (!$connection) { next ;}
    
    my %clt = (
    ip => $connection->peerhost ,
    port => $connection->peerport ,
    ) ;
    
    my $req = $connection->get_request ;
    
    print "-----------------------------------------\n" ;
    print LOG "-----------------------------------------\n" ;    
    print "Client: $clt{ip}:$clt{port}\n" ;
    print LOG "Client: $clt{ip}:$clt{port}\n" ;    
    
    if (!$req) { print "Bad Request (400)\n" ;}
    else {
      my $url = &normalize_path( $req->url->path ) ;

      print "URL: $url\n" ;
      print LOG "URL: $url\n" ;
      
      $connection->send_basic_header( 200 ) ; ## 200 (not 403) to can see the HTML in the browser.
      print $connection "Connection: close" . $RN ;
      print $connection "Content-type: text/html" . $RN.$RN ; 
      print $connection "<title>403 Forbidden</title>\n" ;
      print $connection "<b>Forbiden (403)</b><br>\n" ;
      print $connection "Can't access: $url<p>\n" ;
      print $connection "<i>And don't scan my host!!!</i>\n" ;
    }
    
    print "-----------------------------------------\n\n" ;
    print LOG "-----------------------------------------\n\n" ;    
    
    ## Other HTTPD methods:
    # $connection->send_error(403) ;}
    # $connection->send_file_response($root .'/'. $url) ;}
    
    close($connection) ;
  }
  
  close (LOG) ;
  
exit ;

##################
# NORMALIZE_PATH #
##################

sub normalize_path {
  my ( $path ) = @_ ;
  
  if ($path eq '') { return() }
  
  $path =~ s/^\s+//gs ;
  $path =~ s/\s+^//gs ;
  $path =~ s/[\r\n].*$//s ;
  
  my $symb_ok = q`!#$%&'()+,-./:;=@[\]^{}~€ŸÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåæçèéêëìíîïðñòóôõöùúûüýÿ`;
  my $symb_ok_out = q`*<>?"|`;
  
  $path =~ s/[^\w\s\Q$symb_ok\E]//gs ;
  
  $path =~ s/\\+/\//g ;
  
  if ($path !~ /^\// ) { $path = "/$path" ;}
  
  my ($type,$host) ;
  
  if ( $path =~ /^(\w+:)\/\/(.*)$/ ) { ($type,$path) = ($1,$2) }
  
  if ($type =~ /^(https?|ftps?):$/i ) { ($host,$path) = ( $path =~ /^(.*?)(\/.*)$/ ) ;}
  
  $path =~ s/\/+/\//g ;
  $path =~ s/\/$// ;
  
  if ($path =~ /\/\.\.?\//) {
    my @path = split(/\//,$path) ;
    my @path2 ;
    foreach my $path_i ( @path ) {
      if ($path_i eq '.') { next }
      if ($path_i eq '..') { pop (@path2) ; next ;}
      push(@path2 , $path_i) ;
    }
    
    if ($path =~ /^\// && @path2[0] ne '') { unshift (@path2, "") }
    
    $path = join ("/", @path2) ;
  }

  if ($type ne '') { $path = "$type//$host$path" }

  return( $path ) ;
}

#######
# END #
#######