├── README.md
└── hls-fetch


/README.md:
--------------------------------------------------------------------------------
 1 | hls-fetch
 2 | =========
 3 | 
 4 | Introduction
 5 | ------------
 6 | 
 7 | hls-fetch is a small program that downloads and decrypts HTTP Live Streaming
 8 | (HLS) videos. HLS is commonly used for streaming video on Apple iOS devices.
 9 | 
10 | hls-fetch can download videos from web pages with embedded <video> tags,
11 | from SVT Play (svtplay.se), or from M3U playlist directly. It will
12 | decrypt streams if necessary and assemble individual segments, to produce a
13 | single MPEG transport stream (.ts) file playable in most media players.
14 | 
15 | It is written in Perl.
16 | 
17 | Author and Feedback
18 | -------------------
19 | 
20 | hls-fetch is written by Oskar Liljeblad <oskar@osk.mine.nu>.
21 | 
22 | This software is a work in progress and there are probably many ways it can
23 | still be improved. If you'd like to contribute patches, ideas, or bug
24 | reports, please don't hesitate contacting me!
25 | 
26 | License
27 | -------
28 | 
29 | hls-fetch is copyright (C) 2012 Oskar Liljeblad.
30 | 
31 | This program is free software: you can redistribute it and/or modify
32 | it under the terms of the GNU General Public License as published by
33 | the Free Software Foundation, either version 3 of the License, or
34 | (at your option) any later version.
35 | 
36 | This program is distributed in the hope that it will be useful,
37 | but WITHOUT ANY WARRANTY; without even the implied warranty of
38 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
39 | GNU General Public License for more details.
40 | 
41 | You should have received a copy of the GNU General Public License
42 | along with this program.  If not, see <http://www.gnu.org/licenses/>.
43 | 
44 | Download
45 | --------
46 | 
47 | The latest hls-fetch can be downloaded from GitHub:
48 | 
49 |  * <https://github.com/osklil/hls-fetch>
50 | 
51 | Requirements
52 | ------------
53 | 
54 |  * Perl 5.10.0 (or later).
55 |    Debian: perl
56 | 
57 |  * OpenSSL (only needed for encrypted streams).
58 |    Debian: openssl
59 | 
60 |  * HTML::Parser Perl module.
61 |    Debian: libhtml-parser-perl
62 | 
63 |  * LWP::UserAgent Perl module.
64 |    Debian: libwww-perl
65 | 
66 |  * JSON Perl module.
67 |    Debian: libjson-perl
68 | 
69 |  * URI Perl module.
70 |    Debian: liburi-perl
71 | 
72 | Usage
73 | -----
74 | 
75 | All you need to specify on the command line is the URL to fetch.
76 | hls-fetch will download the page and look for a <video> tag.
77 | If you know the M3U playlist URL, then use the --playlist parameter
78 | along with the URL to tell hls-fetch to download the playlist
79 | directly.
80 | 
81 | Run 'hls-fetch --help' for further usage information.
82 | 
83 | Future
84 | ------
85 | 
86 | On SIGINT and other terminating signals, make sure temporary files are removed.
87 | 
88 | Autodetect data in URL so that the --embedded/--playlist/--svtplay options are not
89 | necessary.
90 | 
91 | References
92 | ----------
93 | 
94 |  * HTTP Streaming with Encryption under Linux:
95 |    <http://www.opensolutions.ie/blog/2010/08/http-streaming-with-encryption-under-linux/>
96 | 
97 |  * HTTP Live Streaming:
98 |    <http://en.wikipedia.org/wiki/HTTP_Live_Streaming> 
99 | 


--------------------------------------------------------------------------------
/hls-fetch:
--------------------------------------------------------------------------------
  1 | #!/usr/bin/perl -w
  2 | #
  3 | # hls-fetch - Download and decrypt HTTP Live Streaming videos.
  4 | # Copyright (C) 2012 Oskar Liljeblad
  5 | #
  6 | # This program is free software: you can redistribute it and/or modify
  7 | # it under the terms of the GNU General Public License as published by
  8 | # the Free Software Foundation, either version 3 of the License, or
  9 | # (at your option) any later version.
 10 | #
 11 | # This program is distributed in the hope that it will be useful,
 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 14 | # GNU General Public License for more details.
 15 | #
 16 | # You should have received a copy of the GNU General Public License
 17 | # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 18 | #
 19 | 
 20 | use strict;
 21 | use Getopt::Long;
 22 | use HTML::Parser;
 23 | use LWP::UserAgent;
 24 | use JSON;
 25 | use File::Temp qw(tempfile);
 26 | use URI::URL;
 27 | use constant READ_SIZE => 1024;
 28 | 
 29 | my %opt = ('bandwidth' => 'max');
 30 | Getopt::Long::GetOptions(\%opt, 'embedded', 'svtplay', 'playlist', 'output|o=s', 'bandwidth|b=s', 'quiet|q', 'force|f', 'verbose|v', 'no-decrypt', 'version', 'help') || exit 1;
 31 | 
 32 | if ($opt{'version'}) {
 33 |   print "hls-fetch 0.1\n";
 34 |   print "Copyright (C) 2012 Oskar Liljeblad\n";
 35 |   print "License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>.\n";
 36 |   print "This is free software: you are free to change and redistribute it.\n";
 37 |   print "There is NO WARRANTY, to the extent permitted by law.\n\n";
 38 |   print "Written by Oskar Liljeblad.\n";
 39 |   exit 0;
 40 | }
 41 | if ($opt{'help'}) {
 42 |   print "Usage: hls-fetch [OPTION]... URL\n";
 43 |   print "Download and decrypt videos served by the HTTP Live Streaming (HLS) protocol.\n\n";
 44 |   print "      --embedded        URL refers to a page with <video> tag (default)\n";
 45 |   print "      --playlist        URL refers to an M3U (m3u8) playlist\n";
 46 |   print "      --svtplay         URL refers to an SVT Play page (svtplay.se)\n";
 47 |   print "  -o, --output=FILE     save video to FILE rather than \"video.ts\"\n";
 48 |   print "  -f, --force           force overwriting existing output file\n";
 49 |   print "  -b, --bandwidth=SPEC  pick video with specified bandwidth (bits/s),\n";
 50 |   print "                        lowest (\"min\") or highest (\"max\") (default max)\n";
 51 |   print "  -v, --verbose         explain what is being done\n";
 52 |   print "  -q, --quiet           no output other than errors\n";
 53 |   print "      --no-decrypt      skip decryption even if stream should be decrypted\n";
 54 |   print "      --help            display this help and exit\n";
 55 |   print "      --version         output version information and exit\n";
 56 |   print "\nDecryption requires openssl.\n";
 57 |   print "\nReport bugs to Oskar Liljeblad <oskar\@osk.mine.nu>.\n";
 58 |   exit 0;
 59 | }
 60 | 
 61 | die "--embedded, --playlist and --svtplay are mutually exclusive\n" if (scalar grep { defined } @opt{'svtplay', 'playlist', 'embedded'}) > 1;
 62 | $opt{'embedded'} = 1 if !$opt{'playlist'} && !$opt{'svtplay'};
 63 | die "--verbose and --quiet are mutually exclusive\n" if $opt{'verbose'} && $opt{'quiet'};
 64 | die "non-numeric --bandwidth specified\n" if $opt{'bandwidth'} !~ /^(min|max|\d+)$/;
 65 | die "missing URL operand\n" if !@ARGV;
 66 | if (!exists $opt{'output'}) {
 67 |   $opt{'output'} = 'video.ts';
 68 |   warn "no output file specified, assuming video.ts\n" if !$opt{'quiet'};
 69 | }
 70 | 
 71 | my ($url) = @ARGV;
 72 | my $browser = LWP::UserAgent->new;
 73 | $browser->cookie_jar({});
 74 | 
 75 | my $video_file = $opt{'output'};
 76 | die "$video_file: file exists, not overwriting without -f/--force\n" if !$opt{'force'} && -e $video_file;
 77 | open(my $video_fh, '>', $video_file) || die "$video_file: cannot open file: $!\n";
 78 | 
 79 | if ($opt{'svtplay'}) {
 80 |   my $data = eval { fetch_url($url) }; die "$url: cannot fetch page: $@" if $@;
 81 |   my $parser = HTML::Parser->new(api_version => 3, start_h => [\&handle_svtplay_tag, 'tagname,@attr']);
 82 |   my ($json_path, $json_title);
 83 | 
 84 |   sub handle_svtplay_tag {
 85 |     my ($tag, %attr) = @_;
 86 |     if ($tag eq 'a' && exists $attr{'id'} && $attr{'id'} =~ /^player($|_)/ && exists $attr{'data-json-href'} && exists $attr{'data-title'}) {
 87 |       $json_path = $attr{'data-json-href'};
 88 |       $json_title = $attr{'data-title'};
 89 |     }
 90 |   }
 91 | 
 92 |   $parser->parse($data);
 93 |   die "$url: cannot find any video on page\n" if !defined $json_path;
 94 |   print "Title: $json_title\n" if $opt{'verbose'};
 95 | 
 96 |   my $json_url = url($json_path, $url)->abs;
 97 |   $json_url->query('output=json');
 98 |   $json_url = $json_url->as_string();
 99 |   print "URL (JSON): $json_url\n" if $opt{'verbose'};
100 | 
101 |   $data = eval { fetch_url($json_url) }; die "$json_url: cannot fetch JSON data: $@" if $@;
102 |   my $json = decode_json($data) // die "$json_url: cannot parse JSON data\n";
103 |   die "$json_url: invalid JSON data\n" if !exists $json->{'video'}->{'videoReferences'}->[0];
104 |   ($url) = map { $_->{'url'} } grep { $_->{'playerType'} eq 'ios' } @{$json->{'video'}->{'videoReferences'}};
105 |   die "$json_url: missing video URL for 'ios' type in JSON data\n" if !defined $url;
106 |   print "URL (master): $url\n" if $opt{'verbose'};
107 | }
108 | elsif ($opt{'embedded'}) {
109 |   my $data = eval { fetch_url($url) }; die "$url: cannot fetch page: $@" if $@;
110 |   my $parser = HTML::Parser->new(api_version => 3, start_h => [\&handle_playlist_tag, 'tagname,@attr']);
111 |   my $index_url;
112 | 
113 |   sub handle_playlist_tag {
114 |     my ($tag, %attr) = @_;
115 |     if ($tag eq 'video') {
116 |       $index_url = $attr{'src'} if exists $attr{'src'};
117 |     } elsif ($tag eq 'source') {
118 |       $index_url = $attr{'src'} if exists $attr{'src'} && exists $attr{'type'} && $attr{'type'} eq 'application/vnd.apple.mpegurl';
119 |     }
120 |   }
121 | 
122 |   $parser->parse($data);
123 |   die "$url: cannot find any video on page\n" if !defined $index_url;
124 |   $url = url($index_url, $url)->abs()->as_string();
125 |   print "URL (master): $url\n" if $opt{'verbose'};
126 | }
127 | 
128 | my $data = eval { fetch_url($url) }; die "$url: cannot fetch playlist: $@" if $@;
129 | my @lines = split(/\r*\n|\r\n*/, $data);
130 | die "$url: invalid playlist, no header\n" if @lines < 1 || $lines[0] ne '#EXTM3U';
131 | 
132 | if (!grep { /^#EXTINF:/ } @lines) {
133 |   my (@streams, $last_stream);
134 |   foreach my $line (@lines) {
135 |     if ($line =~ /^#EXT-X-STREAM-INF:(.*)$/) {
136 |       $last_stream = { parse_m3u_attribs($url, $1) };
137 |       push @streams, $last_stream;
138 |     } elsif ($line !~ /^#EXT/) {
139 |       die "$url: missing #EXT-X-STREAM-INF for URL: $line\n" if !defined $last_stream;
140 |       $last_stream->{'URL'} = $line;
141 |       $last_stream = undef;
142 |     }
143 |   }
144 |   die "$url: no streams found in playlist\n" if !@streams;
145 | 
146 |   warn "$url: non-numeric bandwidth in playlist\n" if grep { $_->{'BANDWIDTH'} =~ /\D/ } @streams;
147 |   my @bandwidths = sort { $a <=> $b } grep { /^\d+$/ } map { $_->{'BANDWIDTH'} } @streams;
148 |   print "Bandwidths: ", join(', ', @bandwidths), "\n" if $opt{'verbose'};
149 |   my $stream;
150 |   if ($opt{'bandwidth'} eq 'min') {
151 |     ($stream) = grep { $_->{'BANDWIDTH'} == $bandwidths[0] } @streams;
152 |   } elsif ($opt{'bandwidth'} eq 'max') {
153 |     ($stream) = grep { $_->{'BANDWIDTH'} == $bandwidths[-1] } @streams;
154 |   } else {
155 |     ($stream) = grep { $opt{'bandwidth'} == $_->{'BANDWIDTH'} } @streams;
156 |     die "$url: no streams with bandwidth $opt{'bandwidth'} in playlist\n" if !defined $stream;
157 |   }
158 |   print "Bandwidth (selected): $stream->{'BANDWIDTH'}\n" if $opt{'verbose'};
159 |   $url = url($stream->{'URL'}, $url)->abs()->as_string();
160 |   print "URL (index): $url\n" if $opt{'verbose'};
161 | 
162 |   $data = eval { fetch_url($url) }; die "$url: cannot fetch playlist: $@" if $@;
163 |   @lines = split(/\r?\n/, $data);
164 |   die "$url: invalid playlist, no header\n" if @lines < 1 || $lines[0] ne '#EXTM3U';
165 | }
166 | 
167 | my $sequence = 0;
168 | my (%segments, $cryptkey_url);
169 | foreach my $line (@lines) {
170 |   if ($line =~ /^#EXT-X-MEDIA-SEQUENCE:(\d+)$/) {
171 |     $sequence = $1;
172 |     print "First sequence number: $sequence\n" if $opt{'verbose'};
173 |   } elsif ($line =~ /^#EXT-X-KEY:(.*)$/) {
174 |     my %attr = parse_m3u_attribs($url, $1);
175 |     die "$url: unsupported encryption method $attr{'METHOD'} in playlist\n" if exists $attr{'METHOD'} && $attr{'METHOD'} ne 'AES-128';
176 |     $cryptkey_url = $attr{'URI'};
177 |     die "$url: missing encryption key URI in playlist\n" if !defined $cryptkey_url;
178 |   } elsif ($line !~ /^#EXT/) {
179 |     $segments{$sequence} = { 'url' => $line, 'cryptkey_url' => $cryptkey_url };
180 |     $sequence++;
181 |   }
182 | }
183 | die "$url: no segments in playlist\n" if !scalar keys %segments;
184 | 
185 | my %cryptkeys;
186 | #my $cryptkey;
187 | #if (defined $cryptkey_url) {
188 | #  print "URL (key): $cryptkey_url\n" if $opt{'verbose'};
189 | #  $cryptkey = eval { fetch_url($cryptkey_url) }; die "$cryptkey_url: cannot fetch encryption key: $@" if $@;
190 | #  $cryptkey = join('', map { sprintf('%02x', ord) } split(//, $cryptkey));
191 | #  print "Key: $cryptkey\n" if $opt{'verbose'};
192 | #}
193 | print "Segments: ", scalar keys %segments, "\n" if $opt{'verbose'};
194 | 
195 | $| = 1;
196 | foreach my $sequence (sort { $a <=> $b } keys %segments) {
197 |   my $segment = $segments{$sequence};
198 |   my $segment_url = url($segment->{'url'}, $url)->abs()->as_string();
199 |   print "URL (segment $sequence): $segment_url\n" if $opt{'verbose'};
200 |   printf "\r%d/%d", $sequence, scalar keys %segments if !$opt{'quiet'} && !$opt{'verbose'};
201 | 
202 |   if (!$opt{'no-decrypt'} && defined $segment->{'cryptkey_url'} && !exists $cryptkeys{$segment->{'cryptkey_url'}}) {
203 |     print "URL (key): ", $segment->{'cryptkey_url'}, "\n" if $opt{'verbose'};
204 |     my $cryptkey = eval { fetch_url($segment->{'cryptkey_url'}) };
205 |     die "$segment->{'cryptkey_url'}: cannot fetch encryption key: $@" if $@;
206 |     $cryptkey = join('', map { sprintf('%02x', ord) } split(//, $cryptkey));
207 |     print "Key: $cryptkey\n" if $opt{'verbose'};
208 |     $cryptkeys{$segment->{'cryptkey_url'}} = $cryptkey;
209 |   }
210 | 
211 |   my ($segment_fh, $segment_file) = tempfile();
212 |   close $segment_fh;
213 |   eval {
214 |     eval { fetch_url($segment_url, $segment_file) }; die "$segment_url: cannot not fetch segment: $@" if $@;
215 |     if (!$opt{'no-decrypt'} && defined $segment->{'cryptkey_url'}) {
216 |       my ($decrypt_fh, $decrypt_file) = tempfile();
217 |       close $decrypt_fh;
218 |       my $iv = sprintf('%032x', $sequence);
219 |       my @cmd = ('openssl', 'aes-128-cbc', '-d', '-in', $segment_file, '-out', $decrypt_file, '-K', $cryptkeys{$segment->{'cryptkey_url'}}, '-iv', $iv);
220 |       system @cmd;
221 |       unlink $segment_file || warn "$segment_file: cannot remove file: $!\n";
222 |       $segment_file = $decrypt_file;
223 |       die "$segment_file: openssl failed (status $?)\n" if $? != 0;
224 |     }
225 |     open ($segment_fh, '<', $segment_file) || die "$segment_file: cannot open file: $!\n";
226 |     for (;;) {
227 |       my $size = sysread($segment_fh, $data, READ_SIZE);
228 |       die "$segment_file: cannot read from file: $!\n" if !defined $size;
229 |       last if $size == 0;
230 |       die "$video_file: cannot write to file: $!\n" if !defined syswrite($video_fh, $data);
231 |     }
232 |     close $segment_fh;
233 |   };
234 |   unlink $segment_file || warn "$segment_file: cannot remove file: $!\n";
235 |   die $@ if $@;
236 | }
237 | close $video_fh;
238 | 
239 | sub parse_m3u_attribs {
240 |   my ($url, $attr_str) = @_;
241 |   my %attr;
242 |   for (my $as = $attr_str; $as ne ''; ) {
243 |     $as =~ s/^?([^=]*)=([^,"]*|"[^"]*")\s*(,\s*|$)// or die "$url: invalid attributes in playlist: $attr_str\n";
244 |     my ($key, $val) = ($1, $2);
245 |     $val =~ s/^"(.*)"$/$1/;
246 |     $attr{$key} = $val;
247 |   }
248 |   return %attr;
249 | }
250 | 
251 | sub fetch_url {
252 |   my ($url, $filename) = @_;
253 |   if (defined $filename) {
254 |     my $response = $browser->get($url, ":content_file" => $filename);
255 |     die $response->status_line(), "\n" if !$response->is_success;
256 |     return undef;
257 |   } else {
258 |     my $response = $browser->get($url);
259 |     die $response->status_line(), "\n" if !$response->is_success;
260 |     return $response->decoded_content();
261 |   }
262 | }
263 | 


--------------------------------------------------------------------------------