#!/usr/local/bin/perl5

# byteserver script
# byteserver.pl
# Last updated May 10, 1996
# This script implements the draft "Byte Range Retrieval Extension to HTTP" described at 
# "http://www.adobe.com/prodindex/acrobat/LIBRARY/drafts/draft-ietf-http-v10-spec-05.txt". 


# place this script wherever you can run CGIs on your Web server.
# 1) Users should make sure that the script as placed in the cgi-bin
#directory is renamed to byteserver.pl, and has execute permission on 
#a UNIX machine. This is done  by typing: chmod 755 byteserver.pl
#2.) The first line of the byteserver.pl script contains a line of the form
#!<pathname>
#where <pathname> points to
#where perl is found on the system.
#Users should modify this line to suit their system-- on a UNIX machine
#you can find out where perl resides by typing: which perl
#if the above returns /usr/local/bin/perl
#then the first line of the byteserver.pl should read
#!/usr/local/bin/perl
#Note: if executing the command: which perl
#returns the message: perl command not found or something similar it
#means that perl is not installed on your system. You *need* perl to
#use byteserver.pl 


# query is of the form
# http://server/cgi-bin/byteserver.pl/path/name/here
#       with HTTP_RANGE specifying the ranges in the form

#       "bytes=m1-n1,m2-n2,...,mn-nn"

#       /path/name/here is relative to server root

#       m-n are ranges (0 based). If m is absent, means n bytes from EOF, if n

#       is absent, mean first m bytes of the file 

#       "bytes=..." syntax

#       STDOUT the ranges

#       The script issues HTTP1.0 206 Partial Content as a partial

#       content response.     

# Env. variables:

#       PATH_TRANSLATED is the file name

#       CONTENT_TYPE is what the server says is the mime type of file

#       REQUEST_METHOD is the request method i.e. GET, POST etc. (we only accept GET)

#       HTTP_RANGE the byte range request





# Return syntax:

# if no ;bytes= is specified, returns:

#       Accept-ranges: bytes

#       Content-type: <content-type>

#       Content-length: <file-length>

#       <the file itself>

# if ;bytes= specified, returns:

#       

#       HTTP/1.0 206 Partial Content

#       Accept-ranges: bytes

#       Content-type: multipart/x-byteranges; boundary=$boundary

#       < multipart-body >

   

sub badjob {

     

local($mesg) = @_;

     

print "Status: 403 \"BOGUS\"\r\n\r\n";

     

print "<HEAD><TITLE>403 BOGUS</TITLE></HEAD>"; print "<BODY><H1>403 BOGUS</H1>";

print "<pre>$mesg</pre>\r\n";

print "Bad Request\r\n\r\n";

exit 1;

}

     

     

$path = $ENV{'PATH_TRANSLATED'};

$ranges = $ENV{'HTTP_RANGE'};

     

($file, $query) = split(/;/,$path);

     

$contenttype = $ENV{'CONTENT_TYPE'};

if ($contenttype eq "") 

{ 

        $contenttype = "application/pdf";

}

     

if ((! -r $file) || (length $file <= 3)) 

{ 

        &badjob("file $file not found");

}

     

if ($ENV{'REQUEST_METHOD'} ne 'GET') 

{ # not URL-based query 

        &badjob("METHOD not GET");

}

     

$size = -s $file;

     

if (($query eq "") && ($ranges eq "")) 

{

        # respond that we can do ranges

        print "Accept-ranges: bytes\r\n";

        print "Content-type: $contenttype\r\n"; 

        printf "Content-Length: %d\r\n\r\n", $size; 

        open(FILE, "< $file");

        while(read(FILE, $buffer, 4096)) {

        print STDOUT $buffer;

}

exit 0;

     

} else {

    if ($ranges ne "")

    { 

        $query = $ranges;

        $query =~ s/bytes=//;

    }

    else

    {           

        $query =~ s/\s+//g; # squeeze all whitespace out 

        $query =~ s/bytes=//; 

    }

     

    #check that the ranges are properly formatted 

    @byterangeCheck = split(/[-,=]/,$query); 

    while (defined($fbyte = shift(@byterangeCheck))) {

        $lbyte = shift(byterangeCheck);

        if (($fbyte > 0) && ($lbyte < 0)) {

                &badjob("query range malformed");

        }

        if (($fbyte < 0) && ($lbyte > 0)) {

                &badjob("query range malformed"); 

        }

        if ($fbyte > $lbyte) {

                &badjob("query range malformed");

        }

     

    }

    @byterange = split(/[,]/,$query);

}

     

# print 206 only if called with official syntax   

if ( $ranges ne "" )

{

        print "Status: 206 Partial Content\r\n";

}



# print other header info

$boundary="multipart-boundary";



print "Accept-ranges: bytes\r\n";



print "Content-type: multipart/x-byteranges; boundary=$boundary\r\n\r\n";

     

# Serve up the bytes:

     

open(FILE, "< $file");

while (defined ($range = shift(@byterange))) {

     

    ($fbyte, $lbyte) = split('-', $range); 

    $i = index($range,"-");

    if ($i == 0) { $fbyte = -1; }

    if ($fbyte < 0) {

        $fbyte = $size - $lbyte;

        $lbyte = $size;

    }

    $nbytes = $lbyte - $fbyte + 1;

     

    print "\r\n--$boundary\r\n";

    print "Content-type: $contenttype\r\n";

    printf "Content-Range: bytes %d-%d/%d\r\n\r\n", $fbyte, $lbyte, $size;

     

    seek(FILE, $fbyte, 0);

    read(FILE, $buffer, $nbytes);

    print STDOUT $buffer;

}

     

print "\r\n--$boundary--\r\n";

     

exit 0;

