#!/usr/bin/perl -wT

# F*EX document output
#
# is a subprogram of fexsrv! do not run it directly!
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#
# Copyright: GNU General Public License

use CGI::Carp		qw(fatalsToBrowser);
use Fcntl 		qw(:flock :seek);
use POSIX		qw(strftime locale_h);

our ($bs,$tmpdir); # import from fex.pp

my $log = "$logdir/dop.log";

# POSIX time format needed for HTTP header
setlocale(LC_TIME,'POSIX');

sub dop {
  my $doc = shift;
  my $seek = 0;
  my ($link,$host,$path);
  
  our $error = 'F*EX document output ERROR';
  
  # reget?
  if ($ENV{HTTP_RANGE} and $ENV{HTTP_RANGE} =~ /^bytes=(\d+)-$/i) {
    $seek = $1;
  }

  # redirect on relative symlinks without ".." 
  if ($link = readlink($doc) and 
      $link !~ m:^/: and $link !~ m:\.\./:) {
    $path = $ENV{REQUEST_URI};
    $path =~ s:[^/]*$::;
    $doc = "$path/$link";
    $doc =~ s:/+:/:g;
    $doc =~ s:^/::;
    $host = $ENV{HTTP_HOST} || $hostname;
    nvt_print(
      "HTTP/1.1 301 Moved Permanently",
      "Location: $ENV{PROTO}://$host/$doc",
      ""
    );
    exit; 
  }
    
  if (-f $doc) {
    if (-r $doc) {
      http_output($doc,$seek);
    } else {
      http_error(403);
    }
  } else {
    http_error(404);
  }

}

sub http_output {
  my ($file,$seek) = @_;
  my ($filename,$size,$total_size);
  my ($data,$type);
  my $htmldoc = '';
  my $s = 0;
  my $b = 0;
  my $http_client = $ENV{HTTP_USER_AGENT} || '';
  local $_;

  open $file,'<',$file or http_error(500);
  
  $type = 'application/octet-stream';
  if    ($file =~ /\.html$/)	{ $type = 'text/html' } 
  elsif ($file =~ /\.css$/)	{ $type = 'text/css' }
  elsif ($file =~ /\.ps$/)	{ $type = 'application/postscript' }
  elsif ($file =~ /\.pdf$/)	{ $type = 'application/pdf' }
  elsif ($file =~ /\.jpg$/)	{ $type = 'image/jpeg' }
  elsif ($file =~ /\.png$/)	{ $type = 'image/png' }
  elsif ($file =~ /\.gif$/)	{ $type = 'image/gif' }
  elsif ($file !~ /\.(zip|jar|rar|7z|gz)$/) {
    my $qfile = $file;
    $qfile =~ s/([^\/\.\+\w!=,_-])/\\$1/g;
    if (open my $cmd,"file -L $qfile|") {
      $_ = <$cmd> || '';
      if (/text/i and not /executable/) {
        $type = 'text/plain';
      }
      close $cmd;
    }
  }
  
  if ($type eq 'text/html') {
    $seek = 0;
    while (<$file>) {
      # evaluate $variables$ with value from environment
      while (/\$([\w_]+)\$/) {
        $var = $1;
        $env = $ENV{$var} || '';
        s/\$$var\$/$env/g;
      };
      $htmldoc .= $_;
    }
    $total_size = $size = $s = length($htmldoc);
  } else {
    $total_size = -s $file || 0;
    $size = $total_size - $seek;
  }
  
  alarm($timeout*10);
  
  if ($seek) {
    my $range = sprintf("bytes %s-%s/%s",$seek,$total_size-1,$total_size);
    nvt_print(
      'HTTP/1.1 206 Partial Content',
      'Server: fexsrv',
      "Content-Length: $size",
      "Content-Range: $range",
      "Content-Type: $type",
      '',
    );
  } else {
    # Java (clients) needs Last-Modified header!
    nvt_print(
      'HTTP/1.1 200 OK',
      'Server: fexsrv',
      'Last-Modified: '.http_date($file),
      "Content-Length: $size",
      "Content-Type: $type",
      '',
    );
  }

  if ($ENV{REQUEST_METHOD} eq 'GET') {
    seek $file,$seek,0;
    if ($type eq 'text/html') {
      alarm($timeout*10);
      print $htmldoc;
    } else {
      # binary data
      while ($b = read($file,$data,$bs)) {
        $s += $b;      
        alarm($timeout*10);
        print $data or last;
      }
    }
    fdlog($log,$file,$s,$size);
  }
  
  alarm(0);
  close $file;
  return $s;
}


sub http_date {
  my $file = shift;
  my @stat;
  
  if (@stat = stat($file)) {
    return strftime("%a, %d %b %Y %T GMT",gmtime($stat[9]));
  } else {
    return 0;
  }
}

1;
