PROGRAM DumpP2K;

{ program to read the contents of a PKT2000.100 file (.P2K) and }
{ write it to the standard output.                              }

{ P2K tests

 - wrong ID: one char wrong and all wrong (and/or test errors) (must abort file)
 - too short main header len value (must abort file)
 - new major/minor number
 - too few bytes for main header len (must abort file)
 - additional main header bytes (must be skipped)
 - too few bytes for packed header (must stop processing)
 - additional packed header bytes (must be skipped)
 - 0, 1 and more ExtraFields
 - invalid dates (year < 100, etc.)
 - Organization must not contain (aka)!
 - NUL in body - must be replaced
}

USES Dos,
     Ramon;

{$I+}

TYPE NetworkAddress = RECORD
                            Zone  : WORD;
                            Net   : WORD;
                            Node  : WORD;
                            Point : WORD;
                      END;

TYPE Type2000Header  = RECORD
                             Id              : ARRAY[1..3] Of CHAR; {Must always be "P2K"}
                             MainHeaderLen   : WORD;
                             SubHeaderLen    : WORD;
                             OrigAddr        : NetworkAddress;
                             OrigDomain      : STRING[30];
                             DestAddr        : NetworkAddress;
                             DestDomain      : STRING[30];
                             Password        : STRING[8];
                             ProductName     : STRING[30];
                             PktVersionMajor : WORD;
                             PktVersionMinor : WORD;
                       END;

TYPE Type2000MsgHeader = RECORD
                               Id          : ARRAY[1..3] OF CHAR; {Must always be "P2K"}
                               OrigAddr    : NetworkAddress;
                               DestAddr    : NetworkAddress;
                               WrittenAddr : NetworkAddress;
                               Year        : WORD;
                               Month       : BYTE;
                               Day         : BYTE;
                               Hour        : BYTE;
                               Min         : BYTE;
                               Sec         : BYTE;
                               Sec100      : BYTE;
                               Attribute   : BYTE; {1 - IsFileAttached
                                                    2 - IsFileRequest
                                                    3 - IsPrivate
                                                    4 - IsCrash}
                               SeenBys     : WORD;
                               Paths       : WORD;
                               TextBytes   : LONGINT;
                               CharSet     : STRING[25];
                               TimeZone    : STRING[5];
                         END;

VAR InFile : FILE;
    Search : SearchRec;

FUNCTION ShowString (Len : BYTE; VAR S) : STRING;

TYPE A = ARRAY[0..255] OF BYTE;

VAR Out : STRING;
    Lp  : BYTE;
    L   : BYTE;

BEGIN
     Out:='"'+STRING (S)+'"';

     L:=Len;
     WHILE (L > 0) AND (A(S)[L] = 0) DO
           Dec (L);

     IF (L > A(S)[0]) THEN
     BEGIN
          Out:=Out+' [';

          FOR Lp:=0 TO L DO
              Out:=Out+Byte2HexString (A(S)[Lp])+' ';

          Out:=Out+']';
     END;

     IF (Len <> A(S)[0]) THEN
        Out:=Out+' (rest 00)';

     ShowString:=Out;
END;


FUNCTION ShowAka (Aka : NetworkAddress) : STRING;
BEGIN
     ShowAka:=Word2String (Aka.Zone)+':'+
              Word2String (Aka.Net)+'/'+
              Word2String (Aka.Node)+'.'+
              Word2String (Aka.Point);
END;


PROCEDURE DumpInBytes (Count : LONGINT);

CONST LINELEN = 19;

VAR Buf : ARRAY[1..LINELEN] OF BYTE;
    BR  : WORD;
    Lp  : BYTE;
    Out : STRING;

BEGIN
     REPEAT
           IF (Count > LINELEN) THEN
              BlockRead (InFile,Buf[1],LINELEN,BR)
           ELSE
               BlockRead (InFile,Buf[1],Count,BR);

           IF (BR > 0) THEN
           BEGIN
                Dec (Count,BR);

                Out:='';

                FOR Lp:=1 TO BR DO
                    Out:=Out+Byte2HexString (Buf[Lp])+' ';

                FOR Lp:=BR+1 TO LINELEN DO
                    Out:=Out+'   ';

                FOR Lp:=1 TO BR DO
                    IF (Char (Buf[Lp]) IN [' '..'~']) THEN
                       Out:=Out+Char (Buf[Lp])
                    ELSE
                        Out:=Out+'.';

                WriteLn (Output,'  '+Out);
           END;
     UNTIL (Count = 0) OR (BR = 0);

     IF (Count <> 0) THEN
        WriteLn (Output,'** ERROR: Could not read all bytes');
END;


FUNCTION ReadOpenString (Name : STRING) : BOOLEAN;

VAR Len   : BYTE;
    Regel : STRING;
    BR    : WORD;

BEGIN
     ReadOpenString:=FALSE; { assume failure }

     BlockRead (InFile,Len,1,BR);
     IF (BR <> 1) THEN
     BEGIN
          WriteLn (Output,'** ERROR: Failed to read string length');
          Exit;
     END;

     IF (Len = 0) THEN
     BEGIN
          WriteLn (Output,'  '+AddUpWithSpaces (14,Name+':'),'(empty)');
          ReadOpenString:=TRUE; { ok }
          Exit;
     END;

     BlockRead (InFile,Regel[1],Len,BR);
     IF (BR <> Len) THEN
     BEGIN
          WriteLn (Output,'** ERROR: Failed to read string');
          Exit;
     END;

     Regel[0]:=Char (Len);
     WriteLn (Output,'  '+AddUpWithSpaces (14,Name+':'),ShowString (Len,Regel));

     ReadOpenString:=TRUE;
END;


PROCEDURE DumpAkas (Count : WORD);

VAR AKA : NetworkAddress;
    L   : BYTE;
    BR  : WORD;
    Out : STRING;

BEGIN
     Write ('  ');
     L:=2;

     IF (Count = 0) THEN
     BEGIN
          WriteLn (Output,'(empty)');
          Exit;
     END;

     WHILE (Count > 0) DO
     BEGIN
          Dec (Count);
          BlockRead (InFile,Aka,SizeOf (NetworkAddress),BR);
          IF (BR <> SizeOf (NetworkAddress)) THEN
          BEGIN
               WriteLn ('** ERROR: Failed to read entire record');
               Exit;
          END;

          Out:=AddUpWithSpaces (18,ShowAka (Aka));
          IF (L + Length (Out) > 78) THEN
          BEGIN
               WriteLn;
               Write ('  ');
               L:=2;
          END;

          Write (Out);
          Inc (L,Length (Out));
     END; { while }

     WriteLn;
END;

PROCEDURE Dump;

VAR P2KHeader   : Type2000Header;
    MsgHeader   : Type2000MsgHeader;
    BytesRead   : WORD;
    ExtraFields : WORD;

BEGIN
     WriteLn ('Filename:  '+Search.Name);
     WriteLn ('File size: ',FileSize (InFile));
     WriteLn;

     BlockRead (InFile,P2KHeader,SizeOf (Type2000Header),BytesRead);

     IF (BytesRead <> SizeOf (Type2000Header)) THEN
     BEGIN
          WriteLn (Output,'** ERROR: Failed to read main header');
          Exit;
     END;

     WITH P2KHeader DO
     BEGIN
          WriteLn (Output,'Main header at offset 0');
          WriteLn (Output,'  Id:              "',Id[1],Id[2],Id[3],'"');
          IF (Id[1] <> 'P') OR (Id[2] <> '2') OR (Id[3] <> 'K') THEN
          BEGIN
               WriteLn (Output,'** ERROR: Wrong Id');
               Exit;
          END;

          Write (Output,'  MainHeaderLen:   ',MainHeaderLen);
          IF (MainHeaderLen <> SizeOf (Type2000Header)) THEN
             WriteLn (Output,' ('+Integer2String (MainHeaderLen-SizeOf (Type2000Header))+' bytes)')
          ELSE
              WriteLn (Output,' (expected)');

          IF (MainHeaderLen < SizeOf (Type2000Header)) THEN
          BEGIN
               WriteLn ('** ERROR: Main header is too short');
               Exit;
          END;

          Write (Output,'  SubHeaderLen:    ',SubHeaderLen);
          IF (SubHeaderLen <> SizeOf (Type2000MsgHeader)) THEN
             WriteLn (Output,' ('+Integer2String (SubHeaderLen-SizeOf (Type2000MsgHeader))+' bytes)')
          ELSE
              WriteLn (Output,' (expected)');

          IF (SubHeaderLen < SizeOf (Type2000MsgHeader)) THEN
          BEGIN
               WriteLn ('** ERROR: Sub header is too short');
               Exit;
          END;

          WriteLn (Output,'  OrigAddr:        ',ShowAka (OrigAddr));
          WriteLn (Output,'  OrigDomain:      ',ShowString (30,OrigDomain));
          WriteLn (Output,'  DestAddr:        ',ShowAka (DestAddr));
          WriteLn (Output,'  DestDomain:      ',ShowString (30,DestDomain));
          WriteLn (Output,'  Password:        ',ShowString (8,Password));
          WriteLn (Output,'  ProductName:     ',ShowString (30,ProductName));
          WriteLn (Output,'  PktVersionMajor: ',PktVersionMajor);
          WriteLn (Output,'  PktVersionMinor: ',PktVersionMinor);

          IF (PktVersionMajor <> 2000) OR (PktVersionMinor < 100) THEN
          BEGIN
               WriteLn ('This version is not supported');
               Exit;
          END;

          { make sure we have read MainHeaderLen bytes }
          IF (MainHeaderLen > SizeOf (Type2000Header)) THEN
          BEGIN
               WriteLn (Output,'  Additional bytes: ');
               DumpInBytes (MainHeaderLen-SizeOf (Type2000Header));
          END;
     END; { with }

     { dump the packed message headers as long as we do not reach }
     { the end of the file.                                       }

     WHILE (FilePos (InFile) <> FileSize (InFile)) DO
     BEGIN
          WriteLn (Output);
          WriteLn (Output,'Msg header at offset ',FilePos (InFile));

          BlockRead (InFile,MsgHeader,SizeOf (Type2000MsgHeader),BytesRead);
          IF (BytesRead <> SizeOf (Type2000MsgHeader)) THEN
          BEGIN
               WriteLn (Output,'** ERROR: Failed to read message header');
               Exit;
          END;

          WITH MsgHeader DO
          BEGIN
               WriteLn (Output,'  Id:          "',Id[1],Id[2],Id[3],'"');
               IF (Id[1] <> 'P') OR (Id[2] <> '2') OR (Id[3] <> 'K') THEN
               BEGIN
                    WriteLn ('** ERROR: Wrong Id');
                    Exit;
               END;

               WriteLn (Output,'  OrigAddr:    ',ShowAka (OrigAddr));
               WriteLn (Output,'  DestAddr:    ',ShowAka (DestAddr));
               WriteLn (Output,'  WrittenAddr: ',ShowAka (WrittenAddr));
               Write (Output,'  Year:        ',Year);
               IF (Year < 1980) OR (Year > 2100) THEN
                  WriteLn (' (out of range)')
               ELSE
                   WriteLn;

               IF (Year < 1980) THEN
                  WriteLn (Output,'** ERROR: Year is < 1980; defeats P2K use!');

               Write (Output,'  Month:       ',Month);
               IF (Month < 1) OR (Month > 12) THEN
                  WriteLn (' (out of range)')
               ELSE
                   WriteLn;

               Write (Output,'  Day:         ',Day);
               IF (Day < 1) OR (Day > 31) THEN
                  WriteLn (' (out of range)')
               ELSE
                   WriteLn;

               Write (Output,'  Hour:        ',Hour);
               IF (Hour > 23) THEN
                  WriteLn (' (out of range)')
               ELSE
                   WriteLn;

               Write (Output,'  Min:         ',Min);
               IF (Min > 59) THEN
                  WriteLn (' (out of range)')
               ELSE
                   WriteLn;

               Write (Output,'  Sec:         ',Sec);
               IF (Sec > 59) THEN
                  WriteLn (' (out of range)')
               ELSE
                   WriteLn;

               WriteLn (Output,'  Sec100:      ',Sec100);
               WriteLn (Output,'  Attribute:   ',Attribute);
               WriteLn (Output,'  SeenBys:     ',SeenBys);
               WriteLn (Output,'  Paths:       ',Paths);
               WriteLn (Output,'  TextBytes:   ',TextBytes);
               WriteLn (Output,'  CharSet:     ',ShowString (25,CharSet));
               WriteLn (Output,'  TimeZone:    ',ShowString (5,TimeZone));
          END; { with }

          { make sure we have read SubHeaderLen bytes }
          IF (P2KHeader.SubHeaderLen > SizeOf (Type2000MsgHeader)) THEN
          BEGIN
               WriteLn (Output,'  Additional bytes: ');
               DumpInBytes (P2KHeader.SubHeaderLen-SizeOf (Type2000Header));
          END;

          WriteLn (Output);
          WriteLn (Output,'Open Strings:');

          IF (NOT ReadOpenString ('ReplyTo')) THEN
             Exit;

          IF (NOT ReadOpenString ('MsgId')) THEN
             Exit;

          IF (NOT ReadOpenString ('From')) THEN
             Exit;

          IF (NOT ReadOpenString ('To')) THEN
             Exit;

          IF (NOT ReadOpenString ('Subject')) THEN
             Exit;

          IF (NOT ReadOpenString ('EchoArea')) THEN
             Exit;

          IF (NOT ReadOpenString ('Organization')) THEN
             Exit;

          WriteLn (Output);

          BlockRead (InFile,ExtraFields,2);
          WriteLn ('  ExtraFields:  ',ExtraFields);

          FOR BytesRead:=1 TO ExtraFields DO
              IF (NOT ReadOpenString ('ExtraField'+Word2String (BytesRead))) THEN
                 Exit;

          WriteLn (Output);
          WriteLn (Output,'SEEN-BYs:');
          DumpAkas (MsgHeader.SeenBys);

          WriteLn (Output);
          WriteLn (Output,'PATHs:');
          DumpAkas (MsgHeader.Paths);

          WriteLn (Output);
          WriteLn ('Body text:');
          DumpInBytes (MsgHeader.TextBytes);
     END; { while }

     WriteLn (Output);
     WriteLn (Output,'Reached end of file');
END;


VAR IORes : BYTE;

BEGIN
     WriteLn ('DumpP2K v1.00 - 980809');
     WriteLn ('Written by Ramon van der Winkel');
     WriteLn;

     Assign (Output,'');
     Rewrite (Output);

     FindFirst ('*.P2K',$3F,Search);
     WHILE (DosError = 0) DO
     BEGIN
          Assign (InFile,Search.Name);
          {$I-} Reset (InFile,1); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               WriteLn (Output,'Error opening ',Search.Name,' (Error ',IORes,')');
               WriteLn (Output);
          END ELSE
          BEGIN
               Dump;
               Close (InFile);
          END;

          FindNext (Search);
     END;
END.
