-- Mail file patcher

-- MailFilePatchImpl.mesa

-- Andrew Birrell  11-Mar-82 10:52:41

DIRECTORY
Ascii,
GlassDefs,
MailParse,
Segments	USING[ FileNameProblem ],
Streams,
String;

MailFilePatchImpl: PROGRAM
   IMPORTS GlassDefs, MailParse, Segments, Streams, String =

BEGIN

DoIt: PROC[str: GlassDefs.Handle] =
   BEGIN
   OPEN str;
   file: STRING = [99];
   DO IF ReadString["Mail file name: "L, file, word] = Ascii.DEL
      THEN EXIT
      ELSE BEGIN
           FOR i: CARDINAL DECREASING IN [0..file.length)
           DO IF file[i] = '. THEN EXIT;
           REPEAT FINISHED =>
             { WriteString[".mail"L]; String.AppendString[file, ".mail"L] };
           ENDLOOP;
           WriteString[" ..."L];
           WriteChar[Ascii.CR];
           IF Patch[str, file] THEN EXIT;
           END;
      WriteChar[Ascii.CR];
   ENDLOOP;
   WriteString["Done"L]; WriteChar[Ascii.CR];
   END;
      
Patch: PROC[str: GlassDefs.Handle, file: STRING] RETURNS[ok: BOOLEAN] =
   BEGIN
   OPEN str;
   stream: Streams.Handle = Streams.NewStream[
      name: file, access: Streams.ReadWrite ! Segments.FileNameProblem[] =>
      GOTO badFile ];
   ParseFile[str, stream !
             BadMailFile =>
               { WriteString["Bad mail file - run MailFileScavenger.laurel then re-run this program"L]; CONTINUE };
             UNWIND => Streams.Destroy[stream] ];
   Streams.Destroy[stream];
   ok _ TRUE;
   EXITS badFile =>
      { WriteString[" ... """L];
        WriteString[file];
        WriteString[""" doesn't exist"L];
        ok _ FALSE }
   END;

BogusNumber: ERROR = CODE;
BadMailFile: ERROR = CODE;

ParseStamp: PROCEDURE [NextChar: PROC RETURNS [CHARACTER]] RETURNS [offsetToHeader, textLength: CARDINAL] =
BEGIN
startOfStamp: STRING = "*start*
"L;
i, j: CARDINAL;

ReadFive: PROCEDURE RETURNS [k: CARDINAL] =
  BEGIN
  char: CHARACTER;
  k _ 0;
  THROUGH [0 .. 5) DO
    IF (char _ NextChar[]) ~IN ['0..'9] THEN ERROR BogusNumber;
    k _ k * 10 + (char - '0);
    ENDLOOP;
  END;  -- of ReadFive --

FOR i IN [0 .. 8) DO IF startOfStamp[i]#NextChar[] THEN GOTO notAStamp; ENDLOOP;

i _ ReadFive[ ! BogusNumber => GOTO notAStamp];
IF NextChar[] # Ascii.SP THEN GOTO notAStamp;
j _ ReadFive[ ! BogusNumber => GOTO notAStamp];
IF NextChar[] # Ascii.SP THEN GOTO notAStamp;

SELECT NextChar[] FROM
  'D => NULL;
  'U => NULL;
  ENDCASE => GOTO notAStamp;

SELECT NextChar[] FROM
  'S => NULL;
  'U => NULL;
  ENDCASE => GOTO notAStamp;

offsetToHeader _ j;
IF i < j THEN GOTO notAStamp;
textLength _ i - j;
[] _ NextChar[];
IF NextChar[] # Ascii.CR THEN GOTO notAStamp;

EXITS
notAStamp => ERROR BadMailFile[];
END; -- of ParseStamp --

repair: STRING = "Name-too-long@Probably-Berkeley"L;

ParseFile: PROC[str: GlassDefs.Handle, stream: Streams.Handle] =
   BEGIN
   OPEN str;
   ch: CHARACTER;
   Get: PROC RETURNS[CHARACTER] =
     { RETURN[ ch _ IF Streams.Ended[stream] THEN MailParse.endOfInput
                    ELSE Streams.GetChar[stream] ] };
   Backup: PROC =
     { Streams.SetIndex[stream, Streams.GetIndex[stream]-1] };
   ph: MailParse.ParseHandle = MailParse.InitializeParse[Get, Backup];
   FOR msg: CARDINAL IN [1..LAST[CARDINAL]]
   UNTIL Streams.Ended[stream]
   DO -- for each message --
      mStart: LONG CARDINAL = Streams.GetIndex[stream];
      offsetToHeader: CARDINAL;
      textLength: CARDINAL;
      [offsetToHeader, textLength] _ ParseStamp[Get];
      Streams.SetIndex[stream, mStart+offsetToHeader];
      BEGIN
        s: STRING = [99];
        WHILE MailParse.GetFieldName[ph, s ! MailParse.ParseError => EXIT ]
        DO IF String.EquivalentString[s, "From"L]
           THEN BEGIN
                fStart: LONG CARDINAL = Streams.GetIndex[stream];
                ProcessFrom: PROC[name, reg, host: STRING,
                                  ignored: MailParse.NameInfo]
                          RETURNS[BOOLEAN] =
                  BEGIN
                  total: CARDINAL _ name.length + reg.length + host.length;
                  IF reg.length > 0 THEN total _ total+1;
                  IF host.length > 0 THEN total _ total+1;
                  IF total > MailParse.maxRecipientLength
                  THEN -- Laurel bug! --
                       BEGIN
                       fEnd: LONG CARDINAL = Streams.GetIndex[stream];
                       Streams.SetIndex[stream, fStart];
                       IF fEnd < fStart + 2 + repair.length THEN ERROR;
                       Streams.PutChar[stream, Ascii.SP];
                       FOR i: CARDINAL IN [0..repair.length)
                       DO Streams.PutChar[stream, repair[i]] ENDLOOP;
                       WHILE Streams.GetIndex[stream]+1 < fEnd
                       DO Streams.PutChar[stream, Ascii.SP] ENDLOOP;
                       WriteString["Patched ""From"" field in message "L];
                       WriteDecimal[msg];
                       WriteString[":
	"""L];
                       WriteString[name];
                       IF reg.length # 0 THEN WriteChar['.];
                       WriteString[reg];
                       IF host.length # 0 THEN WriteChar['@];
                       WriteString[host];
                       WriteChar['"];
                       WriteChar[Ascii.CR];
                       END;
                  RETURN[FALSE]
                  END;
                MailParse.ParseNameList[ph, ProcessFrom !
                  MailParse.ParseError => CONTINUE];
                END
           ELSE MailParse.GetFieldBody[ph, s, TRUE !
                  MailParse.ParseError => CONTINUE];
        ENDLOOP;
      END;
      Streams.SetIndex[stream, mStart+offsetToHeader+textLength];
   ENDLOOP;
   MailParse.FinalizeParse[ph];
   END;

GlassDefs.Listen[DoIt];

END.