@REM = '########################################################################
echo OFF
cls
echo ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
echo ³ ÛÛÛÛÛÛÛÛ²²²²²±±±±°°    TWiki mini web server    °°±±±±²²²²²ÛÛÛÛÛÛÛÛ ³
echo ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
echo ...
rem Define where TWiki can store some temporary files :
set TEMP=.

rem At first, we suppose PERL is installed..
set PERL=perl.exe

rem but, in fact, just a copy will be ok...but let me guess where it is ;-)
for %%d in (PERL) do if exist %%d\bin\perl.exe set PERL=%%d\bin\perl.exe

if "%1"=="STARTING_BROWSER" goto LAUNCH_BROWSER
start %0 STARTING_BROWSER 3 2 1

%PERL% %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
goto END
##############################################################################';
#!/usr/local/bin/perl
#
# - TWiki mini PERL web server - Patrick Nomblot 2003
#
# $Header: /cvs/TOOLS/TWiki/TWikiHttpd.bat,v 1.10 2003/12/09 15:00:18 nomblot Exp $
#
#
#
# History :
#
# $Log: TWikiHttpd.bat,v $
# Revision 1.10  2003/12/09 15:00:18  nomblot
# Fix redirect for some cases
#
# Revision 1.9  2003/07/02 09:22:30  nomblot
# Correct progname value (del .* extension)
#
# Revision 1.8  2003/06/25 16:05:02  nomblot
# UTF8 support
#
# Revision 1.7  2003/06/25 13:52:27  nomblot
# Merge .bat and .pl
#
# Revision 1.6  2003/06/24 15:08:37  nomblot
# Correction of TWiki debug.txt filename setting in TWiki.cfg
#
# Revision 1.5  2003/06/20 16:02:14  nomblot
# Batch header in separated file : TWikiHttpd.bat
# Compatible Win98
# Renamed TWikiHttpd.pl
# Enhance PERL detection
# suppressed LOG option from TK (not running because of forked process)
# LOG activated when one or more options are given to th script
# No more patch to TWiki Search.pm done, run well with Search.pm with no pipe (http://twiki.org/cgi-bin/view/Codev/SearchWithNoPipe)
#
# Revision 1.4  2003/06/19 14:39:17  nomblot
# Backup TWiki patched files and restore them at exit.
#
# Revision 1.3  2003/06/18 13:29:38  nomblot
# Make it running on Linux
# automatic fowarding  to starting TWiki url on web root
#
#
#
################################################################################


use strict;
use IO::Socket;
use Net::hostent;
use Cwd;

################################################################################
# Declare vars
################################################################################
use vars qw($TWiki $cgiURL);
use vars qw($PERL $PERLDIR $TWikiDIR $UNIXDIR $temp $htmldir);  
use vars qw($PostOptFile $logfile $parentPID $TWikiUserfile);
use vars qw($FileBackupSuffix @FilesToRestore);
use vars qw($server $port $client $inetaddr $user $LogTrafic $EOL);
use vars qw(%errors %verrors $line);
use vars qw($content_length $content_type $http_host $starturl);
use vars qw($progname $Revision $title);
use vars qw($TK);
use vars qw($parentPID);



################################################################################
# Add PERL libs in @INC if you use a copy of PERL (did not installed it)
################################################################################
BEGIN
{
  # Make PERL running well in case PERL is not installed

  $PERL="$^X";                  # This is current PERL binary 
  $PERLDIR= "$PERL";
  $PERLDIR=~s|.bin.perl.*$||g;  # And this is where perl should be
  
  print "$PERLDIR $0 started ";
  if ($#ARGV >= 0) 
  { 
    $LogTrafic        = "1"; 
    print "(debug mode)";
  }
  print "...\n";


  if ( -d "$PERLDIR" )
  {
    push(@INC,"$PERLDIR/lib");
    push(@INC,"$PERLDIR/site/lib");
    $PERL="$PERL -I$PERLDIR/lib  -I$PERLDIR/site/lib";
  }
}


################################################################################
# Try to use TK if available
################################################################################
$@ = '';
$TK=1;
eval 'use Tk;';
eval 'use Tk::LabEntry;';
eval 'use Tk::Menubutton;';
if ($@) {$TK=0;} 


################################################################################
# Be polite when exit....
################################################################################
$SIG{'HUP'}  = \&Exit;
$SIG{'INT'}  = \&Exit;       
$SIG{'QUIT'} = \&Exit;
$SIG{'TERM'} = \&Exit;       


################################################################################
# Programm / revision
################################################################################
$Revision  = '$Revision: 1.10 $';
$Revision  =~ s/^\$//g;
$Revision  =~ s/\$$//g;
$progname  =  progname($0);    
$progname  =~ s/\..*//;
$title     = "TWiki Httpd mini web server $Revision   ---  P. Nomblot - 2003";
$parentPID = $$;
$line      = "-"x79;

################################################################################
# Configuration section
################################################################################
$TWiki            = "TWiki";                        # TWiki name
$TWikiDIR         = cwd()."/${TWiki}";              # TWiki DIR
$UNIXDIR          = cwd()."/UNIX";                  # UNIX DIR (for grep)
$temp             = $ENV{TEMP} || ".";              # Temp DIR
$logfile          = "$temp/${progname}.log";        # Log filename
$TWikiUserfile    = "$temp/${progname}_user";       # TWiki user filename
$FileBackupSuffix = "_Saved_by_${progname}"; # Key word to rename patched files


################################################################################
# PERL / TWiki settings : make PERL find TWiki libs
################################################################################
$PERL="$PERL" . " -I$TWiki/lib -I$TWiki/bin";


################################################################################
# WEB server definitions
################################################################################
$htmldir=".";                               # Base directory for HTML files
$cgiURL="/${TWiki}/bin";                    # CGI url to CGI scripts
$port=80;                                   # Port on which we listen
$http_host="127.0.0.1";                     # The local host address
$EOL = "\015\012";                          # HTML End Of Line (platform independant)
$PostOptFile="$temp/${progname}PostOpt$$";  # Post file to store POST opts
$user=GetUser();                            # HTTP User id 

$starturl="http://${http_host}$cgiURL/view/Main/WebHome";


################################################################################
# Here we start
################################################################################
print <<EndOfWellcome;
$line
$title
$line
                            WARNING !                                        
                           ----------                                        

TWikiHttpd has been created to allow you, and only you, to read TWiki topics 
content when a real Web Server is not available. 


TWikiHttpd must not be used in place of a standard WEB server (like APACHE) 
and should not be used to share webs to other users to collaborate.

$line

EndOfWellcome


################################################################################
# Setup TWiki Config file / patch if needed
################################################################################
SetupTwiki();


################################################################################
# TK setup (if we have TK, else edit user file...)
################################################################################
if ($TK)
{
  my  $pid = fork;
  die "Cannot fork: $!" unless defined $pid;

  unless ($pid) 
  {
    my $window = new MainWindow;
    $window->title("$title");

    my $cadre  = $window->Frame(-relief =>'flat', -borderwidth => '2');
    $cadre->Label(-text =>"TWiki user login name", -anchor => "e")->pack(-side => 'left');
    $cadre->Entry(-width => "25", -textvariable => \$user)->pack(-side => 'left');
#    $cadre->Checkbutton(-text =>"Log trafic", -variable => \$LogTrafic)->pack(-side => "left");
    $window->Button(-text => "Exit",              -command=> sub{Exit()})->pack(-side => 'right');
#    $window->Button(-text => "Launch navigator",  -command=> sub{LaunchNavigator()})->pack(-side => 'right');
    $window->Button(-text => "Define TWiki user", -command=> sub{SetUser($user)})->pack(-side => 'right');
    $cadre->pack;
    MainLoop();
    exit();
  }
}
else
{
  print("\nWarning, PERL TK is not installed.\n");
  print("\nYou may define TWiki Remote user in file [$TWikiUserfile] .\n");
}


################################################################################
# HTTP server
################################################################################

# Messages
%verrors=
    (
     "403", "Your client is not allowed to request this item",
     "404", "The requested item was not found on this server",
     "500", "An error occurred while trying to retrieve item",
     "501", "This server does not support the given request type",
     );

# set up a server socket, redirect stderr to logfile


$server = IO::Socket::INET->new( Proto     => 'tcp',
                                 LocalPort => $port,
                                 Listen    => SOMAXCONN,
                                 Reuse     => 1);
die "can't setup server" unless $server;

print "Logfile = $logfile\n";
open(LOG,">$logfile");
select(LOG); $|=1;
open(STDERR, ">&LOG") || die "Cannot redirect STDERR to LOG file $logfile";

print "Server $0 accepting clients, \nstart your browser on [$starturl]\n";

while ($client = $server->accept()) 
{
  $client->autoflush(1);
  $inetaddr=$client->peeraddr;
  my $hostinfo = gethostbyaddr($inetaddr);

  Log ("Connect from: name=", $hostinfo->name , "   IP=", $client->peerhost);
  &serve_request($client);

  close $client;
}



################################################################################
# serv HTTP request 
################################################################################

sub serve_request 
{
  my $client=shift;

  # Analyze HTTP input.
  $_=<$client>;

  Log("Client says : $_");
  my ($method, $url, $proto) = split;

  # Process special chars
  $url =~ s/%(..)/pack("H2",$1)/eg;

  if ($proto) 
  {
    while (<$client>) 
    { 
      s/\n|\r//g; # kill CR and NL chars
      /^Host: (\S*)/i && ($http_host=$1);
      /^Content-Length: (\S*)/i && ($content_length=$1);
      /^Content-Type: (\S*)/i && ($content_type=$1);
      Log("Client says : $_");
      length || last; # empty line - end of header
    }
  }
  else 
  {
    $proto="HTTP/0.9";
  }

  ($method=~/^(GET|POST)$/) || do { &error(501,$method); return; };

  my $opts;
  my $file=$url;
  $user=GetUser();

  Log ("ProcessUrl  : $method $url");

  if ( $method eq "POST" ) 
  {
    my $data;
    if (read($client,$data,$content_length) !=$content_length) { &error(500,"$url"); die; return; }
    Log("POST=$data");
    open (FILE, ">$PostOptFile");
    print FILE "$data\n";
    close FILE;
  }

  if ($url=~m:^$cgiURL/:i) 
  {
    if ($url=~m:^$cgiURL/(\w+)/(.*):i) 
    {
      $file="$cgiURL/$1";
      my $PATH_INFO="$2";
      $PATH_INFO=~ s/\?.*//;
      $ENV{'PATH_INFO'}="/$PATH_INFO";
      Log ("ProcessUrl  : PATH_INFOS=/$PATH_INFO");
    }


    # generate command line
    $file=~s:^/::o;
    if ($url=~m:(.*)\?(.*):) 
    { 
       $url=$1;
       $opts=$2; 
       $file=~s/\?.*//;
    }
    Log ("ProcessUrl  : url  = $url");
    Log ("ProcessUrl  : file = $file");
    Log ("ProcessUrl  : opts = $opts");
    Log ("ProcessUrl  : USER = $user");

    # Execute CGI scripts
    # TODO: SERVER_NAME, PATH_TRANSLATED, 
    # SCRIPT_NAME, QUERY_STRING
    $ENV{'CONTENT_TYPE'}=$content_type;
    $ENV{'CONTENT_LENGTH'}=$content_length;
    $ENV{'GATEWAY_INTERFACE'}="CGI/1.0";
    $ENV{'HTTP_HOST'}="$http_host";
    $ENV{'SERVER_PORT'}=$port;
    $ENV{'SERVER_PROTO'}=$proto;
    $ENV{'REQUEST_METHOD'}=$method;
    $ENV{'REQUEST_URI'}="/$file";
    $ENV{'REMOTE_ADDR'}=$inetaddr;
    $ENV{'QUERY_STRING'}=$opts;
    $ENV{'REMOTE_USER'}=$user;
    $ENV{'SERVER_SOFTWARE'}="$progname";

    ProcessCGI($client, "$PERL -wT $file $opts", $method);
  } 
  else 
  {
    # Get and return file
    GetFile($client, "$url");
  }
  Log ("ProcessUrl  : ------------ Done -------------");
}




################################################################################
# Get HTTP file
################################################################################
sub GetFile
{
  my($client,$url) = @_;

  $url =~ s/\?.*//;
  my $file="$htmldir$url";
  Log ("ProcessGet  : [$url]");

  if ( "$url" eq "\/" )
  {
    # Send the Server Welcome !
    Welcome($client);
  }
  else
  {
    (-r "$file") || do { &error(404,"$file"); return; };
    print $client "HTTP/1.0 200 OK\nMIME-Version: 1.0\nContent-Type: ";
    # output the file
    CASE:	
    {
        $url=~/\.(htm|html)$/ && do { print $client "text/html\n\n"; last CASE; };
        $url=~/\.png$/        && do { Log ("PNG file : $file"); print $client "image/png\n\n"; last CASE; };
        $url=~/\.(gif|jpg)$/  && do { print $client "image/gif\n\n"; last CASE; };
        print $client "text/plain\n\n";
    }
    open (FILE, "<$file");
    binmode(FILE);
    while (my $line= <FILE>) {print $client "$line"; }
    close (FILE); 
  }
}




################################################################################
# Run CGI script
################################################################################
sub ProcessCGI 
{
  my($client,$command, $method) = @_;

  if ( $method eq "POST" ) { $command = "$command <$PostOptFile"; }

  Log ("ProcessCGI  : exec $command");

  my @output = qx/$command/;
  Log ("\n$line\nOUTPUT = @output\n$line\n");

  # Extract the HTTP header
  my @tmp= split ("\n \n", "@output");
  my $HTTP_header = @tmp[0];
  Log ("\n$line\nHTTP HEADER = $HTTP_header\n$line\n");

  if (     ("$HTTP_header" =~ /Status: 302 Moved/i)
        && ("$HTTP_header" =~ m#location: (.*)#i)
     )
  { 
    my $url="$1";

    print $client "HTTP/1.0 302 OK${EOL}MIME-Version: 1.0${EOL}";
    print $client @output;
    Log ("ProcessCGI  : MOVED --> [$url]");
  }
  else
  {
    # return the output to the caller

    print $client "HTTP/1.0 200 OK${EOL}MIME-Version: 1.0${EOL}";
    print $client @output;
  }
  Log ("ProcessCGI  : done");
}




################################################################################
# LOG to log file
################################################################################
sub Log 
{
  if ( $LogTrafic ) 
  {
    my ($texte) = "@_";
    my ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
    $year+=1900;
    my ($date) =  sprintf ("%4u/%02u/%02u %02u:%02u:%02u", $year, $mon, $mday, $hour, $min, $sec);

    print LOG "$date > $texte\n";
  }
}



################################################################################
# ERROR
################################################################################
sub error 
{
  # generate HTTP error response
  my ($errno) = @_[0];
  my ($errmsg) = "$errno $verrors{$errno}";
  Log ("$errmsg (@_[1,2])");
  print <<End;
HTTP/1.0 $errmsg
MIME-version: 1.0
Content-type: text/html

<HTML>
<HEAD><TITLE>$errmsg</TITLE></HEAD>
<BODY><H1>$errmsg</H1>
$verrors{$errno}: <PRE> @_[1] </PRE>
</BODY>
</HTML>
End
}

################################################################################
# Welcome
################################################################################
sub Welcome
{
  my $client=shift;

  # generate a default Home page for TWiki Httpd server
  print $client <<End;
HTTP/1.0 200 OK
MIME-Version: 1.0
Content-type: text/html


<META HTTP-EQUIV="Refresh" CONTENT="1;URL=$starturl">
<HTML>
<HEAD><TITLE>$title</TITLE></HEAD>
<BODY><H3>$title</H3>


Your browser should go into TWiki Main page in a few seconds....
<BR>
or Clic here to Enter <A HREF="$starturl">TWiki</A>
<P>

<SCRIPT language="javascript">
<!--
  parent.location="$starturl";
-->
</SCRIPT>

</BODY>
</HTML>
End
}

################################################################################
# Define HTTP USER
################################################################################
sub SetUser
{
  open(USER,">$TWikiUserfile");
  print USER "$user";
  close (USER);
}

################################################################################
# Get HTTP USER
################################################################################
sub GetUser
{
  open(USER,"<$TWikiUserfile");
  $user = <USER>;
  close (USER);
  return($user);
}


################################################################################
# Launch NAVIGATOR
################################################################################
sub LaunchNavigator
{
  if ($^O =~ /Win/i)
  {
    system ("start $starturl");  # It's really slow !
  }
  else
  {
    # Don't know how to do that on other platforms
  }
}


################################################################################
# Extract progname from a path
################################################################################
sub progname
{
  my $p=shift;
  $p =~s|\\|/|g;
  my @tmp = split('/',$p);
  return(pop @tmp);
}


################################################################################
# Setup TWiki config file
################################################################################
sub SetupTwiki
{
  if ( ! -d "$TWikiDIR" ) { die "ERROR : TWiki dir [$TWikiDIR] not found !\n Died"; }


  my %config = ( '^(\$defaultUrlHost).*',      "\$1 = \"http://localhost\";           ",
                 '^(\$scriptUrlPath).*',       "\$1 = \"/${TWiki}/bin\";              ",
                 '^(\$pubUrlPath).*',          "\$1 = \"/${TWiki}/pub\";              ",
                 '^(\$pubDir).*',              "\$1 = \"${TWikiDIR}/pub\";            ",
                 '^(\$templateDir).*',         "\$1 = \"${TWikiDIR}/templates\";      ",
                 '^(\$dataDir).*',             "\$1 = \"${TWikiDIR}/data\";           ",
                 '^(\$logDir).*',              "\$1 = \"\$dataDir\";                  ",
                 '^(\$debugFilename).*',       "\$1 = \"${TWikiDIR}/data/debug.txt\"; ",
               );


  if ( $^O =~ /Win/i )  # If running on Windows, set GREP.EXE cmd
  {
   $UNIXDIR =~ s/\//\\\\/g;
   %config=(%config , ('^(\$lsCmd).*',               "\$1 = \"${UNIXDIR}\\\\ls.exe -a \";      ",
                       '^(\$egrepCmd).*',            "\$1 = \"${UNIXDIR}\\\\grep.exe -E \";    ",
                       '^(\$fgrepCmd).*',            "\$1 = \"${UNIXDIR}\\\\grep.exe -F \";    ",
                      ) 
           );
  }

  Replace ("${TWiki}/lib/TWiki.cfg", %config);   
    

  # Reset the TWiki Admin Group (to prevent TWiki from sending a mail to admins...)
  Replace (  "${TWiki}/data/Main/TWikiAdminGroup.txt", 
            ('^(	\* Set GROUP = ).*', "\$1") 
          );

  print "Note : modified files will be restored at exit\n";
}


################################################################################
# Replace regex in a file
################################################################################
sub Replace
{
  my ($file, %hash)= @_;

  print "Patching file $file ";
  open (FILE , "<$file") || die ("cannot read $file");
  my @lines=<FILE>;
  close (FILE);

  
  if ( ! -e "${file}${FileBackupSuffix}") 
  {
    print "(file backuped)\n";
    open (FILE,">${file}${FileBackupSuffix}") || die ("cannot write ${file}${FileBackupSuffix}");
    print FILE @lines;
    close (FILE);
  }
  else
  {
    print ": WARNING backup file already exist !\n";
  }
  open (FILE,">$file") || die ("cannot write $file");
  foreach my $line (@lines)
  {
    foreach my $regex (keys %hash)
    {
      if ( "$line" =~ /$regex/ig )
      {
        my $p1="$1"; 
        my $with="$hash{$regex}";
        $with =~ s/\$1/$p1/;

        Log ("Replace in $file : $regex --> $with");
        eval '$line =~ s#$regex#$with#;' ;
      }
    }
   print FILE "$line";
  }
  close (FILE);
  push (@FilesToRestore, "$file");
}


################################################################################
# Restore modified files
################################################################################
sub RestoreFiles
{
  my (@files) = @_;

  foreach my $file (@files)
  {
    print "Restoring file $file \n";
    rename("${file}${FileBackupSuffix}", "$file") || print STDERR ("cannot restore ${file}${FileBackupSuffix}");
  }
}



################################################################################
# By By 
################################################################################
sub Exit
{
  RestoreFiles(@FilesToRestore);
  close LOG;
  kill (9, $parentPID);
  exit(0);
}


__END__


rem -----------------------------------------------------------------------
rem Wait a few seconds and then launch browser ....
rem -----------------------------------------------------------------------

:LAUNCH_BROWSER
shift
if "%1"=="" goto DO_LAUNCH
echo Starting browser in %1 seconds...
%PERL% -e "sleep 1;"
goto LAUNCH_BROWSER

:DO_LAUNCH
echo Starting browser now !
start http://127.0.0.1/
exit
goto END

:END