-
Notifications
You must be signed in to change notification settings - Fork 0
/
mp4.ml
executable file
·160 lines (143 loc) · 4.98 KB
/
mp4.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
(* MP4 : Parsing the container format *)
open Bitstring
let box bits = bitmatch bits with
| { 0x0000l : 32 : bigendian;
kind : 32 : string;
size : 64 : bigendian;
data : Int64.to_int size * 8 - 128 : bitstring;
rest : -1 : bitstring } ->
(* a large box; the Int64.to_int defies purpose of a large box... *)
(kind, data, rest)
| { 0x0000l : 32 : bigendian;
kind : 32 : string;
data : -1 : bitstring } ->
(* consumes remainder of the file *)
(kind, data, empty_bitstring)
| { size : 32 : bigendian;
kind : 32 : string;
data : Int32.to_int size * 8 - 64 : bitstring;
rest : -1 : bitstring } ->
(* a regular box *)
(kind, data, rest)
| { _ } -> failwith "mp4: failure parsing box"
let fullbox bits =
let (kind, data, rest) = box bits in
bitmatch data with
| { version : 8; flags : 24 : bigendian; data' : -1 : bitstring } ->
(* data is actually version : flags : data *)
(kind, data', version, flags, rest)
| { _ } -> failwith "mp4: failure parsing full box"
let rec boxes bits acc =
if bitstring_length bits = 0 then List.rev acc
else
let (kind, data, rest) = box bits in
boxes rest ((kind, data) :: acc)
let rec find_box kind parent =
let children = try boxes parent [] with Failure _ -> [] in
let rec loop = function
| [] -> None
| (k,data) :: _ when k = kind -> Some data
| (_,data) :: xs ->
let r = find_box kind data in
if r = None then loop xs else r
in loop children
let find_box kind parent = match find_box kind parent with
| None -> failwith "mp4: unable to find box"
| Some box -> box
(* the proper way to find a nested box rather than find_box above *)
let rec get_box path bits = match path with
| [] -> bits
| k :: kinds ->
let children = boxes bits [] in
get_box kinds (List.assoc k children)
let show_sample_description bits =
bitmatch bits with
| { _ : 32; (* version & flags *)
0x1l : 32 : bigendian; (* num_entries *)
_ : 32; (* size *)
format_id : 32 : string;
_ : 48; (* reserved *)
0x1 : 16 : bigendian;
_ : 64; (* revision level, vendor, reserved *)
channels_per_frame : 16 : bigendian;
bits_per_channel : 16 : bigendian;
_ : 32; (* compression id, packet size *)
sample_rate : 16 : bigendian;
_ : 16;
cookie : -1 : bitstring }
->
Printf.printf "format id = %s, channels = %d, bitrate = %d, sample rate = %d\n"
format_id channels_per_frame bits_per_channel sample_rate
| { _ } -> Printf.printf "invalid sample description"
let check_sample_description bits =
bitmatch bits with
| { _ : 32; (* version & flags *)
0x1l : 32 : bigendian; (* num_entries *)
_ : 32; (* size *)
format_id : 32 : string;
_ : 48; (* reserved *)
0x1 : 16 : bigendian;
_ : 64; (* revision level, vendor, reserved *)
num_channels : 16 : bigendian;
bits_per_channel : 16 : bigendian;
_ : 32; (* compression id, packet size *)
sample_rate : 16 : bigendian;
_ : 16;
cookie : -1 : bitstring }
when format_id = "alac" && num_channels = 2
&& bits_per_channel = 16 && sample_rate = 44100 ->
cookie
| { _ } -> failwith "mp4: not a compatible mp4 file; expect alac, 16-bit stereo @ 44100kHz"
let openfile filename =
(*
ftyp => check it's actually "M4A "
moov.trak.mdia.minf.stbl.stsd => parse specific config from this
mdat => the actual data
*)
match boxes (bitstring_of_file filename) [] with
| ("ftyp", ftyp) :: ("moov", moov) :: rest
when String.sub (string_of_bitstring ftyp) 0 4 = "M4A " ->
(*let stsd = find_box "stsd" moov in*)
let stsd = get_box ["trak";"mdia";"minf";"stbl";"stsd"] moov in
let mdat = List.assoc "mdat" rest in
check_sample_description stsd, mdat
| _ -> failwith "mp4: unable to parse as an alac media file"
(* this stuff is useful for debugging layout of mp4 container *)
type action = Recurse | Display of (bitstring -> unit)
open Hashtbl
let actions = Hashtbl.create 10
let () =
(* register some actions for some boxes *)
add actions "moov" Recurse;
add actions "trak" Recurse;
add actions "udta" Recurse;
add actions "mdia" Recurse;
add actions "minf" Recurse;
add actions "stbl" Recurse;
add actions "stsd" (Display show_sample_description)
let rec box indent bits =
bitmatch bits with
| { 0x0000_l : 32 : bigendian;
kind : 32 : string;
data : -1 : bitstring }
-> Printf.printf "%*slast box: %s\n" indent "" kind; action indent kind data
| { 0x0001_l : 32 : bigendian;
kind : 32 : string;
size : 64 : bigendian;
data : Int64.to_int size * 8 - 96: bitstring;
next : -1 : bitstring }
-> Printf.printf "%*slarge box: %s, %Ld bytes\n" indent "" kind size; action indent kind data; box indent next
| { size : 32 : bigendian;
kind : 32 : string;
data : Int32.to_int size * 8 - 64 : bitstring;
next : -1 : bitstring }
-> Printf.printf "%*ssmall box: %s, %ld bytes\n" indent "" kind size; action indent kind data; box indent next
| { _ } -> ()
and action indent kind bits =
try
match Hashtbl.find actions kind with
| Recurse -> box (indent + 2) bits
| Display f -> f bits
with Not_found -> ()
let run filename =
box 0 (Bitstring.bitstring_of_file filename)