get-flash-videos 1.25.98-1 / usr / share / perl5 / FlashVideo / Site / Channel4.pm

# Part of get-flash-videos. See get_flash_videos for copyright.
# Thanks to Nibor for his XBMC 4od plugin - this is largely a Perl port of
# it.
package FlashVideo::Site::Channel4;

use strict;

use Crypt::Blowfish;
use FlashVideo::Utils;
use FlashVideo::JSON;
use MIME::Base64;
use Time::HiRes qw(time);

use constant TOKEN_DECRYPT_KEY => 'STINGMIMI';

our $VERSION = '0.04';
sub Version() { $VERSION;}

sub find_video {
  my ($self, $browser, $embed_url, $prefs) = @_;


  if ($browser->response->is_redirect) {
    my $relurl = $browser->response->header('Location');
    info "Relocated to $relurl";
    $browser->get($relurl);
  }

  my $page_url = $browser->uri->as_string;

  # Determine series and episode. Channel 4 sometimes have these backwards,
  # but as long as they differ there's less risk of overwriting or
  # incorrectly resuming previous episodes from the same series.
  my $series_and_episode;
  if ($browser->content =~ /<meta\ property="og:image"
                            \ content="\S+series-(\d+)\/episode-(\d+)/x) {
    $series_and_episode = sprintf "S%02dE%02d", $1, $2;
  }

  # Create a uid
  my $uid = int(time*1000);

  # get SWF player file
  my $swf_player;
  if ($browser->content =~ /fourodPlayerFile\s+=\s+\'(4od\S+\.swf)\'/i) {
    $swf_player = $1;
  }
  else {
     $swf_player = '4odplayer-11.21.2.swf';
  }

  # Get asset ID from 4od programme URL, which can be in two different
  # formats:
  #
  #   http://www.channel4.com/programmes/dispatches/4od#3220372
  #   http://www.channel4.com/programmes/dispatches/4od/player/3269465
  my $asset_id;

  if ($page_url =~ m'(?:4od/player/|4od[^\/]*#)(\d+)') {
    $asset_id = $1;
  }
  else {
    die "Can't get asset ID";
  }

  # Get programme XML.
  my $raw_xml = $browser->get("http://ais.channel4.com/asset/$asset_id");

  if (!$browser->success) {
    die "Couldn't get asset XML: " . $browser->response->status_line;
  }

  my $xml_ref = from_xml($raw_xml);
  my $xml;


  # Check for mp4 if not then try different assetId
  my $lower_id = 0;
  my $upper_id = 9999999;
  if ($xml_ref->{assetInfo}->{uriData}->{streamUri} !~ /mp4$/ ) {
    
    my $find_url = "http://ps3.channel4.com/pmlsd/" . 
        $xml_ref->{assetInfo}->{webSafeBrandTitle} .
        "/4od.json?platform=ps3&uid=" . $uid;

    $browser->get($find_url);
    if ($browser->success) {
      my $json = from_json($browser->content);

      my $fstr = sprintf "%s/%03d", $xml_ref->{assetInfo}->{contractId}, 
                   $xml_ref->{assetInfo}->{programmeNumber};
      info "Looking for programmeId $fstr";
      my @entries;
      if (ref($json->{feed}->{entry}) eq "ARRAY") {
        @entries = @{$json->{feed}->{entry}};
      }
      else
      {
        $entries[0] = $json->{feed}->{entry};
      }
      foreach my $entry ( @entries ) {
        if ($entry->{'dc:relation.programmeId'} eq $fstr) {
          my $ps3_url = $entry->{group}->{player}->{'@url'};
          info $entry->{'dc:relation.BrandTitle'} .
            ' - ' . $entry->{title} .
            ' Series ' . $entry->{'dc:relation.SeriesNumber'} .
            ' Episode ' . $entry->{'dc:relation.EpisodeNumber'} .
            ' ProgrammeId ' . $entry->{'dc:relation.programmeId'} .
            ' Url ' . $ps3_url;
          $raw_xml = $browser->get($ps3_url);
          if ($browser->success) {
            my $xml_off = from_xml($raw_xml);
            if ($xml_off->{assetInfo}->{uriData}->{streamUri} =~ /mp4$/ ) {
              $xml = $xml_off;
              info "Found mp4 stream url $ps3_url siteSectionId $xml->{assetInfo}->{adverts}->{siteSectionId}";
            }
          }
        }
      }

    }
    if  (! defined($xml)) {
      for (my $off = 2; $off < 20; $off++) {
        my $asset_off = $off >> 1;
        $asset_off = -$asset_off if ($off & 1);
        $asset_off += $asset_id; 
        if ($asset_off > $lower_id && $asset_off < $upper_id) {
          $raw_xml = $browser->get("http://ais.channel4.com/asset/$asset_off");
          if ($browser->success) {
            my $xml_off = from_xml($raw_xml); 
            # Check Same programme
            if ( $xml_off->{assetInfo}->{brandTitle}      eq  $xml_ref->{assetInfo}->{brandTitle} &&
                 $xml_off->{assetInfo}->{programmeNumber} eq  $xml_ref->{assetInfo}->{programmeNumber}) {
              if ($xml_off->{assetInfo}->{uriData}->{streamUri} =~ /mp4$/ ) {
                $xml = $xml_off;
                info "Found mp4 stream asset id $asset_off siteSectionId $xml->{assetInfo}->{adverts}->{siteSectionId}";
                if ($xml->{assetInfo}->{uriData}->{streamUri} =~ /\.ps3-/ ) {
                   last;
                }
              }
            }
            else {
              if ($asset_off > $asset_id ) {
                $upper_id = $asset_off;
              }
              else {
                $lower_id = $asset_off;
              }
            }
          } 
        }
      }
    }
  }
  else {
    $xml = $xml_ref;
  }

  die "Unable to find suitable stream - may not be available yet\n" unless defined $xml;

  my $stream_url  = $xml->{assetInfo}->{uriData}->{streamUri};
  my $token       = $xml->{assetInfo}->{uriData}->{token};
  my $cdn         = $xml->{assetInfo}->{uriData}->{cdn};

  my $decoded_token = decode_4od_token($token);

  # RTMP authentication - varies depending on which CDN is in use.
  my $auth;

  # Different CDNs require different handling.
  if ($cdn eq 'll') {
    # Limelight
    my $ip = $xml->{assetInfo}->{uriData}->{ip};
    my $e  = $xml->{assetInfo}->{uriData}->{e};

    if (defined $ip) {
      $auth = sprintf "e=%s&ip=%s&h=%s", $e, $ip, $decoded_token;
    }
    else {
      $auth = sprintf "e=%s&h=%s", $e, $decoded_token;
    }
  }
  else {
    # Akamai presumably
    my $fingerprint = $xml->{assetInfo}->{uriData}->{fingerprint};
    my $slist       = $xml->{assetInfo}->{uriData}->{slist};

    $auth = sprintf "auth=%s&aifp=%s&slist=%s",
      $decoded_token, $fingerprint, $slist;
  }

  # Get filename to use.
  my $title;
  my @title_components = grep defined,
                         map { $xml->{assetInfo}->{$_} }
                         qw(brandTitle episodeTitle);

  if ($series_and_episode) {
    push @title_components, $series_and_episode;
  }

  if (@title_components) {
    $title = join " - ", @title_components;
  }
  
  my $filename = title_to_filename($title, "flv");

  # Get subtitles if necessary.
  if ($prefs->subtitles) {
    if (my $subtitles_url = $xml->{assetInfo}->{subtitlesFileUri}) {
      $subtitles_url = "http://ais.channel4.com$subtitles_url";
      
      $browser->get($subtitles_url);

      if (!$browser->success) {
        info "Couldn't download 4od subtitles: " . $browser->response->status_line;
      }

      my $subtitles_file = title_to_filename($title, "srt");
      convert_sami_subtitles_to_srt($browser->content, $subtitles_file); 

      info "Saved subtitles to $subtitles_file";
    }
    else {
      debug("Subtitles requested for '$title' but none available.");
    }
  }

  # Create the various options for rtmpdump.
  my $rtmp_url;
  
  if ($stream_url =~ /(.*?)mp4:/) {
    $rtmp_url = $1;
  }

  $rtmp_url =~ s{\.com/}{.com:1935/};
  $rtmp_url .= "?ovpfv=1.1&$auth";
  
  my $app;
  if ($stream_url =~ /.com\/(.*?)mp4:/) {
    $app = $1;
    $app .= "?ovpfv=1.1&$auth";
  }

  my $playpath;
  if ($stream_url =~ /.*?(mp4:.*)/) {
    $playpath = $1;
    $playpath .= "?$auth";
  }

  # swf url could be relocated, url_exists returns relocated url.
  my $swf_player_url = url_exists($browser, "http://www.channel4.com/static/programmes/asset/flash/swf/$swf_player");

  if (!$swf_player_url) {
     die "swf url not found";
  }
  
  return {
    flv      => $filename,
    rtmp     => $rtmp_url,
    flashVer => '"WIN 11,0,1,152"',
    swfVfy   => "$swf_player_url",
    conn     => 'Z:',
    playpath => $playpath,
    pageUrl  => $page_url,
    app      => $app,
  };
}

sub decode_4od_token {
  my $encrypted_token = shift;

  $encrypted_token = decode_base64($encrypted_token);

  my $blowfish = Crypt::Blowfish->new(TOKEN_DECRYPT_KEY);

  my $decrypted_token = '';

  # Crypt::Blowfish only decrypts 8 bytes at a time.
  my $position = 0;

  while ( $position < length $encrypted_token) {
    $decrypted_token .= $blowfish->decrypt(substr $encrypted_token, $position, 8);
    $position += 8;
  }

  # remove padding.. PKCS7/RFC5652..
  my $npad = unpack("c", substr($decrypted_token, -1));
  if ($npad > 0 && $npad < 9) {
    $decrypted_token = substr($decrypted_token, 0, length($decrypted_token)-$npad);
  }
  return $decrypted_token;
}

1;