-- File:  MailScavenger.mesa
-- Last edited by Levin:   3-Sep-80 19:03:28

DIRECTORY
  AltoDefs USING [PageSize],
  AltoFileDefs USING [FilenameChars],
  CharIO USING [
    NumberFormat, PutChar, PutNumber, PutString],
  DiskKDDefs USING [CountFreeDiskPages],
  ImageDefs USING [BcdTime],
  InlineDefs USING [LowHalf],
  IODefs USING [
    CR, ESC, LineOverflow, NUL, ReadChar, ReadID, Rubout, SP, WriteChar, WriteDecimal,
    WriteLine, WriteString],
  SegmentDefs USING [
    AccessOptions, Append, DestroyFile, FileHandle, FileNameError, GetEndOfFile,
    LockFile, NewFile, NewFileOnly, OldFileOnly, PageNumber, Read, ReleaseFile,
    SetFileAccess, UnlockFile, Write],
  StreamDefs USING [
    AccessOptions, Append, CleanupDiskStream, CreateByteStream, DiskHandle,
    FileLength, GetPosition, IndexToPosition, Read, ReadBlock, SetPosition,
    StreamError, StreamPosition, Write, WriteBlock],
  StringDefs USING [AppendChar, AppendString, EqualString],
  SystemDefs USING [AllocatePages, FreePages],
  TimeDefs USING [AppendDayTime, UnpackDT];

MailScavenger: PROGRAM
  IMPORTS CharIO, DiskKDDefs, ImageDefs, InlineDefs, IODefs, SegmentDefs,
    StreamDefs, StringDefs, SystemDefs, TimeDefs =

  BEGIN

  mailFile: STRING _ [AltoFileDefs.FilenameChars];
  scratchFile: STRING = "MailScavenger.scratch$";

  mailF, scratchF: SegmentDefs.FileHandle;
  inS, outS: StreamDefs.DiskHandle;

  readFileAccess: SegmentDefs.AccessOptions = SegmentDefs.Read;
  writeFileAccess: SegmentDefs.AccessOptions = SegmentDefs.Write + SegmentDefs.Append;
  allFileAccess: SegmentDefs.AccessOptions = readFileAccess + writeFileAccess;

  readStreamAccess: StreamDefs.AccessOptions = StreamDefs.Read;
  writeStreamAccess: StreamDefs.AccessOptions = StreamDefs.Write + StreamDefs.Append;
  allStreamAccess: StreamDefs.AccessOptions = readStreamAccess + writeStreamAccess;

  pageSize: CARDINAL = AltoDefs.PageSize;

  changesMade: BOOLEAN;

  safetySlop: CARDINAL = 10;

  maxPlausibleChars: CARDINAL = 60000;
  absoluteLimit: CARDINAL = maxPlausibleChars + 1000;

  compactionMark: CHARACTER = 003C;

  Initialize: PROCEDURE RETURNS [goAhead: BOOLEAN] =
    BEGIN OPEN IODefs, SegmentDefs, StreamDefs;
    ENABLE Rubout => {goAhead _ FALSE; CONTINUE};
    pages: CARDINAL;
    WriteHerald[];
    DO
      WriteString["Mail file to scavenge: "L];
      mailFile.length _ 0;
      ReadID[mailFile ! LineOverflow => CONTINUE];
      FOR i: CARDINAL IN [0..mailFile.length) DO
	IF mailFile[i] = '. THEN EXIT;
	REPEAT
	  FINISHED =>
	    BEGIN
	    defaultExtension: STRING = ".mail"L;
	    StringDefs.AppendString[mailFile, defaultExtension];
	    WriteString[defaultExtension];
	    END;
	ENDLOOP;
      mailF _ NewFile[mailFile, readFileAccess !
		  FileNameError => {WriteLine["...can't be opened!"L]; LOOP} ];
      WriteChar[CR];
      EXIT
      ENDLOOP;
    pages _ GetEndOfFile[mailF].page + 1;
    IF pages + safetySlop > DiskKDDefs.CountFreeDiskPages[] THEN
      BEGIN
      WriteString["Sorry, but I will need a minimum of "]; WriteDecimal[pages];
      WriteString[" free disk pages before I can scavenge "]; WriteLine[mailFile];
      ReleaseFile[mailF];
      RETURN[FALSE]
      END;
    LockFile[mailF];
    inS _ CreateByteStream[mailF, readStreamAccess];
    BEGIN
    ENABLE FileNameError => CONTINUE;
    scratchF _ NewFile[scratchFile, allFileAccess, OldFileOnly];
    DestroyFile[scratchF];
    END;
    scratchF _ NewFile[scratchFile, allFileAccess, NewFileOnly];
    LockFile[scratchF];
    outS _ CreateByteStream[scratchF, allStreamAccess];
    changesMade _ FALSE;
    RETURN[TRUE]
    END;

  WriteHerald: PROCEDURE =
    BEGIN OPEN IODefs, TimeDefs;
    time: STRING _ [20];
    WriteString["Mail File Scavenger of "L];
    AppendDayTime[time, UnpackDT[ImageDefs.BcdTime[]]];
    WriteLine[time];
    WriteChar[CR];
    END;

  Scavenge: PROCEDURE =
    BEGIN OPEN CharIO, StreamDefs;
    inLength: StreamPosition = IndexToPosition[FileLength[inS]];
    stampStart: STRING = "*start*
"L;
    stampLength: CARDINAL = 8 + 2*(5+1) + 3 + 1;
    deletedFlag, seenFlag, markChar: CHARACTER;
    messageSize: CARDINAL;
    lastStampIsPrototype: BOOLEAN;
    ticksSinceLastMessage: BOOLEAN _ FALSE;
    messageNumber: CARDINAL _ 1;
    stampNumberFormat: NumberFormat =
      [base: 10, zerofill: TRUE, unsigned: TRUE, columns: 5];

    ScanForStartOfStamp: PROCEDURE RETURNS [found, eof: BOOLEAN] =
      BEGIN
      char, firstStampChar: CHARACTER;
      charCount: CARDINAL _ 0;
      firstStampChar _ stampStart[0];
      found _ eof _ FALSE;
      DO
	char _ inS.get[inS ! StreamError =>
			IF error = StreamAccess THEN GO TO endOfInput];
	IF char = compactionMark AND inS.endof[inS] THEN
	  {ReportCompactionMark[]; GO TO endOfInput};
	charCount _ charCount + 1;
	IF char ~= firstStampChar THEN
	  BEGIN
	  outS.put[outS, 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 _ inS.get[inS ! StreamError =>
			   IF error = StreamAccess THEN {eof _ TRUE; GO TO noMatch}];
	    IF char ~= stampStart[i] THEN GO TO noMatch;
	    REPEAT
	      noMatch =>
		BEGIN
		FOR j: CARDINAL IN [0..i) DO outS.put[outS, stampStart[j]]; ENDLOOP;
		IF eof THEN
		  BEGIN
		  IF char = compactionMark THEN ReportCompactionMark[]
		  ELSE outS.put[outS, char];
		  RETURN
		  END;
		outS.put[outS, char];
		END;
	      FINISHED => RETURN[TRUE, FALSE];
	    ENDLOOP;
	REPEAT
	  endOfInput => eof _ TRUE;
	ENDLOOP;
      END;

    TryToReadAStamp: PROCEDURE RETURNS [BOOLEAN] =
      BEGIN
      stampSize: CARDINAL;
      ok: BOOLEAN;

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

      IF StreamDefs.GetPosition[inS] + (stampLength-stampStart.length) >= inLength THEN
	RETURN[FALSE];
      [ok, messageSize] _ ReadANumber[];
      IF ~ok THEN RETURN[FALSE];
      IF inS.get[inS] ~= IODefs.SP THEN RETURN[FALSE];
      [ok, stampSize] _ ReadANumber[];
      IF ~ok OR stampSize ~= stampLength THEN RETURN[FALSE];
      IF inS.get[inS] ~= IODefs.SP THEN RETURN[FALSE];
      SELECT deletedFlag _ inS.get[inS] FROM
	'D, 'U => NULL;
	ENDCASE => RETURN[FALSE];
      SELECT seenFlag _ inS.get[inS] FROM
	'S, 'U => NULL;
	ENDCASE => RETURN[FALSE];
      IF (markChar _ inS.get[inS]) = IODefs.NUL THEN RETURN[FALSE];
      IF inS.get[inS] ~= IODefs.CR THEN RETURN[FALSE];
      RETURN[TRUE]
      END;

    OutputPrototypeStamp: PROCEDURE =
      BEGIN
      prototypeFlagsAndMark: STRING = "UUS"L;
      PutString[outS, stampStart];
      PutNumber[outS, 0, stampNumberFormat];
      PutChar[outS, IODefs.SP];
      PutNumber[outS, stampLength, stampNumberFormat];
      PutChar[outS, IODefs.SP];
      PutString[outS, prototypeFlagsAndMark];
      PutChar[outS, IODefs.CR];
      lastStampIsPrototype _ changesMade _ TRUE;
      ReportBogusStamp[];
      END;

    OutputRealStamp: PROCEDURE =
      BEGIN
      PutString[outS, stampStart];
      PutNumber[outS, messageSize, stampNumberFormat];
      PutChar[outS, IODefs.SP];
      PutNumber[outS, stampLength, stampNumberFormat];
      PutChar[outS, IODefs.SP];
      PutChar[outS, deletedFlag];
      PutChar[outS, seenFlag];
      PutChar[outS, markChar];
      PutChar[outS, IODefs.CR];
      lastStampIsPrototype _ FALSE;
      END;

    ReportCompactionMark: PROCEDURE =
      BEGIN
      CleanupAfterTicks[];
      changesMade _ TRUE;
      IODefs.WriteLine["Compaction mark removed."L];
      END;

    ReportBogusStamp: PROCEDURE =
      BEGIN
      CleanupAfterTicks[];
      WriteMessageNumber[];
      IODefs.WriteLine["reconstructing stamp information."L];
      END;

    ReportSizeChange: PROCEDURE [old, new: CARDINAL] =
      BEGIN OPEN IODefs;
      difference: CARDINAL = IF old > new THEN old-new ELSE new-old;
      CleanupAfterTicks[];
      WriteMessageNumber[];
      WriteString["existing count was "L];
      WriteDecimal[difference];
      WriteString[" byte"];
      IF difference ~= 1 THEN WriteChar['s];
      WriteString[" too "L];
      IF old > new THEN WriteLine["long."] ELSE WriteLine["short."];
      END;

    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;

    inS.reset[inS];
    IF inLength < stampStart.length THEN OutputPrototypeStamp[]
    ELSE
      BEGIN
      s: STRING _ [8 --stampStart.length--];
      THROUGH [0..stampStart.length) DO StringDefs.AppendChar[s, inS.get[inS]]; ENDLOOP;
      IF StringDefs.EqualString[s, stampStart] THEN
	IF TryToReadAStamp[] THEN OutputRealStamp[]
	ELSE OutputPrototypeStamp[]
      ELSE {OutputPrototypeStamp[]; inS.reset[inS]};
      END;
    DO
      OPEN StreamDefs;
      prevStampStart: StreamPosition _ GetPosition[outS] - stampLength;
      pos: StreamPosition;
      charsMoved: CARDINAL;
      stampFound, eof: BOOLEAN;
      [stampFound, eof] _ ScanForStartOfStamp[];
      charsMoved _ InlineDefs.LowHalf[(pos _ GetPosition[outS]) - prevStampStart];
      IF lastStampIsPrototype OR charsMoved ~= messageSize THEN
	BEGIN
	changesMade _ TRUE;
	IF ~lastStampIsPrototype THEN
	  ReportSizeChange[old: messageSize, new: charsMoved];
	SetPosition[outS, prevStampStart + stampStart.length];
	PutNumber[outS, charsMoved, stampNumberFormat];
	SetPosition[outS, pos];
	END;
      IF eof THEN EXIT;
      ReportProgress[];
      messageNumber _ messageNumber + 1;
      IF stampFound AND TryToReadAStamp[] THEN OutputRealStamp[]
      ELSE OutputPrototypeStamp[];
      ENDLOOP;
    Summarize[];
    END;

  Finalize: PROCEDURE =
    BEGIN OPEN IODefs, SegmentDefs;
    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 OPEN StreamDefs;
	  buffer: POINTER _ SystemDefs.AllocatePages[1];
	  eofPage: PageNumber;
	  eofByte: [0..2*pageSize];
	  WriteLine[" Yes"L];
	  CleanupDiskStream[outS];
	  [eofPage, eofByte] _ GetEndOfFile[scratchF];
	  inS.reset[outS];
	  inS.destroy[inS];
	  SetFileAccess[mailF, writeFileAccess];
	  inS _ outS;
	  outS _ CreateByteStream[mailF, writeStreamAccess];
	  WriteString["Copying..."L];
	  THROUGH [1..eofPage) DO
	    [] _ ReadBlock[inS, buffer, pageSize];
	    [] _ WriteBlock[outS, buffer, pageSize];
	    ENDLOOP;
	  THROUGH [0..eofByte) DO outS.put[outS, inS.get[inS]]; ENDLOOP;
	  SystemDefs.FreePages[buffer];
	  END;
	ENDCASE => {WriteLine[" No"L]; destroyScratchF _ FALSE};
      END
    ELSE
      BEGIN
      WriteString["I couldn't find anything wrong with "L];
      WriteLine[mailFile];
      END;
    UnlockFile[mailF];
    inS.destroy[inS];
    outS.destroy[outS];
    UnlockFile[scratchF];
    IF destroyScratchF THEN DestroyFile[scratchF]
    ELSE {WriteString[scratchFile]; WriteLine[" retained."L]};
    WriteLine["Done."L];
    END;

  -- Main program

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

  END.