(******************************************************************************) (* text -> binary conversion (met compiler) *) (* (C) 2009..2010 Steffen Solyga *) (******************************************************************************) IMPLEMENTATION MODULE Txt2Bin; FROM SYSTEM IMPORT BYTE; IMPORT SysLib, Str, FIO, LibC; IMPORT BfdOut, MD4, Met, Strs, TxtScnr; CONST outBufLen = 32 * 1024; VAR inName, outName: Strs.TStr; outFile: FIO.File; outBuf: BfdOut.TBuffer; large: BOOLEAN; (***** basic (binary) output *****) PROCEDURE WrShtCard( x: SHORTCARD ); BEGIN BfdOut.WrBin( outBuf, x, 1 ); END WrShtCard; PROCEDURE WrCard( x: CARDINAL ); BEGIN BfdOut.WrBin( outBuf, x, 2 ); END WrCard; PROCEDURE WrMedCard( x: LONGCARD ); BEGIN BfdOut.WrBin( outBuf, x, 3 ); END WrMedCard; PROCEDURE WrLngCard( x: LONGCARD ); BEGIN BfdOut.WrBin( outBuf, x, 4 ); END WrLngCard; PROCEDURE WrDgst( VAR x: MD4.TDgstDesc ); BEGIN BfdOut.WrBin( outBuf, x, SIZE(x) ); END WrDgst; PROCEDURE WrMetStr( VAR s: ARRAY OF CHAR; l: CARDINAL ); BEGIN WrCard( l ); BfdOut.WrBin( outBuf, s, l ); END WrMetStr; (***** conversion *****) PROCEDURE Error( s: ARRAY OF CHAR ); CONST e = FIO.ErrorOutput; BEGIN FIO.WrStr( e, 'metc: Error: ' ); IF inName = Strs.noStr THEN FIO.WrStr( e, '' ); ELSIF inName = Strs.emptyStr THEN FIO.WrStr( e, 'STDIN' ); ELSE FIO.WrStr( e, "'" ); FIO.WrStr( e, inName^ ); FIO.WrStr( e, "'" ); END; FIO.WrStr( e, ' (' ); FIO.WrLngCard( e, TxtScnr.pos.l, 0 ); FIO.WrStr( e, ',' ); FIO.WrLngCard( e, TxtScnr.pos.c, 0 ); FIO.WrStr( e, '): ' ); FIO.WrStr( e, s ); FIO.WrStr( e, '.' ); FIO.WrLn( e ); BfdOut.Dispose( outBuf ); Met.Exit( Met.ecSyntax ); END Error; PROCEDURE Warning( s, s1: ARRAY OF CHAR ); CONST e = FIO.ErrorOutput; BEGIN FIO.WrStr( e, 'metc: Warning: ' ); IF inName = Strs.noStr THEN FIO.WrStr( e, '' ); ELSIF inName = Strs.emptyStr THEN FIO.WrStr( e, 'STDIN' ); ELSE FIO.WrStr( e, "'" ); FIO.WrStr( e, inName^ ); FIO.WrStr( e, "'" ); END; FIO.WrStr( e, ' (' ); FIO.WrLngCard( e, TxtScnr.pos.l, 0 ); FIO.WrStr( e, ',' ); FIO.WrLngCard( e, TxtScnr.pos.c, 0 ); FIO.WrStr( e, '): ' ); FIO.WrStr( e, s ); IF Str.Length( s1 ) > 0 THEN FIO.WrChar( e, ' ' ); FIO.WrStr( e, s1 ); END; FIO.WrChar( e, '.' ); FIO.WrLn( e ); END Warning; PROCEDURE Date(); PROCEDURE Num( min, max: LONGCARD ): INTEGER; VAR x: LONGCARD; BEGIN x := TxtScnr.num; IF ( x < min ) OR ( x > max ) THEN Error( 'Value out of range' ) END; TxtScnr.Read(); RETURN INTEGER( x ); END Num; VAR tm: LibC.TDateTimeDesc; BEGIN IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected year' ) END; tm.year := Num( 1970, 2100 ) - 1900; IF TxtScnr.sym # TxtScnr.symDash THEN Error( "Expected '-'" ) END; TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected month' ) END; tm.month := Num( 1, 12 ) - 1; IF TxtScnr.sym # TxtScnr.symDash THEN Error( "Expected '-'" ) END; TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected day' ) END; tm.mday := Num( 1, 31 ); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected hour' ) END; tm.hour := Num( 0, 23 ); IF TxtScnr.sym # TxtScnr.symDDot THEN Error( "Expected ':'" ) END; TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected minute' ) END; tm.min := Num( 0, 59 ); IF TxtScnr.sym # TxtScnr.symDDot THEN Error( "Expected ':'" ) END; TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected second' ) END; tm.sec := Num( 0, 60 ); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected DST value' ) END; tm.isdst := Num( 0, 1 ); WrLngCard( LONGCARD(LibC.MkTime(tm)) ); END Date; PROCEDURE Digest(); BEGIN IF TxtScnr.sym # TxtScnr.symDgst THEN Error( "Expected MD4 digest" ) END; WrDgst( TxtScnr.dgst ); TxtScnr.Read(); END Digest; PROCEDURE Parts(); VAR cnt: LONGCARD; BEGIN TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected part count' ) END; cnt := TxtScnr.num; IF cnt > 0FFFFH THEN Error( 'Part count too high' ) END; WrCard( CARDINAL(cnt) ); TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symLPar THEN Error( "Expected '('" ) END; TxtScnr.Read(); WHILE TxtScnr.sym = TxtScnr.symDgst DO IF cnt <= 0 THEN Error( 'More parts than stated' ) END; Digest(); DEC( cnt ); END; IF TxtScnr.sym # TxtScnr.symRPar THEN IF cnt <= 0 THEN Error( "Expected ')'" ); ELSE Error( 'Expected part digest' ); END; END; IF cnt > 0 THEN Error( 'Less parts than stated' ) END; TxtScnr.Read(); END Parts; PROCEDURE Tag(); TYPE TCnvDesc = RECORD CASE : CARDINAL OF | 0: l: LONGCARD; | 1: c: CARDINAL; | 2: s: SHORTCARD; END; END; VAR cnv: TCnvDesc; str: TxtScnr.TString; len: CARDINAL; PROCEDURE WrTagName(); BEGIN IF cnv.l <= 0 THEN WrMetStr( str, len ); ELSIF cnv.l < 100H THEN WrCard( 1 ); WrShtCard( cnv.s ); ELSIF cnv.l < 10000H THEN WrCard( 2 ); WrCard( cnv.c ); ELSE WrCard( 3 ); WrMedCard( cnv.l ); END; END WrTagName; PROCEDURE PutStr(); PROCEDURE Put( x: CHAR ); BEGIN IF len >= SIZE(str) THEN Error( 'String too long' ) END; str[ len ] := x; INC( len ); END Put; VAR i: CARDINAL; c: CHAR; BEGIN IF TxtScnr.len <= 0 THEN RETURN END; i := 0; WHILE i < TxtScnr.len DO c := TxtScnr.str[ i ]; CASE ORD( c ) OF | 020H..07EH: Put( c ); | 080H..0BFH: Put( CHR(0C2H) ); Put( c ); | 0C0H..0FFH: Put( CHR(0C3H) ); Put( VAL( CHAR, ORD(c) - 040H ) ); ELSE Error( 'Invalid character' ); END; INC( i ); END; END PutStr; BEGIN cnv.l := 0; CASE TxtScnr.sym OF | TxtScnr.symNum: (* special, two- or three-byte tag *) cnv.l := TxtScnr.num; IF ( cnv.l <= 0 ) OR ( cnv.l >= 0FFFFFFH ) THEN Error( 'Invalid meta tag name' ); END; | TxtScnr.symStr: (* normal name string *) len := 0; PutStr(); IF len < 4 THEN Error( 'Invalid meta tag name' ) END; ELSE Error( 'Expected meta tag name' ); END; TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symEqu THEN Error( "Expected '='" ) END; TxtScnr.Read(); CASE TxtScnr.sym OF | TxtScnr.symNum: IF TxtScnr.hig <= 0 THEN WrShtCard( SHORTCARD(Met.ttUInt32) ); WrTagName(); WrLngCard( TxtScnr.num ); ELSE IF ~ large THEN Warning( 'UInt64 without', Met.msKnownLarge ) END; WrShtCard( SHORTCARD(Met.ttUInt64) ); WrTagName(); WrLngCard( TxtScnr.num ); WrLngCard( TxtScnr.hig ); END; TxtScnr.Read(); | TxtScnr.symStr: WrShtCard( SHORTCARD(Met.ttString) ); WrTagName(); len := 0; PutStr(); TxtScnr.Read(); WHILE TxtScnr.sym = TxtScnr.symPlus DO TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symStr THEN Error( 'Expected string' ) END; PutStr(); TxtScnr.Read(); END; WrMetStr( str, len ); ELSE Error( 'Expected meta tag value' ); END; END Tag; PROCEDURE Tags(); VAR cnt: LONGCARD; BEGIN TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected tag count' ) END; cnt := TxtScnr.num; WrLngCard( cnt ); TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symLPar THEN Error( "Expected '('" ) END; TxtScnr.Read(); WHILE ( TxtScnr.sym = TxtScnr.symNum ) OR ( TxtScnr.sym = TxtScnr.symStr ) DO IF cnt <= 0 THEN Error( 'More tags than stated' ) END; Tag(); DEC( cnt ); END; IF TxtScnr.sym # TxtScnr.symRPar THEN IF cnt <= 0 THEN Error( "Expected ')'" ); ELSE Error( 'Expected tag' ); END; END; IF cnt > 0 THEN Error( 'Less tags than stated' ) END; TxtScnr.Read(); END Tags; PROCEDURE File(); BEGIN IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected date' ) END; Date(); IF TxtScnr.sym # TxtScnr.symDgst THEN Error( 'Expected file hash' ) END; Digest(); IF TxtScnr.sym # TxtScnr.symKwParts THEN Error( 'Expected parts' ) END; Parts(); IF TxtScnr.sym # TxtScnr.symKwTags THEN Error( 'Expected tags' ) END; Tags(); END File; PROCEDURE Known( x: SHORTCARD ); VAR cnt: LONGCARD; BEGIN WrShtCard( x ); TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symKwFiles THEN Error( 'Expected file list' ) END; TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symNum THEN Error( 'Expected file count' ) END; cnt := TxtScnr.num; WrLngCard( cnt ); TxtScnr.Read(); IF TxtScnr.sym # TxtScnr.symLPar THEN Error( "Expected '('" ) END; TxtScnr.Read(); WHILE TxtScnr.sym = TxtScnr.symNum DO IF cnt <= 0 THEN Error( 'More file entries than stated' ) END; File(); DEC( cnt ); END; IF TxtScnr.sym # TxtScnr.symRPar THEN IF cnt <= 0 THEN Error( "Expected ')'" ) ELSE Error( 'Expected file entry' ); END; END; IF cnt > 0 THEN Error( 'Less file entries than stated' ) END; TxtScnr.Read(); END Known; PROCEDURE Part(); BEGIN WrShtCard( Met.mcPart ); TxtScnr.Read(); File(); END Part; PROCEDURE Write( VAR x: ARRAY OF BYTE; n: CARDINAL ); BEGIN FIO.WrBin( outFile, x, n ); END Write; PROCEDURE Run( in, out: Strs.TStr ); BEGIN inName := in; outName := out; TxtScnr.Open( inName^ ); IF outName # Strs.emptyStr THEN outFile := FIO.Create( outName^ ); ELSE outFile := FIO.StandardOutput; END; outBuf := BfdOut.New( outBufLen, Write ); TxtScnr.Read(); CASE TxtScnr.sym OF | TxtScnr.symKwKnown : large := FALSE; Known( Met.mcKnown ); | TxtScnr.symKwKnownLarge: large := TRUE; Known( Met.mcKnownLarge ); | TxtScnr.symKwPart : Part(); ELSE Error( 'Expected known' ); END; BfdOut.Dispose( outBuf ); IF outFile # FIO.StandardOutput THEN FIO.Close( outFile ); END; TxtScnr.Close(); END Run; BEGIN inName := Strs.noStr; outName:= Strs.noStr; outFile := FIO.StandardOutput; outBuf := BfdOut.noBuffer; large := FALSE; END Txt2Bin.