Ticket #12437: stream_raw.pl

File stream_raw.pl, 4.7 KB (added by deg@…, 5 years ago)

fixed stream_raw.pl

Line 
1#!/usr/bin/perl
2#
3# MythWeb Streaming/Download module
4#
5#
6
7    $| = 1;
8
9    use HTTP::Date;
10
11# File size
12    my $size = -s $filename;
13
14# Zero bytes?
15    if ($size < 1) {
16        print header(),
17              "$basename is an empty file.";
18        exit;
19    }
20
21
22# File type
23    my $type   = 'text/html';
24    my $suffix = '';
25    if ($basename =~ /\.mpe?g2?$/) {
26        $type   = 'video/mpeg';
27        $suffix = '.mpg';
28    }
29    elsif ($basename =~ /\.ts$/) {
30        $type   = 'video/mp2t';
31        $suffix = '.ts';
32    }
33    elsif ($basename =~ /\.nuv$/) {
34        $type   = 'video/nuppelvideo';
35        $suffix = '.nuv';
36    }
37    elsif ($basename =~ /\.mkv$/) {
38        $type   = 'video/x-matroska';
39        $suffix = '.mkv';
40    }
41    elsif ($basename =~ /\.mp4$/) {
42        $type   = 'video/mp4';
43        $suffix = '.mp4';
44    }
45    elsif ($basename =~ /\.avi$/) {
46        $type   = 'video/x-msvideo';
47        $suffix = '.mp4';
48    }
49    elsif ($basename =~ /\.mov$/) {
50        $type   = 'video/quicktime';
51        $suffix = '.mov';
52    }
53    elsif ($basename =~ /\.wmv$/) {
54        $type   = 'video/x-ms-wmv';
55        $suffix = '.wmv';
56    }
57    elsif ($basename =~ /\.3gp$/) {
58        $type   = 'video/3gpp';
59        $suffix = '.3gp';
60    }
61    elsif ($basename =~ /\.ogv$/) {
62        $type   = 'video/ogg';
63        $suffix = '.ogv';
64    }
65    elsif ($basename =~ /\.webm$/) {
66        $type   = 'video/webm';
67        $suffix = '.webm';
68    }
69    else {
70        print header(),
71              "Unknown video type requested:  $basename\n";
72        exit;
73    }
74
75# Download filename
76    my $name = $basename;
77    if ($name =~ /^\d+_\d+\.\w+$/) {
78        if ($title =~ /\w/) {
79            $name = $title;
80            $name .= sprintf(" - %dx%02d", $season, $episode) if $season and $episode;
81            if ($subtitle =~ /\w/) {
82                $name .= " - $subtitle";
83            }
84        }
85        $name .= $suffix;
86    }
87
88# Open the file for reading
89    unless (sysopen DATA, $filename, O_RDONLY) {
90        print header(),
91              "Can't read $basename:  $!";
92        exit;
93    }
94
95# Binmode, in case someone is running this from Windows.
96    binmode DATA;
97
98    my $start      = 0;
99    my $end        = $size;
100    my $total_size = $size;
101    my $read_size  = 1024;
102    my $mtime      = (stat($filename))[9];
103
104# Handle cache hits/misses
105    if ( $ENV{'HTTP_IF_MODIFIED_SINCE'}) {
106        my $check_time = str2time($ENV{'HTTP_IF_MODIFIED_SINCE'});
107        if ($mtime <= $check_time) {
108            print header(-Content_type           => $type,
109                         -status                 => "304 Not Modified"
110                        );
111            exit;
112        }
113    }
114
115# Requested a range?
116    if ($ENV{'HTTP_RANGE'}) {
117    # Figure out the size of the requested chunk
118        ($start, $end) = $ENV{'HTTP_RANGE'} =~ /bytes\W+(\d*)-(\d*)\W*$/;
119        if ($end < 1 || $end > $size) {
120            $end = $size;
121        }
122        $size = $end - $start+1;
123        if ($read_size > $size) {
124            $read_size = $size;
125        }
126        print header(-status                => "206 Partial Content",
127                     -type                  => $type,
128                     -Content_length        => $size,
129                     -Accept_Ranges         => 'bytes',
130                     -Content_Range         => "bytes $start-$end/$total_size",
131                     -Last_Modified         => time2str($mtime),
132                     -Content_disposition => " attachment; filename=\"$name\""
133                 );
134    }
135    else {
136        print header(-type                  => $type,
137                    -Content_length         => $size,
138                    -Accept_Ranges          => 'bytes',
139                    -Last_Modified          => time2str($mtime),
140                    -Content_disposition => " attachment; filename=\"$name\""
141                 );
142    }
143
144# RFC 3875 4.3.3. script MUST NOT provide a response message-body for a HEAD request
145    if ($ENV{'REQUEST_METHOD'} eq 'HEAD') {
146        exit;
147    }
148
149# Seek to the requested position
150    sysseek DATA, $start, 0;
151
152# Print the content to the browser
153    my $buffer;
154    while (sysread DATA, $buffer, $read_size ) {
155    # Exit if the output pipe is broken i.e. client disconnect
156        unless (print $buffer ) {
157            last;
158        }
159        $size -= $read_size;
160        if ($size <= 0) {
161            my $fileSize = -s $filename;
162            my $filePos  = tell DATA;
163            if ( ($fileSize - $filePos) > 0 ) {
164                $size = $fileSize - $filePos;
165            }
166            else {
167                last;
168            }
169        }
170        if ($size < $read_size) {
171            $read_size = $size;
172        }
173        if ($read_size < 0) {
174            $read_size = 0;
175        }
176    }
177    close DATA;
178
179    1;