HLS fetcher

hls.pl

#!/usr/bin/perl
#
# HLS HTTP2 fetcher
#
# @author nrmmota@gmail.com
#
use strict;
use warnings;
use AnyEvent;
use AnyEvent::Socket;
use AnyEvent::Handle;
use Net::SSLeay;
use AnyEvent::TLS;
use Data::Dumper;
use File::Basename;

use Protocol::HTTP2;
use Protocol::HTTP2::Client;
use Protocol::HTTP2::Constants qw(const_name);

# (1) quit unless we have the correct number of command-line args
my $num_args = $#ARGV + 1;
if ( $num_args != 1 ) {
	print "\nUsage: command https://...m3u8\n";
	exit;
}
elsif ( $ARGV[0] !~ /https/ ) {
	print "You need to use HTTPS\n";
	exit;
}

my $handle;

# Decompose HTTPS Url
my $url = $ARGV[0];
$url =~ s/https:\/\///;
my @host = split( /\//, $url, 2 );

# Temp folder
my $out_folder = "/var/run/hls/";

# TODO: Add support for port selection
# although firewall issues may arise
my $port = 443;

print "Selected url: " . $url, "\n";
print "Hostname: ", $host[0], "\n", "Playlist: ", $host[1], "\n";

Net::SSLeay::initialize();

# Useful debug for print log stub
my $debug = 0;

sub print_log {
	my ( $string, $dump ) = @_;

	if ($debug) {
		if ($dump) {
			print Dumper($string);
		}
		else {
			print $string, "\n";
		}

	}
}

sub print_log_dump {
	print_log( @_, 1 );
}

# href as in hash reference
my $playlist_href = {};
my $nr_segments   = 0;

sub save_file {
	my ( $file, $data ) = @_;
	open( my $fh, '>', $out_folder . $file );
	print $fh $data;
	close $fh;
}

sub parse_playlist {
	my ( $headers, $data ) = @_;

	print_log_dump($headers);
	print_log($data);

	my $segment = "";

	my @lines = split /\n/, $data;
	foreach my $line ( $#lines - $nr_segments .. $#lines ) {
		next if ( $lines[$line] !~ /\.ts/ );
		$segment = $lines[$line];
		$segment =~ s/\.\///;

		if ( !$playlist_href->{ $segment } ) {
			print "Need to download $segment\n";
			prepare_request($segment,$handle);
		}
	}

	print Dumper($playlist_href);

	save_file( $host[1], $data );
}

sub request_cb {
	my ( $headers, $data ) = @_;
	
	print Dumper($headers);

	if ( $data && $data =~ /#EXTM3U/ )    # Parsing playlist
	{
		print "We have a m3u8 playlist\n";

		if ( !$nr_segments ) {
			$nr_segments += 4;

			if ( $data =~ /#EXTINF/ ) {

				# Last five segments
				$nr_segments += 4;
			}

			if ( $data =~ /#EXT-X-PROGRAM-DATE-TIME/ ) {
				$nr_segments += 4;
			}

			print "Number of indexs for segment iteration: $nr_segments\n";
		}

		parse_playlist(@_);
	}
	elsif ($data)    # Considering a segment
	{
		print "Downloaded segment\n";
	}
	
	return 1;
}

my $client = Protocol::HTTP2::Client->new(
	on_change_state => sub {
		my ( $stream_id, $previous_state, $current_state ) = @_;
		printf "Stream %i changed state from %s to %s\n",
		  $stream_id, const_name( "states", $previous_state ),
		  const_name( "states", $current_state );
	},
	on_push => sub {
		my ($push_headers) = @_;

		# If we accept PUSH_PROMISE
		# return callback to receive promised data
		# return undef otherwise
		print "Server want to push some resource to us\n";

		return sub {
			my ( $headers, $data ) = @_;
			print "Received promised resource\n";
		  }
	},
	on_error => sub {
		my $error = shift;
		printf "Error occured: %s\n", const_name( "errors", $error );
	},
	keepalive => 1
);

sub prepare_request {
	my ($file) = @_;

	# Prepare http/2 request
	$client->request(
		':scheme'    => "https",
		':authority' => $host[0] . ":" . $port,
		':path'      => "/$file",
		':method'    => "GET",
		headers      => [
			'accept'     => '*/*',
			'user-agent' => 'perl-Protocol-HTTP2/0.01',
		],
		on_done => sub { return request_cb(@_) }
	);
}

sub make_request {
	my ($file, $handle) = @_;
	
	prepare_request($file);
	
	# Send data
	while ( my $frame = $client->next_frame ) {
		$handle->push_write($frame);
	}
}

my $w = AnyEvent->condvar;

# First request preparation
prepare_request($host[1]);

tcp_connect $host[0], $port, sub {
	my ($fh) = @_ or do {
		print "connection failed: $!\n";
		$w->send;
		return;
	};

	my $tls;
	eval {
		$tls = AnyEvent::TLS->new( method => "TLSv1_2", );

		# ALPN (Net-SSLeay > 1.55, openssl >= 1.0.2)
		if ( exists &Net::SSLeay::CTX_set_alpn_protos ) {
			Net::SSLeay::CTX_set_alpn_protos( $tls->ctx,
				[Protocol::HTTP2::ident_tls] );
		}

		# NPN  (Net-SSLeay > 1.45, openssl >= 1.0.1)
		elsif ( exists &Net::SSLeay::CTX_set_next_proto_select_cb ) {
			Net::SSLeay::CTX_set_next_proto_select_cb( $tls->ctx,
				[Protocol::HTTP2::ident_tls] );
		}
		else {
			die "ALPN and NPN is not supported\n";
		}
	};
	if ($@) {
		print "Some problem with SSL CTX: $@\n";
		$w->send;
		return;
	}

	$handle = AnyEvent::Handle->new(
		fh       => $fh,
		tls      => "connect",
		tls_ctx  => $tls,
		autocork => 1,
		on_error => sub {
			$_[0]->destroy;
			print "connection error\n";
			$w->send;
		},
		on_eof => sub {
			$handle->destroy;
			$w->send;
		},
		timeout => 3,
		on_timeout => sub {make_request($host[1], $handle)}
	);

	# First write preface to peer
	while ( my $frame = $client->next_frame ) {
		$handle->push_write($frame);
	}

	$handle->on_read(
		sub {
			my $handle = shift;

			print "Feeding stuff here\n";

			$client->feed( $handle->{rbuf} );

			$handle->{rbuf} = undef;
			
			# First write preface to peer
			while ( my $frame = $client->next_frame ) {
				$handle->push_write($frame);
			}
		}
	);
};

$w->recv;