| ## |
| # Downloader for F4V files using the documented fragment format. |
| # |
| # Copyright (c) 2013 James Bottomley <James.Bottomley@HansenPartnership.com> |
| # |
| # Released as part of get-flash-videos under the Apache Licence version 2.0 |
| # |
| # The F4V specification is available at |
| # http://download.macromedia.com/f4v/video_file_format_spec_v10_1.pdf |
| # |
| # And the manifest xml format at |
| # http://osmf.org/dev/osmf/specpdfs/FlashMediaManifestFileFormatSpecification.pdf |
| # |
| # And the |
| ## |
| # A short intro is that a Flash Fragment file (F4F) consists of segments and |
| # fragments. Each segment is a complete video file and is built from a set of |
| # fragments. Fragments are incomplete video files, but may be rendered |
| # complete by the addition of the metadata for the segment. The downloader |
| # code tries to download all segments and fragments, but it's only ever been |
| # tested on single segment downloads (because one download is usually one |
| # video file). |
| ## |
| |
| package FlashVideo::F4VDownloader; |
| |
| use strict; |
| use base 'FlashVideo::Downloader'; |
| use IPC::Open3; |
| use Fcntl (); |
| use Symbol qw(gensym); |
| use File::Temp qw(tempfile tempdir); |
| use Storable qw(dclone); |
| use FlashVideo::Utils; |
| use MIME::Base64; |
| use Data::Dumper; |
| use Data::AMF::Parser::AMF0; |
| use Convert::ASN1; |
| use Crypt::Rijndael; |
| |
| sub parse_audio_tag { |
| my ($s, $tag, $len) = @_; |
| my ($c) = unpack('C', $s); |
| my $soundformat = ($c >> 4); |
| my $hdrlen; |
| |
| if ($soundformat == 10) { |
| $hdrlen = 2; |
| } else { |
| $hdrlen = 1; |
| } |
| return $hdrlen; |
| } |
| |
| sub parse_video_tag { |
| my ($s, $tag, $len) = @_; |
| my ($c) = unpack('C', $s); |
| my $codec = ($c & 0x0f); |
| my $hdrlen; |
| |
| if ($codec == 7) { |
| $hdrlen = 5; |
| } else { |
| $hdrlen = 1; |
| } |
| return $hdrlen; |
| } |
| |
| my %parse_tag = ( |
| 8 => \&parse_audio_tag, |
| 9 => \&parse_video_tag, |
| ); |
| |
| sub unpad { |
| my ($t) = @_; |
| my $c = substr($t, length($t)-1, 1); |
| my $pl = unpack('C', $c); |
| #info 'Pad length '.$pl; |
| return undef if ($pl == 0 || $pl > 16); |
| # verify |
| my $p = substr($t, length($t)-$pl, $pl); |
| return undef if ($p ne $c x $pl); |
| return substr($t, 0, length($t) - $pl); |
| } |
| |
| sub parse_flv_tag { |
| my($s, $key) = @_; |
| my $data = ''; |
| my($tag, $l1, $l2, $l3) = unpack('CCCC', $s); |
| my $len = ($l1 << 16) + ($l2 << 8) + $l3; |
| die sprintf("Invalid tag %02x ",$tag) if (($tag & 0xc0) != 0); |
| my $encrypted = $tag & 0x20; |
| my $type = $tag & 0x1f; |
| my $typedesc; |
| my $new = substr($s, 11); #skip past rest of header on to content headers |
| my $dat = substr($new, 0, $len); |
| die "Unrecognised tag $type" if (!defined($parse_tag{$type})); |
| debug "parsing tag $tag"; |
| my $extralen = $parse_tag{$type}($dat, $tag, $len); |
| # invariant elements of the header (i.e. less tag type and length); |
| my $hdr = substr($s, 4, 11 - 4 + $extralen); |
| $s = $new; |
| $dat = substr($dat, $extralen); |
| my $dec = $dat; |
| if ($encrypted) { |
| my ($numfilter, $etype, $l1, $l2, $l3,$l) = unpack('CZ*CCC.*', $dat); |
| $dat = substr($dat, $l); |
| $l = ($l1 << 16) + ($l2 << 8) + $l3; |
| my $iv; |
| my $enc; |
| if ($etype eq 'SE') { |
| ($enc) = unpack('C', $dat); |
| die "Wrong encoding byte $enc" if ($enc & 0x7f != 0); |
| $dat = substr($dat, 1); |
| if ($enc) { |
| $iv = substr($dat, 0, 16); |
| $dat = substr($dat, 16); |
| die "Wrong filter length" if ($l != 17); |
| } else { |
| die "Wrong filter length" if ($l != 1); |
| } |
| } elsif ($etype eq 'Encryption') { |
| $enc = 1; |
| $iv = substr($dat, 0 ,16); |
| $dat = substr($dat, 16); |
| die "Wrong filter length" if ($l != 16); |
| } else { |
| die 'Unknown encryption type '.$etype; |
| } |
| if ($enc) { |
| my ($ivstr) = unpack('H*', $iv); |
| $data .= ' iv:'.$ivstr; |
| } else { |
| $data .= ' unencrypted'; |
| } |
| debug 'data size after headers '.length($dat); |
| my $cipher = Crypt::Rijndael->new($key, Crypt::Rijndael::MODE_CBC()); |
| $cipher->set_iv($iv); |
| $dec = unpad($cipher->decrypt($dat)); |
| |
| die "Decryption error in tag" if (!defined($dec)); |
| debug "size after decryption ".length($dec); |
| } |
| my $newlen = length($dec) + $extralen; |
| my $newhdr = pack('CCCC', $type, ($newlen >> 16) & 0xff, |
| ($newlen >> 8) & 0xff, $newlen & 0xff); |
| my $newtrailer = pack('L>', $newlen + 11); |
| # bang on header to get decrypted tag |
| $dec = $newhdr.$hdr.$dec.$newtrailer; |
| debug sprintf('%s%s tag of length %d: %s', $encrypted ? "encrypted " : "", $typedesc, $len, $data); |
| $s = substr($s, $len); |
| my $prevlen = unpack('L>', $s); |
| die $len.' != '.$prevlen if (($len + 11) != $prevlen); |
| $s = substr($s, 4); |
| return ($s, $dec); |
| } |
| |
| sub flv_decrypt { |
| my ($dat, $key) = @_; |
| my $newdat = ''; |
| while (length($dat) > 0) { |
| my $d; |
| ($dat, $d) = parse_flv_tag($dat, $key); |
| $newdat .= $d; |
| } |
| return $newdat; |
| } |
| |
| sub read_box_header { |
| |
| my ($s, $a) = @_; |
| my $s_len = length($s); |
| |
| ($a->{len}, $a->{type}) = unpack('L>A4', $s); |
| $s = substr($s, 8); |
| $a->{headlen} = 8; |
| if ($a->{len} == 1) { |
| debug "LARGE BOX"; |
| # large box size |
| ($a->{len}) = unpack('Q>', $s); |
| $s = substr($s, 8); |
| $a->{headlen} += 8; |
| } |
| debug "box header, size ".$a->{len}." type ".$a->{type}; |
| die "string not big enough (".$s_len." but should be >= ".$a->{len} if ($a->{len} > $s_len); |
| return $s; |
| } |
| |
| sub read_segment_runtable { |
| my ($s, $a) = @_; |
| my ($len, $totlen); |
| $s = read_box_header($s, $a); |
| die "found wrong box ".$a->{type}." expecting asrt" if ($a->{type} ne 'asrt'); |
| $totlen = $a->{headlen}; |
| ($a->{version}, |
| $a->{flags}, |
| $a->{qualityentrycount}, |
| $len, |
| ) = unpack('CB24C.*', $s); |
| $totlen += $len; |
| $s = substr($s, $len); |
| if ($a->{qualityentrycount} > 0) { |
| @_ = unpack('Z'.$a->{qualityentrycount}.'.*', $s); |
| $a->{qualitysegmenturlmodifiers} = @_; |
| $len = pop $a->{qualitysegmenturlmodifiers}; |
| $s = substr($s, $len); |
| $totlen += $len; |
| } |
| ($a->{segmentrunentrycount}, $len) = unpack('L>.*', $s); |
| $s = substr($s, $len); |
| $totlen += $len; |
| my $i; |
| $a->{segmentrunentrytable} = [()]; |
| for ($i = 0; $i < $a->{segmentrunentrycount}; $i++) { |
| my $t = {}; |
| ($t->{firstsegment}, |
| $t->{fragmentspersegment}, |
| $len |
| ) = unpack('L>L>.*', $s); |
| push $a->{segmentrunentrytable},$t; |
| $s = substr($s, $len); |
| $totlen += $len; |
| } |
| die("Length mismatch in segment runtable ".$totlen." != ".$a->{len}) if ($totlen != $a->{len}); |
| return $s; |
| } |
| |
| sub read_fragment_runtable { |
| my ($s, $a) = @_; |
| my ($len, $totlen); |
| $s = read_box_header($s, $a); |
| die "found wrong box ".$a->{type}." expecting afrt" if ($a->{type} ne 'afrt'); |
| $totlen = $a->{headlen}; |
| ($a->{version}, |
| $a->{flags}, |
| $a->{timescale}, |
| $a->{qualityentrycount}, |
| $len, |
| ) = unpack('CB24L>C.*', $s); |
| $totlen += $len; |
| $s = substr($s, $len); |
| if ($a->{qualityentrycount} > 0) { |
| @_ = unpack('Z'.$a->{qualityentrycount}.'.*', $s); |
| $a->{qualitysegmenturlmodifiers} = @_; |
| $len = pop $a->{qualitysegmenturlmodifiers}; |
| $s = substr($s, $len); |
| $totlen += $len; |
| } |
| ($a->{fragmentrunentrycount}, $len) = unpack('L>.*', $s); |
| $s = substr($s, $len); |
| $totlen += $len; |
| |
| my $i; |
| $a->{fragmentrunentrytable} = [()]; |
| for ($i = 0; $i < $a->{fragmentrunentrycount}; $i++) { |
| my $t = {}; |
| ($t->{firstsegment}, |
| $t->{fragmenttimestamp}, |
| $t->{fragmentduration}, |
| $len |
| ) = unpack('L>Q>L>.*', $s); |
| $s = substr($s, $len); |
| $totlen += $len; |
| if ($t->{fragmentduration} == 0) { |
| ($t->{discontinuityindicator},$len) = unpack('C.*', $s); |
| $s = substr($s, $len); |
| $totlen += $len; |
| } |
| |
| push $a->{fragmentrunentrytable},$t; |
| } |
| die("Length mismatch in fragment runtable ".$totlen." != ".$a->{len}) if ($totlen != $a->{len}); |
| return $s; |
| } |
| |
| sub read_bootstrap_box { |
| my ($s) = @_; |
| |
| my $bb = {}; |
| $s = read_box_header($s, $bb); |
| |
| die "found wrong box ".$bb->{type}." expecting abst" if ($bb->{type} ne 'abst'); |
| my ($len, $totlen, $packedbit); |
| $totlen = $bb->{headlen}; |
| ($bb->{version}, |
| $bb->{flags}, |
| $bb->{bootstrapinfoversion}, |
| $packedbit, |
| $bb->{timescale}, |
| $bb->{currentmediatime}, |
| $bb->{smptetimecodeoffset}, |
| $bb->{movieidentifier}, |
| $bb->{serverentrycount}, |
| $len, |
| ) = unpack('CB24L>B8L>Q>Q>Z*C.*', $s); |
| $bb->{profile} = oct('0b'.substr($packedbit, 0, 2)); |
| $bb->{live} = oct('0b'.substr($packedbit, 2, 1)); |
| $bb->{update} = oct('0b'.substr($packedbit, 3, 1)); |
| $s = substr($s, $len); |
| $totlen += $len; |
| if ($bb->{serverentrytable} > 0) { |
| @_ = unpack('Z'.$bb->{serverentrycount}.'.*', $s); |
| $bb->{serverentrytable} = @_; |
| $len = pop $bb->{serverentrytable}; |
| $s = substr($s, $len); |
| $totlen += $len; |
| } |
| ($bb->{qualityentrycount}) = unpack('C', $s); |
| $s = substr($s, 1); |
| $totlen += 1; |
| if ($bb->{qualityentrycount} > 0) { |
| @_ = unpack('Z'.$bb->{qualityentrycount}.'.*', $s); |
| $bb->{qualityentrytable} = @_; |
| $len = pop $bb->{qualityentrytable}; |
| $s = substr($s, $len); |
| $totlen += $len; |
| } |
| ($bb->{drmdata}, |
| $bb->{metadata}, |
| $bb->{segmentruntablecount}, |
| $len |
| ) = unpack('ZZC.*', $s); |
| $s = substr($s, $len); |
| $totlen += $len; |
| $bb->{segmentruntable} = [()]; |
| my $i; |
| for ($i = 0; $i < $bb->{segmentruntablecount}; $i++) { |
| my $seg = {}; |
| $s = read_segment_runtable($s, $seg); |
| push $bb->{segmentruntable},$seg; |
| $totlen += $seg->{len}; |
| } |
| ($bb->{fragmentruntablecount},$len) = unpack('C.*', $s); |
| $s = substr($s, $len); |
| $totlen += $len; |
| $bb->{fragmentruntable} = [()]; |
| for ($i = 0; $i < $bb->{segmentruntablecount}; $i++) { |
| my $seg = {}; |
| $s = read_fragment_runtable($s, $seg); |
| push $bb->{fragmentruntable},$seg; |
| $totlen += $seg->{len}; |
| } |
| |
| die("Length mismatch in bootstrap box ".$totlen." != ".$bb->{len}) if ($totlen != $bb->{len}); |
| |
| return $bb; |
| } |
| |
| sub download { |
| my ($self, $data, $file, $browser) = @_; |
| |
| $self->{printable_filename} = $file; |
| |
| $file = $data->{flv} = $self->get_filename($file); |
| my $encryptionkey = $data->{encryptionkey}; |
| |
| if (-s $file && !$data->{live}) { |
| info "F4V output filename '$self->{printable_filename}' already " . |
| "exists, asking to resume..."; |
| $data->{resume} = ''; |
| ## |
| # this is a bit of a bitch. We have all the information necessary to |
| # resume a stream at any timestamp. What we lack is the knowledge of how |
| # many bytes go with each fragment (fragments are fixed durations but not |
| # fixed sizes). So, given a resume file of size $x, we have no idea which |
| # fragment to resume from without downloading all the prior fragments to |
| # get their sizes. |
| # |
| # FIXME: could we do something clever by only downloading the http headers |
| # of each of the prior fragments and working out the sizes from them? |
| ## |
| die "resuming f4v streams is currently unimplemented"; |
| } |
| |
| my($r_fh, $w_fh); # So Perl doesn't close them behind our back.. |
| |
| if ($data->{live} && $self->action eq 'play') { |
| # Playing live stream, we pipe this straight to the player, rather than |
| # saving on disk. |
| |
| pipe($r_fh, $w_fh); |
| |
| my $pid = fork; |
| die "Fork failed" unless defined $pid; |
| if(!$pid) { |
| fcntl $r_fh, Fcntl::F_SETFD(), ~Fcntl::FD_CLOEXEC(); |
| exec $self->replace_filename($self->player, "/dev/fd/" . fileno $r_fh); |
| die "Exec failed\n"; |
| } |
| |
| fcntl $w_fh, Fcntl::F_SETFD(), ~Fcntl::FD_CLOEXEC(); |
| $data->{flv} = "/dev/fd/" . fileno $w_fh; |
| |
| $self->{stream} = undef; |
| } |
| |
| if($self->debug) { |
| $data->{verbose} = undef; |
| } |
| |
| my $url = $data->{manifest}; |
| $browser->get($url); |
| if (!$browser->success) { |
| die "Couldn't download manifest $url: ".$browser->response->status_line; |
| } |
| |
| my $xml = from_xml($browser->content); |
| my $manifest = $xml; |
| my $baseurl; |
| if (defined($manifest->{baseURL})) { |
| $baseurl = $manifest->{baseURL}; |
| } else { |
| # kill any post data |
| info "data manifest is ".$data->{manifest}; |
| ($baseurl) = split /\?/, $data->{manifest}; |
| # now strip to the base dir the manifest was in |
| $baseurl =~ m,^(.*)/.*$,; |
| $baseurl = $1; |
| } |
| |
| info "Manifest id \"".$manifest->{id}."\"" if (defined($manifest->{id})); |
| |
| # standard says this must be present, but it often isn't, sigh |
| die "This download isn't streaming media" if (defined($manifest->{deliveryType}) && $manifest->{deliveryType} ne 'streaming'); |
| |
| #die "F4VDownloader can't currently handle DRM encoded files" if (defined($manifest->{drmAdditionalHeader})); |
| |
| # can't do http streaming without bootstrap information |
| die ("manifest has no bootstrapbox") if (!defined($manifest->{bootstrapInfo})); |
| |
| ## |
| # select the media element; FIXME just selecting highest bistream |
| ## |
| my $bitrate = 0; |
| my $res = 0; |
| my $maxres = $data->{prefs}->quality->quality_to_resolution($data->{prefs}->{quality}); |
| my $media; |
| foreach (@{$manifest->{media}}) { |
| my $br = 0; |
| my $metadata = decode_base64($_->{metadata}); |
| my @md = Data::AMF::Parser::AMF0->parse($metadata); |
| die "wrong metadata, expecting onMetaData, found ".$md[0] if ($md[0] ne 'onMetaData'); |
| my $md = $md[1]; |
| next if (@$maxres[1] < $md->{height}); |
| if ($res > $md->{height}) { |
| $res = $md->{height}; |
| # reset bitrate: lower resolution may have higher bitrate |
| $bitrate = 0; |
| } |
| $br = $_->{bitrate} if (defined($_->{bitrate})); |
| if ($br >= $bitrate) { |
| $media = $_; |
| $bitrate = $br; |
| $media->{md} = $md; |
| $media->{metadata} = $metadata; |
| } |
| } |
| info "Selected stream of resolution ".$media->{md}->{height}."x".$media->{md}->{width}." and bitrate ".$bitrate; |
| if (defined($manifest->{bootstrapInfo}->{$media->{bootstrapInfoId}})) { |
| $media->{bootstrapInfo} = $manifest->{bootstrapInfo}->{$media->{bootstrapInfoId}}; |
| } elsif ($manifest->{bootstrapInfo}->{id} eq $media->{bootstrapInfoId}) { |
| $media->{bootstrapInfo} = $manifest->{bootstrapInfo}; |
| } else { |
| die "Can't find bootstrapID ".$media->{bootstrapInfoId}; |
| } |
| my $drmmetadata; |
| if (defined($media->{drmAdditionalHeaderId})) { |
| info "DRM Additional Header ".$media->{drmAdditionalHeaderId}; |
| my $drm; |
| if (defined($manifest->{drmAdditionalHeader}->{$media->{drmAdditionalHeaderId}})) { |
| $drm = $manifest->{drmAdditionalHeader}->{$media->{drmAdditionalHeaderId}}; |
| } elsif ($manifest->{drmAdditionalHeader}->{id} eq $media->{drmAdditionalHeaderId}) { |
| $drm = $manifest->{drmAdditionalHeader}; |
| } else { |
| die "Can't find drmAdditionalHeader ".$media->{drmAdditionalHeaderId}; |
| } |
| $drm = decode_base64($drm->{content}); |
| @_ = Data::AMF::Parser::AMF0->parse($drm); |
| # skip header |
| $drm = $_[1]; |
| if ($drm->{Encryption}->{Version} == 2) { |
| $drmmetadata = decode_base64($drm->{Encryption}->{Params}->{KeyInfo}->{FMRMS_METADATA}->{Metadata}); |
| } elsif ($drm->{Encryption}->{Version} == 2) { |
| $drmmetadata = decode_base64($drm->{Encryption}->{Params}->{KeyInfo}->{Data}->{Metadata}); |
| } else { |
| die "Unknown Encryption Version ".$drm->{Encryption}->{Version}; |
| } |
| my $asn1 = Convert::ASN1->new(); |
| $asn1->configure(encoding => 'DER'); |
| $asn1->prepare(<<ASN1); |
| |
| -- http://www.ietf.org/rfc/rfc2315.txt |
| -- http://www.ietf.org/rfc/rfc3369.txt |
| -- http://www.alvestrand.no/objectid |
| -- http://www.itu.int/ITU-T/asn1/database |
| -- BUT BE CAREFUL !!! |
| |
| Any ::= ANY -- do not remove! |
| |
| ContentInfo ::= SEQUENCE { |
| contentType OBJECT IDENTIFIER, |
| content [0] EXPLICIT ANY } |
| |
| EnvelopedData ::= SEQUENCE { |
| version ANY, |
| originatorInfo [0] ANY OPTIONAL, |
| recipientInfos RecipientInfos, |
| encryptedContentInfo ANY, |
| unprotectedAttrs [1] ANY OPTIONAL |
| } |
| RecipientInfos ::= SET OF RecipientInfo |
| RecipientInfo ::= CHOICE { |
| keyAgreementRecipientInfo [1] SEQUENCE OF KeyAgreementRecipientInfo, |
| keyTransportRecipientInfo ANY |
| } |
| KeyAgreementRecipientInfo ::= SEQUENCE { |
| version ANY, |
| originator ANY, |
| userKeyingMaterial [1] ANY OPTIONAL, |
| keyEncryptionAlgorithm ANY, |
| recipientEncryptedKeys SEQUENCE OF RecipientEncryptedKey |
| } |
| RecipientEncryptedKey ::= SEQUENCE { |
| recipientIdentifier SomebodyIdentifier, |
| encryptedKey ANY |
| } |
| SomebodyIdentifier ::= CHOICE { |
| issuerAndSerialNumber IssuerAndSerialNumber, |
| recipientKeyIdentifier [0] ANY, |
| subjectKeyIdentifier [2] ANY |
| } |
| IssuerAndSerialNumber ::= SEQUENCE { |
| issuer ANY, |
| serialNumber INTEGER |
| } |
| |
| SignerIdentifier ::= CHOICE { |
| issuerAndSerialNumber IssuerAndSerialNumber, |
| subjectKeyIdentifier [0] ANY |
| } |
| |
| SignedAndEnvelopedData ::= SEQUENCE { |
| version ANY, |
| recipientInfos RecipientInfos, |
| digestAlgorithms ANY, |
| encryptedContentInfo ANY, |
| certificates [0] ANY OPTIONAL, |
| crls [1] ANY OPTIONAL, |
| signerInfos SET OF SignerInfo } |
| |
| EncapsulatedContentInfo ::= SEQUENCE { |
| eContentType OBJECT IDENTIFIER, |
| eContent [0] EXPLICIT OCTET STRING OPTIONAL } |
| |
| |
| SignedData ::= SEQUENCE { |
| version INTEGER, |
| digestAlgorithms ANY, |
| contentInfo EncapsulatedContentInfo, |
| certificates [0] ANY OPTIONAL, |
| crls [1] ANY OPTIONAL, |
| test1 ANY, |
| test ANY |
| } |
| SignerInfo ::= SEQUENCE { |
| version INTEGER, |
| signerIdentifier SignerIdentifier, |
| issuerAndSerialNumber IssuerAndSerialNumber, |
| digestAlgorithm ANY, |
| authenticatedAttributes [0] ANY OPTIONAL, |
| digestEncryptionAlgorithm ANY, |
| encryptedDigest ANY, |
| unauthenticatedAttributes [1] ANY OPTIONAL } |
| |
| DigestedData ::= SEQUENCE { |
| version ANY, |
| digestAlgorithm ANY, |
| contentInfo ContentInfo, |
| digest ANY } |
| EncryptedData ::= SEQUENCE { |
| version ANY, |
| encryptedContentInfo EncryptedContentInfo, |
| unprotectedAttributes [1] ANY OPTIONAL } |
| EncryptedContentInfo ::= SEQUENCE { |
| contentType OBJECT IDENTIFIER, |
| contentEncAlgorithm ANY, |
| encryptedContent [0] ANY OPTIONAL } |
| Data ::= OCTET STRING |
| |
| ASN1 |
| |
| my $node = $asn1->find('ContentInfo'); |
| my @d = $node->decode($drmmetadata); |
| my %oidmap = ( |
| '1.2.840.113549.1.7.1' => 'Data', |
| '1.2.840.113549.1.7.2' => 'SignedData', |
| '1.2.840.113549.1.7.3' => 'EnvelopedData', |
| '1.2.840.113549.1.7.4' => 'SignedAndEnvelopedData', |
| '1.2.840.113549.1.7.5' => 'DigestedData', |
| '1.2.840.113549.1.7.6' => 'EncryptedData', |
| ); |
| info Dumper($d[1]); |
| my $type = $oidmap{$d[0]->{contentType}}; |
| my $data = $d[0]->{content}; |
| info "Content Type is $type"; |
| $node = $asn1->find($type); |
| @d = $node->decode($data); |
| $type = $oidmap{$d[0]->{contentInfo}->{eContentType}}; |
| info "Got eContentData of type $type"; |
| $data = $d[0]->{contentInfo}->{eContent}; |
| open (my $fh, '>/tmp/tmp.asn1') || die; |
| print $fh $data; |
| close($fh); |
| $node = $asn1->find($type); |
| @d = $node->decode($data); |
| info Dumper(@d); |
| |
| } |
| |
| my $bb = read_bootstrap_box(decode_base64($media->{bootstrapInfo}->{content})); |
| debug 'Parsed media bootstrap data is '.Dumper($bb); |
| debug 'Parsed media metadata is '.Dumper($media); |
| |
| if ($media->{url} =~ m,^http[s]?://,) { |
| $baseurl = $media->{url}; |
| } else { |
| $baseurl .= '/'.$media->{url}; |
| } |
| |
| my $totfrags = 0; |
| my $prev; |
| |
| foreach (@{$bb->{segmentruntable}}) { |
| foreach (@{$_->{segmentrunentrytable}}) { |
| $totfrags += $_->{firstsegment}; |
| if (defined($prev)) { |
| $totfrags += ($_->{firstsegment} - $prev->{firstsegment} - 1) * $prev->{fragmentspersegment}; |
| } |
| $totfrags += $_->{fragmentspersegment}; |
| $prev = $_; |
| } |
| } |
| die "Invalid fragment count ".$totfrags if ($totfrags < 0); |
| $totfrags += $bb->{segmentruntable}->[0]->{segmentrunentrytable}->[0]->{firstfragment} - 1; |
| |
| info "downloading $totfrags Fragments from $baseurl to $file"; |
| |
| die "Currently cannot process live media (requires bootstrap info recomputes)" if ($bb->{live}); |
| |
| my ($seg, $frag); |
| for ($seg = 1; $seg <= $bb->{segmentruntablecount}; $seg++) { |
| my $segent = $bb->{segmentruntable}->[$seg - 1]->{segmentrunentrytable}->[0]; |
| die "Can't handle split segmentrunentry tables" if ($bb->{segmentruntable}->[$seg - 1]->{segmentrunentrycount} != 1); |
| open(my $fh, ">", $file) || die "can't open file $file for writing: $!"; |
| |
| my $mdl = length($media->{metadata}); |
| ## |
| # most of the Flash header is the metadata, but need to pad with |
| # global file headers first |
| ## |
| # Flash header for audio + video file |
| print $fh pack('H*', '464c5601050000000900000000'); |
| # now the metadata introduction |
| print $fh pack('CCCCCCCL>', 0x12, ($mdl >> 16) & 0xff, ($mdl >> 8) & 0xff, |
| $mdl & 0xff, 0, 0, 0, 0); |
| # the actual metadata from the manifest |
| print $fh $media->{metadata}; |
| # finally the previous tag length |
| print $fh pack('L>', $mdl + 11); |
| |
| ## |
| # now just glue the mdat boxes of the fragments together |
| ## |
| my $filebytecount = 0; |
| for ($frag = $segent->{firstsegment}; |
| $frag < $segent->{firstsegment} + $segent->{fragmentspersegment}; |
| $frag ++) { |
| my $dl = $baseurl.'Seg'.$seg.'-Frag'.$frag; |
| $dl .= $data->{auth} if (defined $data->{auth}); |
| debug "downloading $dl"; |
| $browser->get($dl); |
| if (!$browser->success) { |
| die "Couldn't download fragment: $dl".$browser->response->status_line; |
| } |
| my $s = $browser->content; |
| my $dat; |
| $bb = undef; |
| while(length($s) > 0) { |
| $a = {}; |
| read_box_header($s, $a); |
| die "Fragment $frag too short" if (length($s) < $a->{len}); |
| $bb = read_bootstrap_box($s) if ($a->{type} eq 'abst'); |
| $dat = substr($s, $a->{headlen}, $a->{len} - $a->{headlen}) if ($a->{type} eq 'mdat'); |
| $s = substr($s, $a->{len}); |
| } |
| die "Didn't find the movie data box in fragment $frag" if (!defined($dat)); |
| if (defined($encryptionkey)) { |
| $dat = flv_decrypt($dat, $encryptionkey); |
| } |
| $filebytecount += length($dat); |
| print STDERR sprintf("%s: %d (Frag %d: %.2f\%)\r", $file, $filebytecount, $frag, $frag/$totfrags*100); |
| print $fh $dat; |
| } |
| close($fh); |
| print STDERR "\n"; |
| } |
| return $media->{md}->{filesize}; |
| } |
| |
| # Check if a stream is active by downloading a sample |
| sub try_download { |
| return 1; |
| } |
| |
| 1; |