#!/usr/bin/perl -w
# sanada0.pl - Don Yang (uguu.org)
#
# sanada0.pl <filename> [port] [type]
#
# <filename> is name of file to serve.
# [port] is where to listen for requests, default is 80.
# [type] is content type of file, default is application/octet-stream.
#
# For incomplete sends, Sanada-san will indicate this with a ~ prefix
# in number of bytes sent.  This is always an overestimate due to buffering.
# For small files, Sanada-san always assume the entire file got sent properly.
#
# 11/26/03


use strict;
use Socket;

local (*SERVER, *CLIENT, *FILE);
my ($Name, $Port, $Type, $Size, $HEADER, $EOL);

sub Text
{
   print "$$: ", (scalar(localtime)), ": @_\n";
}

sub Header
{
   my ($start, $end) = @_;
   my ($header, $status);

   if( $start >= $Size || $end >= $Size || $end < $start )
   {
      $header =
         "HTTP/1.1 416 Requested Range Not Satisfiable$EOL" .
         "Content-Range: bytes */$Size$EOL";
      $status = 0;
   }
   else
   {
      if( $start > 0 || $end < $Size - 1 )
      {
         $header =
            "HTTP/1.1 206 Partial Content$EOL" .
            "Content-Range: bytes $start-$end/$Size$EOL";
      }
      else
      {
         $header = "HTTP/1.1 200 OK$EOL";
      }
      $header .= "Content-Length: " . ($end - $start + 1) . $EOL;
      $status = 1;
   }
   return ($header . $HEADER, $status);
}

sub SendFile
{
   my ($request, $start, $end, $size, $data, $status);

   binmode(CLIENT);
   defined(recv(CLIENT, $request, 1024, 0)) || die $!;

   $start = 0;
   $end = $Size - 1;
   if( $request =~ /\s+user-agent:\s*([^\r\n]+)/i )
   {
      Text("agent=$1");
   }
   if( $request =~ /\s+referer:\s*([^\r\n]+)/i )
   {
      Text("referer=$1");
   }
   if( $request =~ /\s+range:\s*bytes=(\d+)-(\d+)/i )
   {
      $start = $1;
      $end = $2;
   }
   elsif( $request =~ /\s+range:\s*bytes=(\d+)-/i )
   {
      $start = $1;
   }
   elsif( $request =~ /\s+range:\s*bytes=-(\d+)/i )
   {
      $start = $Size - $1;
   }

   ($data, $status) = Header($start, $end);
   send(CLIENT, $data, 0) || die $!;
   if( $status && ($request =~ /^GET /) )
   {
      $status = 0;
      open(FILE, "< $Name");
      $end++;
      for(seek(FILE, $start, 0); $start < $end; $start += $size)
      {
         if( ($size = $end - $start) > 0x4000 )
         {
            $size = 0x4000;
         }
         read(FILE, $data, $size);
         last unless defined(send(CLIENT, $data, 0));
         $status += $size;
      }
      close(FILE);
      $status = "~" . $status if( $start < $end );
      Text("sent $status bytes");
   }
   shutdown(CLIENT, 2);
   close(CLIENT);
   exit(0);
}

sub Serve
{
   my ($rin, $rout, $i, $j);

   $SIG{"CHLD"} = "IGNORE";
   die "$!\n" unless(
      socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname("tcp")) &&
      bind(SERVER, sockaddr_in($Port, INADDR_ANY)) &&
      listen(SERVER, 5) &&
      binmode(SERVER));
   $rin = "";
   vec($rin, fileno(SERVER), 1) = 1;
   Text("serving $Name (type=$Type, size=$Size)");
   Text("listening on port $Port");
   while( select($rout = $rin, undef, undef, undef) )
   {
      if( vec($rout, fileno(SERVER), 1) )
      {
         $j = accept(CLIENT, SERVER);
         ($j, $i) = sockaddr_in($j);
         $i = inet_ntoa($i);
         if( fork )
         {
            close(CLIENT);
         }
         else
         {
            Text("request from $i:$j");
            SendFile();
         }
      }
   }
   die "$!\n";
}

die "$0 <file> [port] [type]\n" unless( $#ARGV > -1 );
($Name, $Port, $Type) = @ARGV;
die "$Name is empty\n" unless( (-f $Name) && ($Size = -s $Name) > 0 );
$Port ||= 80;
$Type ||= "application/octet-stream";
$EOL = "\r\n";
$HEADER =
   "Server: Sanada-san$EOL" .
   "Accept-Ranges: bytes$EOL" .
   "Content-Type: $Type$EOL" .
   "Connection: close$EOL$EOL";
Serve();