(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)
MODULE MultiMail IN Oberon; (** portable *) (* ejz, *)
IMPORT Files, Objects, Texts, Oberon, Strings, Fonts, Base64, NetTools, MIME, Mail, Links, Gadgets, Lists,
Streams, TextStreams;
VAR
W: Texts.Writer;
PROCEDURE SearchText(text: Texts.Text; CONST pat: ARRAY OF CHAR; VAR pos: SIGNED32): BOOLEAN;
CONST
MaxPatLen = 128;
VAR
i, l, sPatLen: SIZE;
R: Texts.Reader;
sPat: ARRAY MaxPatLen OF CHAR;
sDv: ARRAY MaxPatLen + 1 OF SIGNED16;
ch: CHAR;
PROCEDURE CalcDispVec;
VAR i, j, d: SIGNED32;
BEGIN
i := 1; d := 1;
WHILE i <= sPatLen DO
j := 0;
WHILE (j + d < sPatLen) & (sPat[j] = sPat[j + d]) DO
INC(j)
END;
WHILE i <= j + d DO
sDv[i] := SHORT(d); INC(i)
END;
INC(d)
END
END CalcDispVec;
BEGIN
COPY(pat, sPat);
sPatLen := Strings.Length(sPat);
CalcDispVec();
IF sPatLen > 0 THEN
Texts.OpenReader(R, text, pos);
Texts.Read(R, ch); INC(pos);
l := text.len; i := 0;
WHILE (i # sPatLen) & (pos <= l) DO
IF ch = sPat[i] THEN
INC(i);
IF i < sPatLen THEN
Texts.Read(R, ch); INC(pos)
END
ELSIF i = 0 THEN
Texts.Read(R, ch); INC(pos)
ELSE
i := i - sDv[i]
END
END
ELSE
i := -1
END;
RETURN i = sPatLen
END SearchText;
PROCEDURE Send*;
VAR
S: Mail.SMTPSession;
Sw: Streams.Stream;
server: Mail.ServerName;
email: Mail.AdrString;
cont: MIME.Content;
obj: Objects.Object;
text, mail, ascii: Texts.Text;
buf: Texts.Buffer;
list: Lists.List;
item: Lists.Item;
boundary: ARRAY 128 OF CHAR;
magStr, val: ARRAY 16 OF CHAR;
pos, magic: SIGNED32;
F: Files.File;
h: MIME.Header;
R: Texts.Reader;
ch: CHAR;
autoCc: BOOLEAN;
BEGIN
Texts.OpenWriter(W);
obj := Gadgets.FindObj(Gadgets.context, "body");
Links.GetLink(obj, "Model", obj);
text := obj(Texts.Text);
obj := Gadgets.FindObj(Gadgets.context, "files");
list := obj(Lists.List);
NEW(mail); Texts.Open(mail, "");
NEW(buf); Texts.OpenBuf(buf);
Mail.GetSetting("SMTP", server, FALSE); Mail.GetSetting("EMail", email, FALSE);
Mail.GetSetting("AutoCc", boundary, TRUE); Strings.StrToBool(boundary, autoCc);
(* gen boundary *)
magic := Oberon.Time(); boundary := "------------";
Strings.IntToStr(magic, magStr); Strings.Append(boundary, magStr);
(* mime header *)
Sw := TextStreams.OpenReader(text, 0);
MIME.ReadHeader(Sw, NIL, h, pos);
Texts.OpenReader(R, text, pos); Texts.Read(R, ch);
IF ((ch = Strings.CR) OR (ch = Strings.LF)) OR R.eot THEN
ch := Strings.CR;
WHILE (pos > 0) & ((ch = Strings.CR) OR (ch = Strings.LF)) DO
DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch)
END;
INC(pos); IF pos > text.len THEN pos := text.len END
END;
Texts.Save(text, 0, pos, buf); Texts.Append(mail, buf);
Texts.WriteLn(W);
Texts.WriteString(W, "X-Mailer: MultiMail for Oberon (ejz)"); Texts.WriteLn(W);
Texts.WriteString(W, "MIME-Version: 1.0"); Texts.WriteLn(W);
Texts.WriteString(W, 'Content-Type: multipart/mixed; boundary="');
Texts.WriteString(W, boundary); Texts.Write(W, 022X); Texts.WriteLn(W);
Texts.WriteLn(W);
Texts.WriteString(W, "This is a multi-part message in MIME format.");
Texts.WriteLn(W); Texts.WriteLn(W);
(* message *)
Texts.WriteString(W, "--"); Texts.WriteString(W, boundary);
Texts.WriteLn(W); Texts.Append(mail, W.buf);
Mail.GetSetting("ContType", val, TRUE);
NEW(cont); cont.typ := MIME.GetContentType("text/plain");
IF val[0] = "0" THEN
cont.encoding := MIME.EncBin
ELSIF val[0] = "1" THEN
cont.encoding := MIME.Enc8Bit
ELSIF val[0] = "2" THEN
cont.typ := MIME.GetContentType(MIME.OberonMime); cont.encoding := MIME.EncAsciiCoderC
ELSE
cont.encoding := MIME.EncAuto;
Mail.QueryContType(text, pos, cont)
END;
IF cont.encoding IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC, MIME.EncAsciiCoderCPlain} THEN
Texts.WriteString(W, "X-Content-Type: "); Texts.WriteString(W, MIME.OberonMime);
Texts.WriteLn(W); Texts.Append(mail, W.buf)
END;
Sw := TextStreams.OpenWriter(mail);
MIME.WriteISOMime(Sw, cont);
TextStreams.WriteLn(Sw); TextStreams.WriteLn(Sw);
IF cont.encoding IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC, MIME.EncAsciiCoderCPlain} THEN
IF cont.encoding IN {MIME.EncAsciiCoder, MIME.EncAsciiCoderC} THEN
MIME.WriteText(text, pos, text.len, Sw, cont, FALSE, TRUE)
END;
TextStreams.WriteString(Sw, Mail.OberonStart); TextStreams.WriteLn(Sw);
Mail.MakeAscii(text, pos, text.len, cont.encoding # MIME.EncAsciiCoder, ascii);
cont.typ := MIME.GetContentType("text/plain");
MIME.WriteText(ascii, 0, ascii.len, Sw, cont, FALSE, TRUE)
ELSE
Texts.OpenReader(R, text, pos); Texts.Read(R, ch); INC(pos);
WHILE ~R.eot & (ch <= " ") & (R.lib IS Fonts.Font) DO
Texts.Read(R, ch); INC(pos)
END;
DEC(pos);
MIME.WriteText(text, pos, text.len, Sw, cont, FALSE, TRUE)
END;
TextStreams.WriteLn(Sw); Sw.Flush(Sw);
(* attachments *)
pos := 0; ASSERT(~SearchText(text, boundary, pos));
NEW(text); item := list.items;
WHILE item # NIL DO
Texts.WriteString(W, "--"); Texts.WriteString(W, boundary); Texts.WriteLn(W);
Texts.WriteString(W, "Mime-Version: 1.0"); Texts.WriteLn(W);
Texts.WriteString(W, "Content-Type: application/octet-stream"); Texts.WriteLn(W);
Texts.WriteString(W, "Content-Transfer-Encoding: base64"); Texts.WriteLn(W);
Texts.WriteString(W, 'Content-Disposition: attachment; filename="');
Texts.WriteString(W, item.s); Texts.Write(W, 022X); Texts.WriteLn(W);
Texts.WriteLn(W); Texts.Append(mail, W.buf);
F := Files.Old(item.s);
IF F # NIL THEN
Texts.Open(text, ""); Base64.EncodeFile(F, text);
Texts.Save(text, 0, text.len, buf); Texts.Append(mail, buf);
pos := 0; ASSERT(~SearchText(text, boundary, pos));
Texts.WriteLn(W)
ELSE
Texts.OpenWriter(W);
Texts.WriteString(W, item.s); Texts.WriteString(W, " not found");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
RETURN
END;
item := item.next
END;
Texts.WriteString(W, "--"); Texts.WriteString(W, boundary); Texts.WriteString(W, "--"); Texts.WriteLn(W);
Texts.WriteLn(W); Texts.Append(mail, W.buf);
cont.typ := MIME.GetContentType("text/plain"); cont.encoding := MIME.EncBin;
Mail.OpenSMTP(S, server, email, Mail.DefSMTPPort);
IF S.res = NetTools.Done THEN
Texts.WriteString(W, "mailing "); Texts.Append(Oberon.Log, W.buf);
Mail.SendMail(S, mail, cont, autoCc);
Mail.CloseSMTP(S)
END;
Texts.WriteString(W, S.reply); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END Send;
END MultiMail.
MultiMail.Panel
System.Free MultiMail ~
