(******************************************************************************) (* binary -> text conversion (met decompiler) *) (* (C) 2009..2010 Steffen Solyga *) (******************************************************************************) IMPLEMENTATION MODULE Bin2Txt; FROM SYSTEM IMPORT BYTE, ADR; IMPORT Str, FIO, LibC, Lib; IMPORT BfdIn, BfdOut, MD4, Met, Strs; CONST f = FIO.ErrorOutput; inBufLen = 32 * 1024; outBufLen = 32 * 1024; VAR inName, outName: Strs.TStr; inFile, outFile: FIO.File; inBuf: BfdIn.TBuffer; outBuf: BfdOut.TBuffer; inPos: LONGCARD; PROCEDURE Error( s: ARRAY OF CHAR; c: Met.TExitCode ); BEGIN BfdOut.Flush( outBuf ); FIO.WrStr( f, 'metc: Error: ' ); IF inName = Strs.noStr THEN FIO.WrStr( f, '' ); ELSIF inName = Strs.emptyStr THEN FIO.WrStr( f, 'STDIN' ); ELSE FIO.WrStr( f, "'" ); FIO.WrStr( f, inName^ ); FIO.WrStr( f, "'" ); END; FIO.WrStr( f, ' (' ); FIO.PrefixChar := '0'; FIO.WrLngHex( f, inPos, 8 ); FIO.WrStr( f, 'H): ' ); FIO.WrStr( f, s ); FIO.WrStr( f, '.' ); FIO.WrLn( f ); Met.Exit( c ); END Error; PROCEDURE Warning( s: ARRAY OF CHAR ); BEGIN FIO.WrStr( f, 'metc: Warning @ offset ' ); FIO.PrefixChar := '0'; FIO.WrLngHex( f, inPos, 8 ); FIO.WrStr( f, 'H: ' ); FIO.WrStr( f, s ); FIO.WrStr( f, '.' ); FIO.WrLn( f ); END Warning; (***** basic (binary) input *****) PROCEDURE RdBin( VAR b: ARRAY OF BYTE; n: CARDINAL ); BEGIN IF SIZE(b) < n THEN Error( 'Bug: Buffer too small', Met.ecBug ); END; IF BfdIn.RdBin( inBuf, b, n ) # n THEN Error( 'Unexpected EOF', Met.ecEOF ) END; INC( inPos, n ); END RdBin; PROCEDURE RdChar( VAR c: CHAR ); BEGIN RdBin( c, 1 ); END RdChar; PROCEDURE RdShtCard( VAR x: SHORTCARD ); CONST l = 1; BEGIN x := 0; RdBin( x, l ); END RdShtCard; PROCEDURE RdCard( VAR x: CARDINAL ); CONST l = 2; BEGIN x := 0; RdBin( x, l ); END RdCard; PROCEDURE RdLngCard( VAR x: LONGCARD ); CONST l = 4; BEGIN x := 0; RdBin( x, l ); END RdLngCard; PROCEDURE RdHash( VAR x: MD4.TDgstDesc ); BEGIN RdBin( x, SIZE(MD4.TDgstDesc) ); END RdHash; (***** some (text) output *****) PROCEDURE WrHash( h: MD4.TDgstDesc ); VAR s: MD4.TDgstStr; BEGIN BfdOut.WrChar( outBuf, '#' ); MD4.MkStr( s, h ); BfdOut.WrStr( outBuf, s ); END WrHash; (***** conversion *****) PROCEDURE Magic( VAR mt: Met.TMetType ); VAR x: SHORTCARD; BEGIN RdShtCard( x ); CASE x OF | Met.mcKnown : mt := Met.mtKnown; BfdOut.WrStr( outBuf, Met.msKnown ); | Met.mcKnownLarge: mt := Met.mtKnown; BfdOut.WrStr( outBuf, Met.msKnownLarge ); | Met.mcPart : mt := Met.mtPart; BfdOut.WrStr( outBuf, Met.msPart ); ELSE Error( 'Unknown file magic', Met.ecMagic ); END; BfdOut.WrLn( outBuf ); END Magic; PROCEDURE Date(); VAR d: LONGCARD; tm: LibC.TDateTimeDesc; pc: CHAR; BEGIN RdLngCard( d ); LibC.LocalTime( d, tm ); pc := BfdOut.GetPrefix( outBuf ); BfdOut.SetPrefix( outBuf, '0' ); BfdOut.WrStr( outBuf, ' ' ); BfdOut.WrLngCard( outBuf, tm.year + 1900, 4 ); BfdOut.WrChar( outBuf, '-' ); BfdOut.WrLngCard( outBuf, tm.month + 1, 2 ); BfdOut.WrChar( outBuf, '-' ); BfdOut.WrLngCard( outBuf, tm.mday, 2 ); BfdOut.WrChar( outBuf, ' ' ); BfdOut.WrLngCard( outBuf, tm.hour, 2 ); BfdOut.WrChar( outBuf, ':' ); BfdOut.WrLngCard( outBuf, tm.min, 2 ); BfdOut.WrChar( outBuf, ':' ); BfdOut.WrLngCard( outBuf, tm.sec, 2 ); BfdOut.WrChar( outBuf, ' ' ); BfdOut.WrLngCard( outBuf, tm.isdst, 1 ); BfdOut.WrStr( outBuf, ' (* ' ); BfdOut.WrLngHex( outBuf, d, 8 ); BfdOut.WrStr( outBuf, ' *)' ); BfdOut.WrLn( outBuf ); BfdOut.SetPrefix( outBuf, pc ); END Date; PROCEDURE FileHash( VAR h: MD4.TDgstDesc ); BEGIN RdHash( h ); BfdOut.WrStr( outBuf, ' ' ); WrHash( h ); BfdOut.WrLn( outBuf ); END FileHash; PROCEDURE PartHash( VAR h: MD4.TDgstDesc ); BEGIN RdHash( h ); BfdOut.WrStr( outBuf, ' ' ); WrHash( h ); BfdOut.WrLn( outBuf ); END PartHash; PROCEDURE PartHashList( VAR h: MD4.TDgstDesc ); VAR cnt: CARDINAL; ctx: MD4.TCtxDesc; ph: MD4.TDgstDesc; BEGIN RdCard( cnt ); BfdOut.WrStr( outBuf, ' parts ' ); BfdOut.WrCard( outBuf, cnt, 0 ); BfdOut.WrStr( outBuf, ' (' ); BfdOut.WrLn( outBuf ); IF cnt > 0 THEN MD4.Init( ctx ); WHILE cnt > 0 DO PartHash( ph ); MD4.Update( ctx, ph, SIZE(ph) ); DEC( cnt ); END; MD4.Final( ctx, h ); (* cnt = 0 ==> h keeps value *) END; BfdOut.WrStr( outBuf, ' )' ); BfdOut.WrLn( outBuf ); END PartHashList; PROCEDURE SpecialTag(); VAR st: SHORTCARD; pc: CHAR; BEGIN RdShtCard( st ); pc := BfdOut.GetPrefix( outBuf ); BfdOut.SetPrefix( outBuf, '0' ); BfdOut.WrChar( outBuf, '$' ); BfdOut.WrShtHex( outBuf, st, 2 ); BfdOut.WrStr( outBuf, ' (* ' ); CASE st OF | 001H: BfdOut.WrStr( outBuf, 'name' ); | 002H: BfdOut.WrStr( outBuf, 'size' ); | 003H: BfdOut.WrStr( outBuf, 'type' ); | 004H: BfdOut.WrStr( outBuf, 'frmt' ); | 012H: BfdOut.WrStr( outBuf, 'ptnm' ); | 019H: BfdOut.WrStr( outBuf, 'priu' ); | 021H: BfdOut.WrStr( outBuf, 'klps' ); | 027H: BfdOut.WrStr( outBuf, 'aich' ); | 050H: BfdOut.WrStr( outBuf, 'xfdl' ); | 051H: BfdOut.WrStr( outBuf, 'rqed' ); | 052H: BfdOut.WrStr( outBuf, 'accd' ); | 054H: BfdOut.WrStr( outBuf, 'xfdh' ); ELSE BfdOut.WrStr( outBuf, 'unkn' ); END; BfdOut.WrStr( outBuf, ' *)' ); BfdOut.SetPrefix( outBuf, pc ); END SpecialTag; PROCEDURE TwoByteTag(); VAR tg: CARDINAL; pc: CHAR; BEGIN RdCard( tg ); pc := BfdOut.GetPrefix( outBuf ); BfdOut.SetPrefix( outBuf, '0' ); BfdOut.WrChar( outBuf, '$' ); BfdOut.WrHex( outBuf, tg, 4 ); BfdOut.WrStr( outBuf, ' (* ?? *)' ); BfdOut.SetPrefix( outBuf, pc ); END TwoByteTag; PROCEDURE ThreeByteTag(); VAR tg: LONGCARD; pc: CHAR; BEGIN tg := 0; RdBin( tg, 3 ); pc := BfdOut.GetPrefix( outBuf ); BfdOut.SetPrefix( outBuf, '0' ); BfdOut.WrChar( outBuf, '$' ); BfdOut.WrHex( outBuf, tg, 6 ); BfdOut.WrStr( outBuf, ' (* *)' ); BfdOut.SetPrefix( outBuf, pc ); END ThreeByteTag; PROCEDURE StringBody( l: CARDINAL ); VAR c: CHAR; BEGIN BfdOut.WrChar( outBuf, "'" ); WHILE l > 0 DO RdChar( c ); DEC( l ); CASE ORD(c) OF | 020H..07EH: (* printables *) IF c = "'" THEN BfdOut.WrChar( outBuf, c ); BfdOut.WrStr( outBuf, ' + "' ); BfdOut.WrChar( outBuf, c ); BfdOut.WrStr( outBuf, '" + ' ); END; | 0C2H: (* UTF-8 specials *) RdChar( c ); DEC( l ); CASE ORD( c ) OF | 080H..09FH: (* controls (already seen with aMule) *) | 0A0H..0BFH: (* printables '|', '¡'..'¿' *) ELSE Error( 'Invalid special character', Met.ecStr ); END; | 0C3H: (* UTF-8 umlauts *) RdChar( c ); DEC( l ); CASE ORD( c ) OF | 080H..0BFH: (* printables 'À'..'ÿ' *) c := VAL( CHAR, ORD(c) + 40H ); ELSE Error( 'Invalid umlaut character', Met.ecStr ); END; ELSE Error( 'Invalid character', Met.ecStr ); END; BfdOut.WrChar( outBuf, c ); END; BfdOut.WrChar( outBuf, "'" ); END StringBody; PROCEDURE MetaTagName(); VAR pos: LONGCARD; len: CARDINAL; BEGIN pos := inPos; RdCard( len ); CASE len OF | 0: Error( 'Zero meta tag length', Met.ecTag ); | 1: SpecialTag(); | 2: TwoByteTag(); | 3: ThreeByteTag(); ELSE StringBody( len ); END; BfdOut.WrStr( outBuf, ' = ' ); END MetaTagName; PROCEDURE String(); VAR len: CARDINAL; BEGIN RdCard( len ); StringBody( len ); END String; PROCEDURE UInt32(); VAR val: LONGCARD; pc: CHAR; BEGIN RdLngCard( val ); pc := BfdOut.GetPrefix( outBuf ); BfdOut.SetPrefix( outBuf, '0' ); BfdOut.WrChar( outBuf, '$' ); BfdOut.WrLngHex( outBuf, val, 8 ); BfdOut.SetPrefix( outBuf, pc ); BfdOut.WrStr( outBuf, ' (* ' ); BfdOut.WrLngCard( outBuf, val, 0 ); BfdOut.WrStr( outBuf, ' *)' ); END UInt32; PROCEDURE Float32(); BEGIN Error( 'Float32 not (yet) implemented', Met.ecBug ); END Float32; PROCEDURE UInt64(); VAR l,h: LONGCARD; pc: CHAR; BEGIN RdLngCard( l ); RdLngCard( h ); pc := BfdOut.GetPrefix( outBuf ); BfdOut.SetPrefix( outBuf, '0' ); BfdOut.WrChar( outBuf, '$' ); BfdOut.WrLngHex( outBuf, h, 8 ); BfdOut.WrLngHex( outBuf, l, 8 ); BfdOut.SetPrefix( outBuf, pc ); END UInt64; PROCEDURE MetaTag(); TYPE TCnvDesc = RECORD CASE : CARDINAL OF | 0: tt: Met.TTagType; | 1: sc: SHORTCARD; | 2: lc: LONGCARD; END; END; VAR pos: LONGCARD; cnv: TCnvDesc; BEGIN BfdOut.WrStr( outBuf, ' ' ); pos := inPos; cnv.lc := 0; RdShtCard( cnv.sc ); CASE cnv.tt OF | Met.ttString : MetaTagName(); String(); | Met.ttUInt32 : MetaTagName(); UInt32(); | Met.ttFloat32: MetaTagName(); Float32(); | Met.ttUInt64 : MetaTagName(); UInt64(); ELSE Error( 'Unknown meta tag type', Met.ecTag ); END; BfdOut.WrLn( outBuf ); END MetaTag; PROCEDURE MetaTagList(); VAR cnt: LONGCARD; BEGIN RdLngCard( cnt ); BfdOut.WrStr( outBuf, ' tags ' ); BfdOut.WrCard( outBuf, cnt, 0 ); BfdOut.WrStr( outBuf, ' (' ); BfdOut.WrLn( outBuf ); WHILE cnt > 0 DO MetaTag(); DEC( cnt ); END; BfdOut.WrStr( outBuf, ' )' ); BfdOut.WrLn( outBuf ); END MetaTagList; PROCEDURE FileStat(); VAR h0,h1: MD4.TDgstDesc; BEGIN Date(); FileHash( h0 ); h1 := h0; PartHashList( h1 ); IF Lib.Compare( ADR(h0), ADR(h1), SIZE(h0) ) # SIZE( h0 ) THEN Warning( 'Part hashes do not match file hash' ); END; MetaTagList(); END FileStat; PROCEDURE FileStatList(); VAR cnt: LONGCARD; BEGIN RdLngCard( cnt ); BfdOut.WrStr( outBuf, 'files ' ); BfdOut.WrLngCard( outBuf, cnt, 0 ); BfdOut.WrStr( outBuf, ' (' ); BfdOut.WrLn( outBuf ); WHILE cnt > 0 DO FileStat(); DEC( cnt ); END; BfdOut.WrStr( outBuf, ')' ); BfdOut.WrLn( outBuf ); END FileStatList; PROCEDURE EndOfFile(); VAR pos: LONGCARD; c: CHAR; BEGIN pos := inPos; c := BfdIn.RdChar( inBuf ); IF c # BfdIn.chrEOF THEN Warning( 'Trailing garbage ignored' ); END; END EndOfFile; PROCEDURE Read( VAR x: ARRAY OF BYTE; n: CARDINAL ): CARDINAL; BEGIN RETURN FIO.RdBin( inFile, x, n ); END Read; PROCEDURE Write( VAR x: ARRAY OF BYTE; n: CARDINAL ); BEGIN FIO.WrBin( outFile, x, n ); END Write; PROCEDURE Run( in, out: Strs.TStr ); VAR mt: Met.TMetType; BEGIN inName := in; outName := out; IF inName # Strs.emptyStr THEN inFile := FIO.OpenRead( inName^ ); END; IF outName # Strs.emptyStr THEN outFile := FIO.Create( outName^ ); END; inBuf := BfdIn.New( inBufLen, Read ); outBuf := BfdOut.New( outBufLen, Write ); Magic( mt ); CASE mt OF | Met.mtKnown: FileStatList(); | Met.mtPart : FileStat(); END; EndOfFile(); BfdOut.Dispose( outBuf ); BfdIn.Dispose( inBuf ); IF outFile # FIO.StandardOutput THEN FIO.Close( outFile ); END; IF inFile # FIO.StandardInput THEN FIO.Close( inFile ); END; END Run; BEGIN inName := Strs.noStr; outName := Strs.noStr; inFile := FIO.StandardInput; outFile := FIO.StandardOutput; inPos := 0; inBuf := BfdIn.noBuffer; outBuf := BfdOut.noBuffer; END Bin2Txt.