-- File:  MailFileScavenger.mesa
-- Last edited by Levin:   5-May-81 12:59:31

DIRECTORY
  AltoDefs USING [BytesPerPage],
  AltoFileDefs USING [FilenameChars],
  crD: FROM "CoreDefs" USING [
    CountAltoFreePages, DeleteFile, DMSUser, OpenFile, UFileHandle],
  csD: FROM "CoreStreamDefs" USING [
    Close, Destroy, Error, GetLength, GetPosition, OpenFromName, Position, Read,
    SetPosition, StreamCopy, StreamHandle, Write],
  ImageDefs USING [BcdTime],
  Inline USING [DIVMOD, LongDiv, LowHalf],
  IODefs USING [
    CR, ESC, LineOverflow, NUL, ReadChar, ReadID, Rubout, SP, WriteChar, WriteDecimal,
    WriteLine, WriteString],
  LaurelExecDefs USING [GetUserCredentials],
  ovD: FROM "OverviewDefs" USING [endOfStream],
  String USING [AppendString, StringBoundsFault],
  Time USING [Append, Unpack];

MailFileScavenger: PROGRAM
  IMPORTS crD, csD, ImageDefs, Inline, IODefs, LaurelExecDefs, String, Time =

  BEGIN


  -- Syntax of Messages:

  -- message ::= stamp message-body
  -- stamp ::= fixed-part variable-part
  -- fixed-part ::= sentinel cr counts space flags cr
  -- sentinel ::= <the 7-character ASCII literal *start*>
  -- counts ::= message-length space stamp-length
  -- message-length ::= stamp-number
  -- stamp-length ::= stamp-number
  -- flags ::= deleted-flag examined-flag mark-character
  -- deleted-flag ::= D | U
  -- examined-flag ::= S | U
  -- mark-character ::= <any non-NUL ASCII character>
  -- variable-part ::= <empty> | @ item-list @ optional-cr
  -- item-list ::= <empty> | item-list item
  -- item ::= item-header item-contents
  -- item-header ::= byte-length space item-type space
  -- byte-length ::= stamp-number
  -- item-type ::= stamp-number
  -- optional-cr ::= <empty> | cr
  -- item-contents ::= <sequence of 8-bit bytes>
  -- stamp-number ::= <5-character (leading zeroes) decimal number>
  -- space ::= <the ASCII space character 040C>
  -- cr ::= <the ASCII carriage return character, 015C>
  -- message-body ::= <sequence of 8-bit bytes, not necessarily ASCII>


  -- Semantics:

  -- Fixed-part:
  -- The message-length is the total number of characters in the stamp and
  -- message-body.  The stamp-length is the total number of characters in the stamp
  -- proper; thus, the number of characters in the message-body is message-length
  -- minus stamp-length.  From the syntax equations it is easy to see that the
  -- stamp-length will be 00024 if the variable-part is <empty>, 00026 or 00027 if
  -- the item-list is <empty>, and at least 00038 otherwise.  The deleted-flag must be
  -- either 'D or 'U (note:  lower case not allowed) and indicates if the message is
  -- logically Deleted or Undeleted.  The examined-flag must be either 'S or 'U (again,
  -- lower case is not permitted) and indicates if the message has been Seen or is
  -- Unseen.  The mark-character can be any non-NUL ASCII character.
  --
  -- Variable-part:
  -- The byte-length is the total number of characters in the item, including the
  -- item-header of which it is a part.  Thus, this number must always be at least
  -- 00012.  The item-type identifies the structure and semantics of the item-contents.
  -- Item types are issued by LaurelSupport and recorded in a central registry,
  -- [Juniper]<Grapevine>ItemRegistry.txt.
 
 

  -- Miscellaneous Constants --

  inBufferPages: CARDINAL = 3;
  outBufferPages: CARDINAL = 3;

  maxPlausibleChars: CARDINAL = 60000;
  absoluteLimit: CARDINAL = maxPlausibleChars + 2000;  -- leave room for editing

  safetySlop: CARDINAL = 10;


  -- Global Variables --

  mailFile: STRING _ [AltoFileDefs.FilenameChars+20];  -- hack: allow IFS file names
  scratchFile: STRING = "MailFileScavenger.scratch$";

  simpleName: STRING _ [25];
  password: STRING _ [25];
  registry: STRING _ [25];

  credentials: crD.DMSUser _ [name: simpleName, registry: registry, password: password];

  inS, outS: csD.StreamHandle;

  changesMade: BOOLEAN;


  -- Code --

  Initialize: PROCEDURE RETURNS [goAhead: BOOLEAN] =
    BEGIN OPEN IODefs;
    inPages, availablePages: CARDINAL;

    PagesInFile: PROCEDURE [s: csD.StreamHandle] RETURNS [pages: CARDINAL] =
      {RETURN[Inline.LongDiv[csD.GetLength[s], AltoDefs.BytesPerPage] + 2]};

    WriteHerald[];
    LaurelExecDefs.GetUserCredentials[simpleName, password, registry];
    DO
      WriteString["Mail file to scavenge: "L];
      mailFile.length _ 0;
      ReadID[mailFile ! LineOverflow => CONTINUE; Rubout => GO TO quit];
      FOR i: CARDINAL IN [0..mailFile.length) DO
	IF mailFile[i] = '. THEN EXIT;
	REPEAT
	  FINISHED =>
	    BEGIN
	    ENABLE String.StringBoundsFault => CONTINUE;
	    defaultExtension: STRING = ".mail"L;
	    String.AppendString[mailFile, defaultExtension];
	    WriteString[defaultExtension];
	    END;
	ENDLOOP;
      inS _ csD.OpenFromName[mailFile, credentials, byte, read, inBufferPages !
		  csD.Error => {WriteLine["...can't be opened!"L]; LOOP} ];
      EXIT
      ENDLOOP;
    WriteChar[CR];
    outS _ csD.OpenFromName[scratchFile, credentials, byte, overwrite, outBufferPages !
                csD.Error => GO TO noScratch];
    inPages _ PagesInFile[inS];
    availablePages _ PagesInFile[outS] + crD.CountAltoFreePages[];
    IF inPages + safetySlop > availablePages THEN
      BEGIN
      needed: CARDINAL = inPages + safetySlop - availablePages;
      WriteString["Sorry, but I will need a minimum of "L]; WriteDecimal[needed];
      WriteString[" more free disk pages before I can scavenge "L]; WriteLine[mailFile];
      csD.Destroy[inS];
      csD.Destroy[outS];
      RETURN[FALSE]
      END;
    changesMade _ FALSE;
    RETURN[TRUE];
    EXITS
      noScratch =>
        BEGIN
	WriteLine["Gleep!  I can't open my scratch file.  I give up..."L];
	csD.Destroy[inS];
	RETURN[FALSE]
	END;
      quit => RETURN[FALSE];
    END;

  WriteHerald: PROCEDURE =
    BEGIN OPEN IODefs;
    time: STRING _ [30];
    WriteString["Mail File Scavenger of "L];
    Time.Append[time, Time.Unpack[ImageDefs.BcdTime[]]];
    WriteLine[time];
    WriteChar[CR];
    END;

  Get: PROCEDURE RETURNS [CHARACTER] = INLINE {RETURN[csD.Read[inS]]};

  Put: PROCEDURE [char: CHARACTER] = INLINE {csD.Write[outS, char]};

  Backup: PROCEDURE = INLINE {csD.SetPosition[inS, csD.GetPosition[inS] - 1]};

  Scavenge: PROCEDURE =
    BEGIN
    inLength: csD.Position = csD.GetLength[inS];
    stampStart: STRING = "*start*
"L;
    fixedPartLength: CARDINAL = 8 + 2*(5+1) + 3 + 1;
    minItemLength: CARDINAL = 2*(5+1);
    stampSize, messageSize: CARDINAL;
    stampRepair: {none, rebuilt, size, variablePart, bodyLength};
    ticksSinceLastMessage: BOOLEAN _ FALSE;
    messageNumber: CARDINAL _ 1;

    CheckForInitialStamp: PROCEDURE RETURNS [found: BOOLEAN] =
      BEGIN
      IF inLength < stampStart.length THEN RETURN[FALSE];
      FOR i: CARDINAL IN [0..stampStart.length) DO
        IF Get[] ~= stampStart[i] THEN EXIT;
	REPEAT
	  FINISHED => RETURN[TRUE];
	ENDLOOP;
      csD.SetPosition[inS, 0];
      RETURN[FALSE]
      END;

    ScanForStartOfStamp: PROCEDURE RETURNS [found, eof: BOOLEAN] =
      BEGIN
      firstStampChar: CHARACTER = stampStart[0];
      charCount: CARDINAL _ 0;
      found _ eof _ FALSE;
      DO
	char: CHARACTER _ Get[ ! csD.Error =>
				    IF reason = ovD.endOfStream THEN {eof _ TRUE; EXIT}];
	charCount _ charCount + 1;
	IF char ~= firstStampChar THEN
	  BEGIN
	  Put[char];
	  SELECT charCount FROM
	    < maxPlausibleChars => NULL;
	    IN [maxPlausibleChars..absoluteLimit) =>
	      SELECT char FROM
		IODefs.CR, IN [200C..377C] => EXIT;
		ENDCASE => NULL;
	    ENDCASE => EXIT;
	  END
	ELSE
	  FOR i: CARDINAL IN [1..stampStart.length) DO
	    char _ Get[ ! csD.Error =>
			   IF reason = ovD.endOfStream THEN {eof _ TRUE; GO TO noMatch}];
	    IF char ~= stampStart[i] THEN GO TO noMatch;
	    REPEAT
	      noMatch =>
		BEGIN
		FOR j: CARDINAL IN [0..i) DO Put[stampStart[j]]; ENDLOOP;
		IF eof THEN RETURN;
		Put[char];
		charCount _ charCount + i + 1;
		END;
	      FINISHED => RETURN[TRUE, FALSE];
	    ENDLOOP;
	ENDLOOP;
      END;

    ParseAndOutputStamp: PROCEDURE =
      BEGIN
      deletedFlag, seenFlag, markChar: CHARACTER;
      itemLength, itemType: CARDINAL;

      ReadANumber: PROCEDURE RETURNS [ok: BOOLEAN, value: CARDINAL] =
	BEGIN
	value _ 0;
	THROUGH [0..5) DO
	  char: CHARACTER _ Get[];
	  IF char ~IN ['0..'9] THEN RETURN[FALSE, 0];
	  value _ value * 10 + (char - '0);
	  ENDLOOP;
	RETURN[TRUE, value]
	END;

      TryToReadFixedPart: PROCEDURE RETURNS [BOOLEAN] =
	BEGIN
	ok: BOOLEAN;
	IF csD.GetPosition[inS] + (fixedPartLength-stampStart.length) >= inLength THEN
	  RETURN[FALSE];
	[ok, messageSize] _ ReadANumber[];
	IF ~ok THEN RETURN[FALSE];
	IF Get[] ~= IODefs.SP THEN RETURN[FALSE];
	[ok, stampSize] _ ReadANumber[];
	IF ~ok THEN RETURN[FALSE];
	IF Get[] ~= IODefs.SP THEN RETURN[FALSE];
	SELECT deletedFlag _ Get[] FROM
	  'D, 'U => NULL;
	  ENDCASE => RETURN[FALSE];
	SELECT seenFlag _ Get[] FROM
	  'S, 'U => NULL;
	  ENDCASE => RETURN[FALSE];
	IF (markChar _ Get[]) = IODefs.NUL THEN RETURN[FALSE];
	IF Get[] ~= IODefs.CR THEN RETURN[FALSE];
	RETURN[TRUE]
	END;

      OutputFixedPart: PROCEDURE =
	BEGIN
	PutString[stampStart];
	PutNumberInStamp[messageSize]; Put[IODefs.SP];
	PutNumberInStamp[stampSize]; Put[IODefs.SP];
	Put[deletedFlag]; Put[seenFlag]; Put[markChar];
	Put[IODefs.CR];
	END;

      TryToReadItemHeader: PROCEDURE RETURNS [BOOLEAN] =
	BEGIN
	ok: BOOLEAN;
	IF csD.GetPosition[inS] + minItemLength >= inLength THEN RETURN[FALSE];
	[ok, itemLength] _ ReadANumber[];
	IF ~ok THEN RETURN[FALSE];
	IF Get[] ~= IODefs.SP THEN RETURN[FALSE];
	[ok, itemType] _ ReadANumber[];
	IF ~ok THEN RETURN[FALSE];
	IF Get[] ~= IODefs.SP THEN RETURN[FALSE];
	RETURN[TRUE]
	END;

      TryToReadVariablePart: PROCEDURE RETURNS [ok: BOOLEAN] =
	BEGIN
	probe: csD.Position _ csD.GetPosition[inS];
	DO
	  IF Get[ ! csD.Error => EXIT] = '@ THEN
	    {IF Get[ ! csD.Error => CONTINUE] ~= IODefs.CR THEN Backup[]; RETURN[TRUE]};
	  Backup[];
	  IF ~TryToReadItemHeader[] OR itemLength < minItemLength THEN EXIT;
	  IF (probe _ MIN[probe + itemLength, inLength]) = inLength THEN EXIT;
	  csD.SetPosition[inS, probe];
	  ENDLOOP;
	csD.SetPosition[inS, probe];
	RETURN[FALSE]
	END;

      BEGIN
      fixedPartStart: csD.Position _ csD.GetPosition[inS];
      msgStart, variablePartStart: csD.Position;
      newStampSize: CARDINAL;
      terminalAtSign: BOOLEAN;
      stampRepair _ none;
      IF ~TryToReadFixedPart[] THEN {OutputPrototypeStamp[]; RETURN};
      variablePartStart _ msgStart _ csD.GetPosition[inS];
      IF Get[! csD.Error => GO TO fixedPartOnly] ~= '@ THEN
        {Backup[]; GO TO fixedPartOnly};
      terminalAtSign _ TryToReadVariablePart[];
      msgStart _ csD.GetPosition[inS];
      newStampSize _ Inline.LowHalf[fixedPartLength + msgStart - variablePartStart];
      IF ~terminalAtSign THEN newStampSize _ newStampSize + 1;
      IF newStampSize ~= stampSize THEN
        {stampSize _ newStampSize; stampRepair _ size};
      OutputFixedPart[];
      csD.SetPosition[inS, variablePartStart];
      csD.StreamCopy[from: inS, to: outS, fromItems: msgStart - variablePartStart];
      IF ~terminalAtSign THEN {Put['@]; stampRepair _ variablePart};
      EXITS
	fixedPartOnly =>
	  BEGIN
	  IF stampSize ~= fixedPartLength THEN
	    {stampSize _ fixedPartLength; stampRepair _ size};
	  OutputFixedPart[];
	  END;
      END;
      END;

    OutputPrototypeStamp: PROCEDURE =
      BEGIN
      prototypeFlagsAndMark: STRING = "UUS"L;
      PutString[stampStart];
      PutNumberInStamp[messageSize _ 0]; Put[IODefs.SP];
      PutNumberInStamp[stampSize _ fixedPartLength]; Put[IODefs.SP];
      PutString[prototypeFlagsAndMark];
      Put[IODefs.CR];
      stampRepair _ rebuilt;
      END;

    PutNumberInStamp: PROCEDURE [n: CARDINAL] =
      BEGIN
      digits: STRING _ "00000"L;
      FOR i: CARDINAL DECREASING IN [0..5) UNTIL n = 0 DO
	rem: [0..9];
	[n, rem] _ Inline.DIVMOD[n, 10];
	digits[i] _ '0 + rem;
	ENDLOOP;
      PutString[digits];
      END;

    PutString: PROCEDURE [s: STRING] =
      {FOR i: CARDINAL IN [0..s.length) DO Put[s[i]] ENDLOOP};

    ReportProgress: PROCEDURE =
      BEGIN OPEN IODefs;
      IF messageNumber MOD 5 = 0 THEN
	BEGIN
	IF ticksSinceLastMessage THEN WriteChar[SP] ELSE ticksSinceLastMessage _ TRUE;
	WriteDecimal[messageNumber];
	END;
     END;

    CleanupAfterTicks: PROCEDURE =
      BEGIN OPEN IODefs;
      IF ticksSinceLastMessage THEN {WriteChar[CR]; ticksSinceLastMessage _ FALSE};
      END;

    Summarize: PROCEDURE =
      BEGIN OPEN IODefs;
      CleanupAfterTicks[];
      WriteDecimal[messageNumber];
      WriteString[" message"L];
      IF messageNumber ~= 1 THEN WriteChar['s];
      WriteLine[" processed."L];
      END;

    WriteMessageNumber: PROCEDURE =
      BEGIN OPEN IODefs;
      WriteString["Message "L];
      WriteDecimal[messageNumber];
      WriteString[": "L];
      END;

    stampFound: BOOLEAN _ CheckForInitialStamp[];
    DO
      prevStampStart, currentPos: csD.Position;
      charsMoved: CARDINAL;
      eof: BOOLEAN;
      IF stampFound THEN ParseAndOutputStamp[] ELSE OutputPrototypeStamp[];
      prevStampStart _ csD.GetPosition[outS] - stampSize;
      [stampFound, eof] _ ScanForStartOfStamp[];
      currentPos _ csD.GetPosition[outS];
      charsMoved _ Inline.LowHalf[currentPos - prevStampStart];
      IF stampRepair = none AND charsMoved ~= messageSize THEN stampRepair _ bodyLength;
      IF stampRepair ~= none THEN
	BEGIN OPEN IODefs;
	changesMade _ TRUE;
	CleanupAfterTicks[];
	WriteMessageNumber[];
	SELECT stampRepair FROM
	  size => WriteLine["correcting stamp length."L];
	  rebuilt => WriteLine["reconstructing stamp information."L];
	  variablePart => WriteLine["truncating malformed variable part of stamp."L];
	  bodyLength =>
	    BEGIN OPEN IODefs;
	    difference: CARDINAL =
	      IF messageSize > charsMoved THEN messageSize - charsMoved
	      ELSE charsMoved - messageSize;
	    WriteString["existing count was "L];
	    WriteDecimal[difference];
	    WriteString[" byte"L];
	    IF difference ~= 1 THEN WriteChar['s];
	    WriteString[" too "L];
	    IF messageSize > charsMoved THEN WriteLine["long."L]
	    ELSE WriteLine["short."L];
	    END;
	  ENDCASE;
	IF charsMoved ~= messageSize THEN
	  BEGIN
	  csD.SetPosition[outS, prevStampStart + stampStart.length];
	  PutNumberInStamp[charsMoved];
	  csD.SetPosition[outS, currentPos];
	  END;
	END;
      IF eof THEN EXIT;
      ReportProgress[];
      messageNumber _ messageNumber + 1;
      ENDLOOP;
    Summarize[];
    END;

  Finalize: PROCEDURE =
    BEGIN OPEN IODefs;
    char: CHARACTER;
    destroyScratchF: BOOLEAN _ TRUE;
    WriteChar[CR];
    IF changesMade THEN
      BEGIN
      WriteString["Scavenging complete into "L]; WriteLine[scratchFile];
      WriteString["Shall I copy it back to "L]; WriteString[mailFile]; WriteChar['?];
      char _ ReadChar[];
      SELECT char FROM
	CR, 'Y, 'y, ESC =>
	  BEGIN
	  WriteLine[" Yes"L];
	  csD.Close[inS]; csD.Close[outS];
	  inS _ csD.OpenFromName[scratchFile, credentials, byte, read, inBufferPages];
	  outS _ csD.OpenFromName[mailFile, credentials, byte, overwrite, outBufferPages];
	  WriteString["Copying..."L];
	  csD.StreamCopy[from: inS, to: outS, fromItems: csD.GetLength[inS]];
	  END;
	ENDCASE => {WriteLine[" No"L]; destroyScratchF _ FALSE};
      END
    ELSE {WriteString["I couldn't find anything wrong with "L]; WriteLine[mailFile]};
    csD.Close[inS]; csD.Close[outS];
    IF destroyScratchF THEN
      BEGIN
      file: crD.UFileHandle;
      [ , file] _ crD.OpenFile[credentials, scratchFile, update];
      [] _ crD.DeleteFile[file];
      END
    ELSE {WriteString[scratchFile]; WriteLine[" retained."L]};
    WriteLine["Done."L];
    END;

  -- Main program

  IF Initialize[] THEN {Scavenge[]; Finalize[]};
  IODefs.WriteChar[IODefs.CR];

  END.