-- 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.