PROGRAM DECRYPT; { decrypts electronic mail file }
 {$K-}

 {DECRYPT   Keyfile.KEY  Myfile.TEL   Myfile.COM : third 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} ];
     Keyfile : FILE OF CHAR;
       {Not text file because contains embedded ctrl-z's}
     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 encrypt the Before file }

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

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

FUNCTION NextKey : CharInt;
    {produces a value for encrypting the next character}
    VAR
    achar : Char;
  BEGIN {NextKey}
    IF EOF(KeyFile) THEN
       BEGIN
       Writeln ('Warning!  Keyfile too short.',
        '  Perfect uncrackability not guaranteed');
       { No Beep as may be repeated }
       RESET(KeyFile);
       IF EOF(KeyFile) THEN
          BEGIN
          Writeln('Oops!  Keyfile is empty.');
          Close (KeyFile);
          Close (Before);
          Close (After);
          HALT(1)
          END
       END;
    read(keyfile,achar);
    NextKey := ord(achar)
  END; {NextKey}

PROCEDURE Garbled;
     BEGIN {Garbled}
     Writeln ('Input file ',ParamStr(2), ' 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);
            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};
   VAR
   achar : Char;
   BEGIN {PutIt}
     achar := char(c XOR NextKey); {descramble it}
     write (After, achar)
  END {PutIt};

PROCEDURE ctrl(c:charint);   {analyse a ^ letter 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 ENCRYPTed file}
     { grab the original filename }
     { file to decrypt has the following form:}
     { junk...^cENCRYPT\sub\file.xxx^c...body...^cNNNN^c }
     { where NNNN is the CheckSum starting with the letters ENCRYPT }
     { 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 ENCRYPT counts in CheckSum}
         {check for letters ENCRYPT}
         IF Char(GetIt) <> 'E' THEN Garbled;
         IF Char(GetIt) <> 'N' THEN Garbled;
         IF Char(GetIt) <> 'C' THEN Garbled;
         CASE Char(GetIt) OF
                'R' : { nothing all is ok };
                'O' :
                    BEGIN
                    Writeln('Oops! Use DECODE instead');
                    Die
                    END;
                'I' :
                    BEGIN
                    Writeln('Oops! Use DECIPHER instead');
                    Die
                    END
              ELSE Garbled
              END {CASE};
         IF Char(GetIt) <> 'Y' THEN Garbled;
         IF Char(GetIt) <> 'P' THEN Garbled;
         IF Char(GetIt) <> 'T' 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}
         {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 {DECRYPT}
    if NOT (ParamCount in [2 .. 3]) THEN
        BEGIN
        writeln('Oops! usage:   DECRYPT   Keyfile.KEY  Myfile.TEL   Myfile.COM');
        Die
        END;
    {$I-} {ensure no crash on cantopen}
    IF (Paramstr(1) = ParamStr(2)) THEN
       BEGIN
       Writeln
       ('Oops! The names of the key, input and output files must all be different');
       Die
       END;

    Assign (Keyfile, ParamStr(1));
    Reset(Keyfile);
    IF IORESULT <> 0 THEN
       BEGIN
       Writeln('Oops! Cannot find key file ',Paramstr(1));
       Die
       END;

    Assign (Before, ParamStr(2));
    Reset(Before);
    IF IORESULT <> 0 THEN
       BEGIN
       Writeln('Oops! Cannot find file ',Paramstr(2));
       Die
       END;
    done := false;
    CheckSum := 0;
    GetHeader;
    IF ParamCount = 3 THEN OrigFilNam := ParamStr(3);
    Assign (After, OrigFilNam);
    IF (Paramstr(1) = OrigFilNam)
       OR (Paramstr(2) = OrigFilNam) THEN
       BEGIN
       Writeln
       ('Oops! The names of the key, input and output files must all be different');
       Die
       END;

    Rewrite(After);
    IF IORESULT <> 0 THEN
       BEGIN
       Writeln('Oops! Cannot create file ', OrigFilNam,
          ' -- probably no such subdirectory');
       Die
       END;
    {$I+}
    WriteLn('Decrypt 2.0 creating file ',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 {DECRYPT}.