-- Grapevine: Lily: message composition

-- [Indigo]<Grapevine>Lily>LilySend.mesa

-- Andrew Birrell  19-Oct-81 14:35:45

DIRECTORY
Answer		USING[ Block, MakeHeader ],
Ascii,
BodyDefs	USING[ maxRNameLength, RName, Timestamp ],
GlassDefs	USING[ Handle, TimeOut ],
HeapDefs,
Inline		USING[ COPY, LowHalf ],
LilyAccessDefs	USING[ Handle, Read ],
LilyCommandDefs	USING[ HelpSendOptions ],
LilyIODefs	USING[ AppendFromInput, Confirm ],
MailParse,
SendDefs,
String		USING[ AppendString, EquivalentString, StringBoundsFault ],
Storage		USING[ Node, Free ],
Time		USING[ Append, Current, Packed, Unpack ];

LilySend: PROGRAM
IMPORTS AnswerDefs: Answer, GlassDefs, HeapDefs, Inline, LilyCommandDefs,
        LilyAccessDefs, LilyIODefs, MailParse, SendDefs, String, Storage,
        Time
EXPORTS LilyCommandDefs =

BEGIN



-- Begin message reader/writer abstraction

-- Messages are constructed in Writers, then buffered in readers --

bLength: CARDINAL = 16 * 8 -- assumed to be multiple of 8 bytes --;
lastChar: CHARACTER = MailParse.endOfInput;

Writer: TYPE = POINTER TO WriterObj;

WriterObj: TYPE = RECORD[buffer: PACKED ARRAY [0..bLength) OF CHARACTER,
                      pos: CARDINAL _ 0,
                      length: CARDINAL _ 0,
                      obj: HeapDefs.WriterHandle ];

Reader: TYPE = POINTER TO ReaderObj;

ReaderObj: TYPE = RECORD[buffer: PACKED ARRAY [0..bLength) OF CHARACTER,
                      pos: CARDINAL _ 0,
                      length: CARDINAL _ 0,
                      maxlength: CARDINAL _ 0,
                      beyondEnd: CARDINAL _ 0,
                      obj: HeapDefs.ReaderHandle ];

GetWriter: PROC RETURNS[b: Writer] =
   BEGIN
   b _ Storage.Node[SIZE[WriterObj]];
   b.pos _ b.length _ 0;
   b.obj _ HeapDefs.HeapStartWrite[temp];
   END;


SubWrite: PROC[b: Writer] =
   BEGIN
   bWriteUnit: CARDINAL = bLength/8 -- words --;
   HeapDefs.HeapWriteData[b.obj,[@b.buffer, bWriteUnit]];
   b.pos _ b.pos - MIN[b.pos, bWriteUnit*2];
   Inline.COPY[from: @b.buffer + bWriteUnit, to: @b.buffer,
               nwords: bLength/2-bWriteUnit];
   END;

Append: PROC[b: Writer, s: STRING] =
   BEGIN
   FOR i: CARDINAL IN [0..s.length)
   DO IF b.pos = bLength THEN SubWrite[b];
      b.buffer[b.pos] _ s[i]; b.pos _ b.pos+1;
   ENDLOOP;
   b.length _ b.length + s.length;
   END;

AppendC: PROC[b: Writer, c: CHARACTER] =
   BEGIN
   IF c = lastChar THEN RETURN;
   IF b.pos = bLength THEN SubWrite[b];
   b.buffer[b.pos] _ c; b.pos _ b.pos+1; b.length _ b.length + 1;
   END;

Unwrite: PROC[b: Writer] RETURNS[prev: CHARACTER] =
   BEGIN
   IF b.pos > 0
   THEN { b.pos _ b.pos-1; b.length _ b.length-1; prev _ b.buffer[b.pos] }
   ELSE prev _ lastChar;
   END;

Peek: PROC[b: Writer, str: GlassDefs.Handle] =
   BEGIN
   -- type last few chars from writer; we have "b.pos" of them available --
   OPEN str;
   -- we want up to 30 characters ... --
   wanted: CARDINAL _ 30;
   -- ... but can only show as many as we have buffered ... --
   IF b.pos < wanted THEN wanted _ b.pos;
   -- ... and don't want more than one line ... --
   FOR i: CARDINAL DECREASING IN [b.pos-wanted..b.pos)
   DO IF i+10 < b.pos -- ... unless the line is very short --
      AND b.buffer[i] = Ascii.CR
      THEN { wanted _ b.pos - i - 1; EXIT };
   ENDLOOP;
   IF b.length > wanted --there will be non-shown chars--
   AND ( b.pos <= wanted --we don't know preceding chars--
       OR b.buffer[b.pos-wanted-1] # Ascii.CR --more chars on this line-- )
   THEN WriteString["..."L];
   FOR i: CARDINAL IN [ b.pos-wanted .. b.pos )
   DO WriteChar[b.buffer[i]] ENDLOOP;
   END;

AbandonWriter: PROC[b: Writer] =
   BEGIN
   HeapDefs.HeapAbandonWrite[b.obj];
   Storage.Free[b];
   END;

SubRead: PROC[r: Reader] =
   BEGIN
   IF r.pos MOD 2 # 0 THEN ERROR;
   IF r.pos > bLength/2
   THEN BEGIN
        Inline.COPY[from: @r.buffer+bLength/8, to: @r.buffer,
                    nwords: bLength/2 - bLength/8];
        r.pos _ r.pos - bLength/4;
        END;
   [] _ HeapDefs.HeapReadData[r.obj,
                [@r.buffer + r.pos/2, (MIN[r.length,bLength-r.pos]+1)/2]];
   END;

GetReader: PROC[b: Writer] RETURNS[r: Reader] =
   BEGIN
   Accept: PROC[obj: HeapDefs.ObjectNumber] =
      { r.obj _ HeapDefs.HeapStartRead[obj] };
   WHILE b.pos > 0 DO SubWrite[b] ENDLOOP;
   r _ Storage.Node[SIZE[ReaderObj]];
   r.maxlength _ b.length;
   HeapDefs.HeapEndWrite[b.obj, Accept];
   Storage.Free[b];
   ResetReader[r];
   END;

ResetReader: PROC[r: Reader] =
   BEGIN
   HeapDefs.SetReaderOffset[r.obj, HeapDefs.objectStart];
   r.pos _ 0; r.length _ r.maxlength;
   IF r.length > 0 THEN SubRead[r];
   r.beyondEnd _ 0;
   END;

Read: PROC[r: Reader] RETURNS[c: CHARACTER] =
   BEGIN
   IF r.length = 0
   THEN { r.beyondEnd _ r.beyondEnd+1; RETURN[lastChar] };
   IF r.pos = bLength THEN SubRead[r];
   c _ r.buffer[r.pos]; r.pos _ r.pos+1; r.length _ r.length-1;
   END;

Unread: PROC[r: Reader] =
   BEGIN
   IF r.beyondEnd > 0
   THEN r.beyondEnd _ r.beyondEnd-1
   ELSE IF r.pos > 0
        THEN { r.pos _ r.pos-1; r.length _ r.length+1 }
        ELSE NULL -- error --;
   END;

AbandonReader: PROC[r: Reader] =
   BEGIN
   HeapDefs.HeapEndRead[r.obj];
   Storage.Free[r];
   END;

-- End of message reader/writer abstraction:  should be moved to
-- separate Defs file someday





AppendToWriter: PROC[str: GlassDefs.Handle, b: Writer,
                     prompt: STRING, peekFirst: BOOLEAN _ TRUE]
             RETURNS[end: CHARACTER] =
   BEGIN
   OPEN str;
   MyWrite: PROC[c: CHARACTER] = { AppendC[b,c] };
   MyUnwrite: PROC RETURNS[CHARACTER] = { RETURN[ Unwrite[b] ] };
   WriteString[prompt];
   WriteString[" (ESC to terminate):"L];
   WriteChar[Ascii.CR]; IF peekFirst THEN Peek[b, str];
   DO end _ LilyIODefs.AppendFromInput[str, ReadChar[],
                                       MyWrite, MyUnwrite, any];
      IF end = Ascii.ControlR THEN Peek[b, str] ELSE EXIT;
   ENDLOOP;
   END;

LowerCase: PROC[c: CHARACTER] RETURNS[CHARACTER] = INLINE
   { RETURN[ IF c IN ['A..'Z] THEN 'a + (c-'A) ELSE c ] };

Find: PROC[ pattern: STRING,
            r: Reader,
            w: Writer ]
      RETURNS[ match: BOOLEAN ] =
   BEGIN
   pPos: CARDINAL _ 0;
   pBase: CARDINAL _ 0;
   literal: BOOLEAN _ FALSE;
   char: CHARACTER _ Read[r];
   DO SELECT TRUE FROM
        pPos = pattern.length => { match _ TRUE; Unread[r]; EXIT };
        char = lastChar => { match _ FALSE; EXIT };
        literal => NULL;
        pattern[pPos] = '' => { pPos_pPos+1; literal _ TRUE; LOOP };
        pattern[pPos] = '* => { pPos_pPos+1; pBase_pPos; LOOP };
      ENDCASE => NULL;
      IF LowerCase[pattern[pPos]] # LowerCase[char]
      THEN pPos _ pBase
      ELSE pPos _ pPos+1;
      literal _ FALSE; AppendC[w, char]; char _ Read[r];
   ENDLOOP;
   END;

Edit: PROC[str: GlassDefs.Handle, r: Reader] RETURNS[ new: Reader ] =
   BEGIN
   OPEN str;
   b: Writer _ GetWriter[];
   BEGIN
      ENABLE UNWIND => AbandonWriter[b];
      DO ENABLE GlassDefs.TimeOut => GOTO timeOut;
         pattern: STRING = [128];
         WriteChar[Ascii.CR];
         IF ReadString["Find pattern (ESC to terminate): "L,
                       pattern, any] = Ascii.DEL THEN GOTO del;
         IF pattern.length = 0 THEN EXIT;
         WriteString[" ... "L]; SendNow[];
         IF Find[pattern, r, b]
         THEN BEGIN
              WriteChar[Ascii.CR];
              IF AppendToWriter[str, b, "New text"L] = Ascii.DEL
              THEN GOTO del;
              END
         ELSE { WriteString["not found"L]; EXIT };
      REPEAT
         del => { AbandonWriter[b]; str.WriteString[" XXX"L]; RETURN[r] };
         timeOut => { WriteChar[Ascii.CR]; WriteString["*** time-out"L] };
      ENDLOOP;
   END;
   CopyToWriter[r, b];
   AbandonReader[r]; new _ GetReader[b];
   END;

CopyToWriter: PROC[r: Reader, b: Writer] =
   BEGIN
   DO c: CHARACTER = Read[r];
      IF c = lastChar THEN EXIT;
      AppendC[b,c];
   ENDLOOP;
   END;

AppendText: PROC[str: GlassDefs.Handle, r: Reader, prompt: STRING]
     RETURNS[ new: Reader ] =
   BEGIN
   OPEN str;
   b: Writer _ GetWriter[];
   CopyToWriter[r,b];
   BEGIN
      [] _ AppendToWriter[str, b, prompt, FALSE !
           UNWIND => AbandonWriter[b]; GlassDefs.TimeOut => GOTO timeOut];
   EXITS timeOut => { WriteChar[Ascii.CR]; WriteString["*** time-out"L] };
   END;
   AbandonReader[r]; new _ GetReader[b];
   END;

Type: PROC[str: GlassDefs.Handle, r: Reader] =
   BEGIN
   OPEN str;
   WriteChar[Ascii.CR];
   DO c: CHARACTER = Read[r];
      IF c = lastChar THEN EXIT;
      IF DelTyped[] THEN EXIT;
      WriteChar[c];
   ENDLOOP;
   END;

ReallySend: PROC[str: GlassDefs.Handle, r: Reader,
                 user, password: STRING ]
         RETURNS[ ok: BOOLEAN ] =
   BEGIN
   OPEN str;
   sHandle: SendDefs.Handle = SendDefs.Create[];
   senderNeeded: BOOLEAN _ FALSE;
   arpaHostNeeded: BOOLEAN _ FALSE;
   SendNow[];
   BEGIN
      ENABLE
        BEGIN
        SendDefs.SendFailed =>
          { WriteString["server failure: retrying .. "L]; RETRY };
        UNWIND => SendDefs.Destroy[sHandle];
        END;
      pHandle: MailParse.ParseHandle;
      ReadInput: PROC RETURNS[ c: CHARACTER ] =
         { RETURN[Read[r] ] };
      Backup: PROC =
         { Unread[r] };
      info: SendDefs.StartSendInfo = SendDefs.StartSend[handle: sHandle,
                senderPwd: password, sender: user, validate: TRUE];
      ok _ TRUE;
      IF DelTyped[] THEN GOTO del;
      SELECT info FROM
        badPwd =>
          { WriteString["incorrect password"L]; GOTO bad };
        badSender =>
          { WriteString["invalid user name"L]; GOTO bad };
        allDown =>
          { WriteString["can't contact any mail server"L]; GOTO bad };
        ok =>
          NULL;
      ENDCASE => ERROR;
      pHandle _ MailParse.InitializeParse[ReadInput, Backup, FALSE];
      IF ok        -- parse to find recipients --
      THEN BEGIN
           ENABLE
             BEGIN
             MailParse.ParseError => GOTO badHeader;
             UNWIND => MailParse.FinalizeParse[pHandle];
             END;
           field: STRING = [MailParse.maxFieldNameSize];
           registry: STRING = [BodyDefs.maxRNameLength];
           WriteString["parsing ... "L]; SendNow[];
           AppendRegistry[registry, user];
           WHILE MailParse.GetFieldName[pHandle, field]
           DO SELECT TRUE FROM
                String.EquivalentString[field, "cc"L],
                String.EquivalentString[field, "to"L] =>
                   BEGIN
                   ProcessName: PROC[sn, na, arpa: STRING,
                                     info: MailParse.NameInfo]
                                RETURNS[ BOOLEAN ] =
                      BEGIN
                      ENABLE String.StringBoundsFault => GOTO tooLong;
                      recipient: BodyDefs.RName = [BodyDefs.maxRNameLength];
                      String.AppendString[recipient, sn];
                      IF arpa.length > 0
                      THEN BEGIN
                           arpaHostNeeded _ TRUE;
                           IF na.length > 0
                           THEN BEGIN
                                String.AppendString[recipient, "."L];
                                String.AppendString[recipient, na];
                                END;
                           String.AppendString[recipient, "@"L];
                           String.AppendString[recipient, arpa];
                           String.AppendString[recipient, ".ArpaGateway"L];
                           END
                      ELSE BEGIN
                           String.AppendString[recipient, "."L];
                           String.AppendString[recipient,
                             IF na.length = 0 THEN registry ELSE na];
                           END;
                      SendDefs.AddRecipient[sHandle, recipient];
                      RETURN[ TRUE ]
                      EXITS tooLong =>
                         BEGIN
                         WriteChar[Ascii.CR];
                         WriteString["Recipient name too long: "L];
                         WriteString[sn];
                         IF na.length >0
                         THEN { WriteChar['.]; WriteString[na] };
                         IF arpa.length > 0
                         THEN { WriteChar['@]; WriteString[arpa] };
                         ok _ FALSE;
                         RETURN[TRUE];
                         END;
                      END;
                   MailParse.ParseNameList[pHandle, ProcessName];
                   END;
              ENDCASE =>
                BEGIN
                fieldBody: STRING = [BodyDefs.maxRNameLength--or so--];
                MailParse.GetFieldBody[pHandle, fieldBody];
                SELECT TRUE FROM
                  String.EquivalentString[field, "Date"L],
                  String.EquivalentString[field, "Sender"L] =>
                    BEGIN
                    ok _ FALSE;
                    WriteChar[Ascii.CR]; WriteString[field];
                    WriteString[" not allowed; Lily will provide it"L];
                    END;
                  String.EquivalentString[field, "From"] =>
                    senderNeeded _ TRUE;
                ENDCASE => NULL;
                END;
           ENDLOOP;
           EXITS badHeader =>
              IF ok
              THEN BEGIN
                   ok _ FALSE;
                   WriteChar[Ascii.CR];
                   WriteString["Syntax error in header"L];
                   END;
           END;
      MailParse.FinalizeParse[pHandle];
      IF ok        -- validate recipients --
      THEN BEGIN
           Notify: PROC[n: CARDINAL, who: BodyDefs.RName] =
              BEGIN
              ok _ FALSE;
              WriteChar[Ascii.CR];
              WriteString["Invalid recipient: "L];
              WriteString[who];
              END;
           IF DelTyped[] THEN GOTO del;
           IF SendDefs.CheckValidity[sHandle, Notify] = 0 AND ok
           THEN BEGIN
                ok _ FALSE;
                WriteChar[Ascii.CR];
                WriteString["No valid recipients"L];
                END;
           END;
      IF ok        -- send text and commit --
      THEN BEGIN
           wsBuffer: STRING = [64] --must be even--;
           ws: PROCEDURE[s: STRING] =
              BEGIN
              FOR index: CARDINAL IN [0..s.length)
              DO wc[s[index]] ENDLOOP;
              END;
           wc: PROC[c: CHARACTER] = INLINE
              BEGIN
              IF wsBuffer.length = wsBuffer.maxlength THEN FlushWS[];
              wsBuffer[wsBuffer.length] _ c;
              wsBuffer.length _ wsBuffer.length + 1;
              END;
           FlushWS: PROC =
              BEGIN
              SendDefs.AddToItem[sHandle,
                          DESCRIPTOR[@(wsBuffer.text), wsBuffer.length] ];
              wsBuffer.length _ 0;
              END;
           wt: PROCEDURE[t: Time.Packed] =
              BEGIN
              s: STRING = [30];
              Time.Append[s, Time.Unpack[t], TRUE];
              ws[s];
              END;
           cr: STRING = "
"L;
           WriteString["sending ... "L]; SendNow[];
           SendDefs.StartText[sHandle];
           ws[IF senderNeeded THEN "Sender: "L ELSE "From: "L]; ws[user];
           IF arpaHostNeeded THEN ws[" @ PARC-MAXC"L];
           ws[cr];
           ws["Date: "L]; wt[Time.Current[]]; ws[cr];
           ResetReader[r];
           DO c: CHARACTER = Read[r];
              IF c = lastChar THEN EXIT;
              wc[c];
           ENDLOOP;
           FlushWS[];
           IF DelTyped[] THEN GOTO del;
           SendDefs.Send[sHandle];
           WriteString["sent"L];
           END;
   EXITS
      bad => ok _ FALSE;
      del => { ok _ FALSE; Flush[]; WriteString[" delivery cancelled"L] };
   END;
   SendDefs.Destroy[sHandle];
   END;

AppendRegistry: PROC[reg, user: STRING] =
   BEGIN
   pos: CARDINAL _ user.length;
   WHILE pos > 0
   DO IF user[pos-1] = '. THEN EXIT;
      pos _ pos-1;
   ENDLOOP;
   WHILE pos < user.length AND reg.length < reg.maxlength
   DO reg[reg.length] _ user[pos]; pos _ pos+1;
      reg.length _ reg.length+1;
   ENDLOOP;
   END;

SendOptions: PROC[str: GlassDefs.Handle, r: Reader, user, password: STRING] =
   BEGIN
   OPEN str;
   DO ENABLE UNWIND => AbandonReader[r];
      BEGIN
         ENABLE GlassDefs.TimeOut => GOTO noChars;
         ResetReader[r];
         WriteChar[Ascii.CR];
         WriteString["Option: "L];
         SELECT LowerCase[ReadChar[]] FROM
           'a => { WriteString["Append"L]; SendNow[];
                   r _ AppendText[str,r," extra text"L] };
           'e => { WriteString["Edit"L]; r _ Edit[str, r] };
           'h => { WriteString["Help"L]; LilyCommandDefs.HelpSendOptions[str] };
           'q => { WriteString["Quit without sending"L];
                   IF LilyIODefs.Confirm[str] = yes THEN EXIT };
           's => BEGIN
                 WriteString["Send"L];
                 IF LilyIODefs.Confirm[str] = yes
                 AND ReallySend[str, r, user, password]
                 THEN EXIT;
                 END;
           't => { WriteString["Type"L]; Type[str, r] };
            Ascii.DEL => GOTO del
         ENDCASE =>
           BEGIN
           WriteChar['?]; WriteChar[Ascii.CR];
           WriteString["Options are: Append, Edit, Help, Quit, Send, Type"L];
           END;
         IF DelTyped[] THEN GOTO del;
         EXITS
         noChars =>
            BEGIN
            WriteChar[Ascii.CR];
            WriteString["Type any character to continue sending ... "L];
            [] _ ReadChar[ ! GlassDefs.TimeOut => GOTO going ];
            EXITS going => { WriteString["abandoned sending"L]; EXIT }
            END;
         del => { Flush[]; WriteString[" XXX"L] };
      END;
   ENDLOOP;
   AbandonReader[r];
   END;

HeaderItem: PROC[str: GlassDefs.Handle, b: Writer, name: STRING]
      RETURNS[ notDel: BOOLEAN ] =
   BEGIN
   OPEN str;
   s: STRING = [128];
   WriteChar[Ascii.CR];
   IF ReadString[name, s, line] = Ascii.DEL
   THEN { WriteString[" XXX"L]; notDel _ FALSE }
   ELSE BEGIN
        notDel _ TRUE;
        IF s.length # 0
        THEN { Append[b, name]; Append[b, s]; AppendC[b, Ascii.CR] };
        END;
   END;

SendOrForward: PROC[ str: GlassDefs.Handle, old: Reader,
                     user, password: STRING ] =
  
   BEGIN
   OPEN str;
   b: Writer = GetWriter[];
   BEGIN
      ENABLE
         BEGIN
         GlassDefs.TimeOut => GOTO timeOut;
         UNWIND => { AbandonWriter[b]; IF old#NIL THEN AbandonReader[old] };
         END;
      IF HeaderItem[str, b, "Subject: "L]
      AND HeaderItem[str, b, "To: "L]
      AND HeaderItem[str, b, "cc: "L]
      THEN BEGIN
           AppendC[b, Ascii.CR]; WriteChar[Ascii.CR];
           [] _ AppendToWriter[str, b,
                   IF old=NIL THEN "Message"L ELSE "Covering note"L, FALSE];
           END
      ELSE BEGIN
           AbandonWriter[b]; IF old#NIL THEN AbandonReader[old];
           RETURN -- user didn't really want to send anything! --
           END;
   EXITS timeOut => { WriteChar[Ascii.CR]; WriteString["*** time-out"L] };
   END;
   IF old#NIL
   THEN BEGIN
        Append[b, "

----------

"L];
        CopyToWriter[old, b]; AbandonReader[old];
        END;
   SendOptions[str, GetReader[b], user, password];
   END;

Send: PUBLIC PROC[ str: GlassDefs.Handle, user, password: STRING ] =
   { SendOrForward[str, NIL, user, password] };

Forward: PUBLIC PROC[ str: GlassDefs.Handle, msg: LilyAccessDefs.Handle,
                      user, password: STRING ] =
   BEGIN
   b: Writer = GetWriter[];
   Copier: PROC[postmark: BodyDefs.Timestamp,
                sender: BodyDefs.RName,
                readChar: PROC RETURNS[CHARACTER],
                backup: PROC] =
      BEGIN
      DO c: CHARACTER = readChar[];
         IF c = lastChar THEN EXIT;
         AppendC[b,c];
      ENDLOOP;
      END;
   LilyAccessDefs.Read[msg, Copier ! UNWIND => AbandonWriter[b]];
   SendOrForward[str, GetReader[b], user, password];
   END;

CopyHeader: PROC[msg: LilyAccessDefs.Handle]
          RETURNS[r: Reader, length: CARDINAL] =
   BEGIN
   b: Writer = GetWriter[];
   Copier: PROC[postmark: BodyDefs.Timestamp,
                sender: BodyDefs.RName,
                readChar: PROC RETURNS[CHARACTER],
                backup: PROC] =
      BEGIN
      cr: BOOLEAN _ FALSE;
      DO c: CHARACTER = readChar[];
        -- terminate on double CR's --
         IF c = lastChar
         THEN { IF NOT cr THEN { AppendC[b, Ascii.CR]; length_length+1 };
                AppendC[b, Ascii.CR]; length_length+1; EXIT };
         AppendC[b,c]; length_length+1;
         IF c = Ascii.CR
         THEN{ IF cr THEN EXIT ELSE cr _ TRUE }
         ELSE cr _ FALSE;
      ENDLOOP;
      END;
   length _ 0;
   LilyAccessDefs.Read[msg, Copier ! UNWIND => AbandonWriter[b]];
   r _ GetReader[b];
   END;

Answer: PUBLIC PROC[ str: GlassDefs.Handle, msg: LilyAccessDefs.Handle,
                     user, password: STRING ] =
   BEGIN
   OPEN str;
   old: Reader;
   oldLength: CARDINAL;
   oldPos: CARDINAL _ 0;
   GetChar: PROC[n: CARDINAL] RETURNS[CHARACTER] =
      BEGIN
      IF oldPos # n
      THEN BEGIN
           ResetReader[old];
           THROUGH [0..n) DO [] _ Read[old] ENDLOOP;
           oldPos _ n;
           END;
      oldPos _ oldPos+1;
      RETURN[ Read[old] ]
      END;
   GetPages: PROC[n: CARDINAL] RETURNS[ LONG POINTER ] =
      { RETURN[ Storage.Node[n*256] ] };
   FreePages: PROC[ p: LONG POINTER ] =
      { Storage.Free[ Inline.LowHalf[p] ] };
   arpaHosts: ARRAY[0..3) OF STRING _ ["PARC-MAXC"L, "PARC"L, "MAXC"L];
   w: Writer;
   PutBlock: PROC[block: AnswerDefs.Block] =
      BEGIN
      FOR i: CARDINAL IN [0..block.length)
      DO AppendC[w, block.buffer[i]] ENDLOOP;
      END;
   userSN: STRING = [64];
   userReg: STRING = [64];
   dotPos: CARDINAL _ 0;
   FOR i: CARDINAL DECREASING IN [0..user.length)
   DO IF user[i] = '. THEN { dotPos _ i; EXIT } ENDLOOP;
   FOR i: CARDINAL IN [0..dotPos)
   DO userSN[i] _ user[i] ENDLOOP;
   userSN.length _ dotPos;
   FOR i: CARDINAL IN (dotPos..user.length)
   DO userReg[i-dotPos-1] _ user[i] ENDLOOP;
   userReg.length _ user.length-dotPos-1;
   WriteString["parsing ... "L]; SendNow[];
   [old, oldLength] _ CopyHeader[msg];
   w _ GetWriter[];
   IF AnswerDefs.MakeHeader[GetChar, oldLength, PutBlock,
                        GetPages, FreePages, userSN, userReg,
                        DESCRIPTOR[arpaHosts] !
              UNWIND => { AbandonReader[old]; AbandonWriter[w] }]
   THEN BEGIN
        ENABLE UNWIND => AbandonWriter[w];
        AbandonReader[old];
        WriteString["syntax error in message - can't answer it"L];
        END
   ELSE BEGIN
        new: Reader;
        AbandonReader[old];
        new _ GetReader[w];
        BEGIN
           ENABLE UNWIND => AbandonReader[new];
           WriteString["ok"L];
           Type[str, new]; ResetReader[new];
           new _ AppendText[str, new, "Reply"L];
        END;
        SendOptions[str, new, user, password];
        END;
   END;

END.