forked from hepek/MPEG-TS
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Main.hs
141 lines (118 loc) · 5.04 KB
/
Main.hs
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
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as BS
import Data.Binary.Get
import Data.Word
import Data.Bits
import Control.Applicative hiding (empty)
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import System.Environment
import System.Directory (removeFile)
import System.IO
import Codec.Video.MpegTS
import Numeric
filterPID pid = filter ((pid==).ts_pid)
printInfoFile = printInfo <=< BL.readFile
printInfo bytes = do
let tspackets = collectTS bytes 0
let pidpackets= filterPID 0 tspackets
handlePAT (head pidpackets) tspackets
where
handlePAT patTS tspackets = do
let pat = (runGet.decodePAT) (ts_pst patTS)
(BL.fromChunks [fromJust.ts_data$ patTS])
forM_ (pat_programs pat)
(\(PAT_Prog num pid) -> do
putStrLn$ "Program: " ++ (show num)
let pmtTS = filterPID pid tspackets
let pmt = runGet (decodePMT $ ts_pst.head $ pmtTS)
(BL.fromChunks (map (fromJust.ts_data) pmtTS))
printPMT pmt)
printPMT (PMT _ _ pcrpid _ progs) = do
putStrLn$ "\tPCR: " ++ show pcrpid
forM progs
(\(PMT_Prog st pid info) -> do
putStrLn$ "\tStream PID: " ++ show pid
putStrLn$ "\t\tStream Type: " ++ show st
putStrLn$ "\t\tDescription: " ++ show info)
showWOData ts = do
putStrLn$ "ts_pid: " ++ (show $ ts_pid ts)
putStrLn$ "ts_pst: " ++ (show $ ts_pst ts)
putStrLn$ "ts_contc: " ++ (show $ ts_contc ts)
putStrLn$ "ts_ad: " ++ (showAD $ ts_ad ts)
putStrLn "------------------------"
showAD Nothing = "Nothing"
showAD (Just ad) = "len: " ++ show (ad_len ad) ++ " flags: " ++ show (ad_flags ad) ++ "\tpcr: "
++ show (ad_pcr ad) ++ "\topcr: " ++ show (ad_opcr ad) ++ "\tspl: " ++ show (ad_splice ad)
printAdaptation = printInfoAd <=< BL.readFile
where
printInfoAd bytes = do
let tspackets = filter (isJust.ts_ad)(collectTS bytes 0)
forM_ tspackets showWOData
printDisconts pid = printInfoDisconts pid <=< BL.readFile
where
printInfoDisconts pid bytes = do
mapM_ (\(ts, off) -> do
putStrLn$ "0x" ++ (showHex off ":")
showWOData ts)
(filter (\(ts,_) -> (af_discont.ad_flags) (fromJust (ts_ad ts))) $
filter (\(ts,_) -> (isJust.ts_ad $ ts) && (ts_pid ts == pid)) $ (collectTSOff bytes 0))
discontinuities pids tss = filter (\ts -> (af_discont.ad_flags) (fromJust (ts_ad ts))) $ filter (\ts -> (isJust.ts_ad $ ts) && (ts_pid ts `elem` pids)) $ tss
selectPID pid srcFileName destFileName = do
bytes <- BL.readFile srcFileName
let packets = (filterPID pid $ collectTS bytes 0)
case packets of
[] -> error $ "PID " ++ (show pid) ++ " not present in the stream"
_ ->
forM_ packets (\x-> case (ts_data x) of
Just datum -> BS.appendFile destFileName datum
Nothing -> return ())
return ()
uniqPids fileName = do
bytes <- BL.readFile fileName
let packets = collectTS bytes 0
mapM_ print $ nub $ map (ts_pid) packets
hasDiscont = hasDiscont' <=< BL.readFile
where
hasDiscont' bytes = do
let tspackets = collectTS bytes 0
let patTS = head $ filterPID 0 tspackets
let pat = runGet (decodePAT (ts_pst patTS))
(BL.fromChunks [fromJust.ts_data$ patTS])
pcrs <- forM (pat_programs pat)
(\(PAT_Prog num pid) -> do
let pmtTS = filterPID pid tspackets
let pmt = runGet (decodePMT $ ts_pst.head $ pmtTS) (BL.fromChunks (map (fromJust.ts_data) pmtTS))
return $ pmt_pcrPID pmt)
if (null $ discontinuities pcrs tspackets)
then
return ()
else
error "discontinuities found"
printUsage = do
name <- getProgName
hPutStrLn stderr $ unlines
[name ++ " - a program for MPEGTS stream analysis."
,"Usage: " ++ name ++ " info <FILE> " ++
"#to view stream info of a file"
," " ++ name ++ " adaptation <FILE> " ++
"#to view stream adaptation fields"
," " ++ name ++ " discont <PID> <FILE> " ++
"#to view stream discontinuities"
," " ++ name ++ " hasDiscont <FILE> " ++
"#to check for discontinuities in any program"
," " ++ name ++ " uniqPids <FILE> " ++
"#to display a list of unique PIDs in a stream"
," " ++ name ++ " demux pid <SOURCEFILE> <DESTFILE> #to demux a file"]
main = do
args <- getArgs
case args of
["adaptation", fileName] -> printAdaptation fileName
["discont", pid, fileName] -> printDisconts (read pid) fileName
["hasDiscont", fileName] -> hasDiscont fileName
["info", fileName] -> printInfoFile fileName
["demux", pid, sFileName, dFileName] -> selectPID (read pid) sFileName dFileName
["uniqPids", fileName] -> uniqPids fileName
_ -> printUsage