PROGRAM DECIPHER; { deciphers electronic mail file }
 {$K-}

 {DECIPHER   Myfile.TEL   Myfile.COM : second file optional}

 {Version 2.0 1987 February 2 by Roedy Green}

 {Please direct comments for improvement of this public domain program to:}
 {Roedy Green}
 {Canadian Mind Products}
 {#11 - 2856 Sunset Street}
 {Burnaby, BC}
 {CANADA  V5G 1T3}
 {telephone (604) 435-2957}
 {Envoy/Bix id: ROEDY}

 TYPE charint = -1..255;
         {-1 indicates end of file}
      mystring = STRING[64];
         {variable length strings}
      runint = 0..97;
         {integer used to count repeating chars}

 VAR Before : TEXT [ 8192 {blocksize} ];
        {input file contain no weird chars}
     After : TEXT [ 8192 {blocksize} ];
     c : charint;
        { current char from Before file }
     done : Boolean;
        { true after main body of Before file is processed -- after hit ^c }
     CheckSum : integer;
        { used to ensure no chars in the file were garbled. }
     origfilnam : myString;
       { original filename used to encipher the Before file }
     Deciphering : BOOLEAN;
       { true if deciphering turned on.}
       { We do not encipher until after the ^c after the filename }
       { We encipher the body including the trailing ^c.}
       { We do not encipher the checksum }

PROCEDURE Beep;
     BEGIN {Beep}
     Sound(400);
     Delay(500);
     NoSound
     END; {Beep}

PROCEDURE Die;
     BEGIN {Die}
     Beep;
     {$I-}
     Close (Before);
     Close (After);
     {$I+}
     HALT(1)
     END; {Die}

PROCEDURE Garbled;
     BEGIN {Garbled}
     Writeln ('Input file ',ParamStr(1), ' is garbled.  Try retransmitting it.');
     Die
     END {Garbled};

 FUNCTION GetIt: charint; {get 1 character from Before file}
    VAR
    achar : char;
    c : charint;
  BEGIN {GetIt}
        REPEAT
            IF EOF(Before) THEN Garbled;
            read(Before,achar);
            IF Deciphering THEN c :=  159 - ord(achar)
            ELSE c := ord(achar);
        UNTIL c in [33 .. 126];  {totally ignore all non printing chars}
    CheckSum := CheckSum + c;
    GetIt := c
  END {GetIt};

PROCEDURE PutIt(c:charint) {emit 1 character to After file};
  BEGIN {PutIt}
        write(After, char(c));
  END {PutIt};

PROCEDURE ctrl(c:charint);   {analyse a ^ char string}
     BEGIN
     CASE C OF
          96: { grave }
              putit(127);
          97: { a }
              putit(160);
          98: { b }
              putit(46);  { . }
          99: { c }
              done := true;
        ELSE
              putit(c-64)
      END {CASE}
  END {ctrl};

 PROCEDURE decompress(c:charint);   {emit a run of c's}
    VAR
    I : runint;
     BEGIN {decompress}
     FOR I := 1 TO GETIT-30 DO putit(c);
     END {decompress};

 PROCEDURE GetHeader;
     { bypass junk before first ^c, ensure this is an ENCIPHERED file}
     { grab the original filename }
     { file to decode has the following form:}
     { junk...^cENCIPHER\sub\file.xxx^c...body...^cNNNN^c }
     { where NNNN is the CheckSum starting with the letters ENCIPHER }
     { up to and including the ^c just prior to the CheckSum }
     Var
     I : runint;
     BEGIN {GetHeader}
         {scan for ^c}
         REPEAT
             REPEAT
             UNTIL GetIt = 94 {^};
         UNTIL GetIt = 99 {c};
         CheckSum := 0; {nothing prior to ENCIPHER counts in CheckSum}
         {check for letters ENCIPHER}
         IF Char(GetIt) <> 'E' THEN Garbled;
         IF Char(GetIt) <> 'N' THEN Garbled;
         IF Char(GetIt) <> 'C' THEN Garbled;
         CASE Char(GetIt) OF
                'I' : { nothing all is ok };
                'O' :
                    BEGIN
                    Writeln('Oops! Use DECODE instead');
                    Die
                    END;
                'R' :
                    BEGIN
                    Writeln('Oops! Use DECRYPT instead');
                    Die
                    END
              ELSE Garbled
              END {CASE};
         IF Char(GetIt) <> 'P' THEN Garbled;
         IF Char(GetIt) <> 'H' THEN Garbled;
         IF Char(GetIt) <> 'E' THEN Garbled;
         IF Char(GetIt) <> 'R' THEN Garbled;
         c := Getit;
         origfilnam := '';
         WHILE c <> 94 {^} DO
            BEGIN
            origfilnam := concat(origfilnam, char(c));
            c := getit
            END; {WHILE}
       IF GetIt <> 99 {c} THEN Garbled
       {next char to get will be first char of body}
END; {GetHeader}

PROCEDURE GetTrailer;
     VAR ExpectedCheckString : STRING[5];
     BEGIN {GetTrailer}
         Deciphering := FALSE; {turn off after ^c}
         {save CheckSum because GetIt continues to change it}
         {get 4 digits with leading 0's}
         Str(ABS(CheckSum MOD 10000) + 10000 :5, ExpectedCheckString);
         Delete(ExpectedCheckstring,1,1); {remove leading 1}
         IF GetIt <> ord(ExpectedCheckstring[1]) THEN Garbled;
         IF GetIt <> ord(ExpectedCheckstring[2]) THEN Garbled;
         IF GetIt <> ord(ExpectedCheckstring[3]) THEN Garbled;
         IF GetIt <> ord(ExpectedCheckstring[4]) THEN Garbled
         {ignore the ^c on the end}
     END; {GetTrailer}


BEGIN {DECPIPHER}
    if NOT (ParamCount in [1 .. 2]) THEN
        BEGIN
        writeln('Oops! usage:   DECIPHER   Myfile.TEL   Myfile.COM');
        Die
        END;
    Assign (Before, ParamStr(1));
    {$I-} {ensure no crash on cantopen}
    Reset(Before);
    IF IORESULT <> 0 THEN
       BEGIN
       Writeln('Oops! Cannot find file ',Paramstr(1));
       Die
       END;
    done := false;
    CheckSum := 0;
    Deciphering := FALSE;
    GetHeader;
    Deciphering := TRUE;
    IF ParamCount = 2 THEN OrigFilNam := ParamStr(2);
    IF Paramstr(1) = OrigFilNam THEN
       BEGIN
       Writeln
       ('Oops! Cannot have the same name for the input and output files');
       Die
       END;
    Assign (After, OrigFilNam);
    Rewrite(After);
    IF IORESULT <> 0 THEN
       BEGIN
       Writeln('Oops! Cannot create file ',OrigFilNam,
          ' -- probably no such subdirectory');
       Die
       END;
    {$I+}
    WriteLn('Decipher 2.0 creating ', OrigfilNam);
            REPEAT
            c := GetIt;
            CASE c OF 34, 36, 40..58, 61, 63..90, 97..122, 124 :
                    BEGIN
                    { leave-alone }
                    putit(c);
                    END;
               59 : { ; }
                    BEGIN
                    {Cr Lf}
                    putit(13);
                    putit(10)
                    END;
               94:  { ^ hat }
                    { ^c marks done }
                    ctrl(getit);
               33:  { ! }
                    putit(getit);
               39:  { '  tick }
                    putit(64+getit);
               96:  { ` grave }
                    putit(128+getit);
               92:  { \ backslash solidus }
                    putit(0);
              126:  { ~ tilde }
                    BEGIN
                    { create double null }
                    putit(0);
                    putit(0)
                    end;
              35 :  { # sharp }
                    decompress(0 { null } );
              38 :  { & }
                    putit(32 {space});
              60 :  { < }
                    BEGIN
                    putit(32 {space});
                    putit(32 {space});
                    END;
              62 :  decompress(32 { space } );
             123 :  { left curly }
                    BEGIN
                    putit( 48 {'0'});
                    putit( 48 {'0'})
                    END;
             125 :  { right curly }
                    decompress(48 { zero } );
              37 :  { % }
                    putit(255);
              91 :  { [ }
                    BEGIN
                    putit(255);
                    putit(255);
                    END;
              93 :  { ] }
                    decompress(255 { hex FF } );
             ELSE   { Cr Lfs or other chars added by Envoy}
                    { ignore them they dont even count in the CheckSum }
                    { they are filtered out by GetIt }
                    { canthappen }
                    BEGIN
                    Writeln('Invalid char ',c);
                    Die
                    END
               END; {CASE}
     UNTIL Done;
     GetTrailer;
     Close (Before);
     Close (After);
END {DECIPHER}.