Oberon/A2/Oberon.MIME.Mod

< Oberon‎ | A2
(* 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 MIME IN Oberon; (** portable *)
	IMPORT Streams, TextStreams, Files, Dates, Strings, Fonts, Texts, Display, Display3,
		Objects, Attributes, Gadgets, BasicFigures, Out, Oberon;

	CONST
		BufLen = 1024;
		MaxLine = BufLen-1;
		MaxSMTPLine = 1000;
		MimeVersion* = "Mime-Version: 1.0";
		TextMime* = "text/plain"; ISOVer* = "ISO-8859-1";
		OberonMime* = "application/compressed/oberon";
		EncAuto* = -1; EncBin* = 0; Enc8Bit* = 1; Enc7Bit* = 2; EncQuoted* = 3; EncBase64* = 4; EncAsciiCoder* = 5;
		EncAsciiCoderC* = 6; EncAsciiCoderCPlain* = 7;
		ContEncQuoted* = "Content-Transfer-Encoding: quoted-printable"; (* EncQuoted *)
		ContEnc7Bit* = "Content-Transfer-Encoding: 7bit"; (* Enc7Bit *)
		ContEnc8Bit* = "Content-Transfer-Encoding: 8bit"; (* EncBin, Enc8Bit*)
		ContEncBase64* = "Content-Transfer-Encoding: Base64"; (* EncBase64 *)

	TYPE
		OpenString* = POINTER TO ARRAY OF CHAR;
		Header* = POINTER TO HeaderDesc;
		HeaderDesc* = RECORD
			fields*: OpenString
		END;
	(** A list of the mime content-types supported.
			The mime-types supported by Oberon are described in the "MIME" section of oberon.ini.
			The syntax of a mime entry is:

				mimedef = mime "=" [ suffix [ prefix ] ] .

				mime	The mime type, e.g: "text/html", "image/gif", ...
				suffix	Suffix to be used for temporary files.
				prefix	Prefix to be used for temporary files .
					e.g. "c:/temp/" writes the temporary files in the c:/temp directory *)
		ContentType* = POINTER TO ContentTypeDesc;
		ContentTypeDesc* = RECORD
			typ*: ARRAY 32 OF CHAR;
			subTyp*: ARRAY 64 OF CHAR;
			suffix*: ARRAY 8 OF CHAR;
			prefix*: ARRAY 128 OF CHAR;
			support*: BOOLEAN;
			next: ContentType
		END;
		Content* = POINTER TO ContentDesc;
		ContentDesc* = RECORD
			h: Header;
			pos, len*: LONGINT;
			typ*: ContentType;
			encoding*: LONGINT (* 0: binary; 1: 8 bit; 2: 7 bit; 3: 7 bit, quoted; 4: Base64; 5: AsciiCoder; 6: AsciiCoder % *)
		END;
		Part = POINTER TO PartDesc;
		PartDesc = RECORD
			name: ARRAY 64 OF CHAR;
			no: LONGINT;
			next: Part
		END;

	VAR
		contTypes*: ContentType; (** Root of the content-typ list. *)
		textCont*: Content;

	PROCEDURE ReadHeader*(S, echo: Streams.Stream; VAR h: Header; VAR len: LONGINT);
		VAR
			buf: OpenString;
			bufLen, bufPos, begPos, begLen: LONGINT;
			ch, eolc: CHAR;
			end, eol, field, anyField, white: BOOLEAN;
		PROCEDURE Read;
		BEGIN
			IF (ch # Strings.LF) & (echo # NIL) THEN
				TextStreams.Write(echo, ch)
			END;
			Streams.Read(S, ch); INC(len)
		END Read;
	BEGIN
		len := 0; begLen := 0; anyField := FALSE;
		NEW(h); bufLen := 1024; NEW(h.fields, bufLen); bufPos := 0;
		ch := Strings.LF; Read(); eol := FALSE;
		REPEAT
			end := TRUE; field := FALSE; white := FALSE; begPos := bufPos;
			WHILE ~S.eos & ~eol DO
				IF bufPos >= (bufLen-3) THEN
					h.fields[bufPos] := 0X;
					INC(bufLen, 1024); NEW(buf, bufLen);
					COPY(h.fields^, buf^); h.fields := buf
				END;
				IF ((ch = ":") OR (ch = "+")) & ~field THEN	(* "+OK xxx octets" workaround *)
					end := FALSE; field := ~white; anyField := anyField OR field
				ELSIF ch <= " " THEN
					ch := " "; white := TRUE
				END;
				h.fields[bufPos] := ch; INC(bufPos);
				Read();
				IF (ch = Strings.CR) OR (ch = Strings.LF) THEN
					eolc := ch; Read();
					IF eolc # Strings.LF THEN
						IF ch # Strings.LF THEN
							eolc := Strings.CR
						ELSE
							Read(); eolc := Strings.LF
						END
					END;
					IF ch > " " THEN
						eol := TRUE
					ELSE
						WHILE ~S.eos & (ch <= " ") & (ch # eolc) DO
							Read()
						END;
						eol := ch = eolc;
						IF ~eol THEN
							h.fields[bufPos] := " "; INC(bufPos)
						END
					END
				ELSE
					eol := FALSE
				END
			END;
			end := end OR (bufPos <= begPos) OR (ch = Strings.CR) OR (ch = Strings.LF);
			IF field THEN
				begLen := len-1;
				IF S.eos & ~((ch = Strings.CR) OR (ch = Strings.LF)) THEN
					INC(begLen)
				ELSIF ~S.eos THEN
					DEC(begLen)
				END
			END;
			h.fields[bufPos] := 0X; field := FALSE; INC(bufPos);
			eol := FALSE
		UNTIL end;
		len := begLen; h.fields[bufPos] := 0X;
		IF ~anyField THEN
			h.fields[0] := 0X; h.fields[1] := 0X
		END
	END ReadHeader;

	PROCEDURE FindFieldPos*(h: Header; field: ARRAY OF CHAR; VAR pos: LONGINT);
		VAR len, i: LONGINT;
	BEGIN
		len := LEN(h.fields^);
		WHILE pos < len DO
			i := 0;
			WHILE (pos < len) & (CAP(field[i]) = CAP(h.fields[pos])) & (field[i] # 0X) DO
				INC(i); INC(pos)
			END;
			IF (field[i] = 0X) & ((h.fields[pos] <= " ") OR (h.fields[pos] = ":")) THEN
				WHILE (pos < len) & (h.fields[pos] # ":") & (h.fields[pos] # 0X) DO
					INC(pos)
				END;
				IF h.fields[pos] = ":" THEN
					INC(pos);
					WHILE (pos < len) & (h.fields[pos] <= " ") & (h.fields[pos] # 0X) DO
						INC(pos)
					END
				END;
				RETURN
			ELSE
				WHILE (pos < len) & (h.fields[pos] # 0X) DO
					INC(pos)
				END
			END;
			INC(pos)
		END;
		pos := -1
	END FindFieldPos;

	PROCEDURE FindField*(h: Header; field: ARRAY OF CHAR): LONGINT;
		VAR pos: LONGINT;
	BEGIN
		pos := 0; FindFieldPos(h, field, pos);
		RETURN pos
	END FindField;

	PROCEDURE NextValue*(h: Header; VAR pos: LONGINT);
		VAR len: LONGINT;
	BEGIN
		len := LEN(h.fields^);
		IF (pos < 0) OR (pos >= len) THEN
			RETURN
		END;
		WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] # ";") DO
			INC(pos)
		END;
		IF h.fields[pos] = ";" THEN
			INC(pos)
		END;
		WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] <= " ") DO
			INC(pos)
		END
	END NextValue;

	PROCEDURE HexVal(ch: CHAR): LONGINT;
	BEGIN
		IF (ch >= "0") & (ch <= "9") THEN
			RETURN ORD(ch)-ORD("0")
		ELSIF (ch >= "A") & (ch <= "F") THEN
			RETURN ORD(ch)-ORD("A")+10
		ELSIF (ch >= "a") & (ch <= "f") THEN
			RETURN ORD(ch)-ORD("a")+10
		END
	END HexVal;

	PROCEDURE DecodeValue(VAR value: ARRAY OF CHAR);
		VAR
			i, j, l: LONGINT;
			quoted: BOOLEAN;
			ch: CHAR;
	BEGIN
		quoted := FALSE;
		i := 0; j := 0; l := LEN(value);
		ch := value[i];
		WHILE ch # 0X DO
			ch := Strings.ISOToOberon[ORD(ch)];
			IF ch = "=" THEN
				IF ~quoted & ((i+14) < l) & (value[i+1] = "?") & (value[i+12] = "?") & (value[i+14] = "?") THEN
					quoted := TRUE; INC(i, 14)
				ELSIF quoted & Strings.IsHexDigit(value[i+1]) & Strings.IsHexDigit(value[i+2]) THEN
					value[j] := Strings.ISOToOberon[HexVal(value[i+1])*16+HexVal(value[i+2])]; INC(j);
					INC(i, 2)
				ELSE
					value[j] := ch; INC(j)
				END
			ELSIF (ch = "?") & quoted & (value[i+1] = "=") THEN
				quoted := FALSE; INC(i)
			ELSE
				value[j] := ch; INC(j)
			END;
			INC(i); ch := value[i]
		END;
		value[j] := 0X
	END DecodeValue;

	PROCEDURE ExtractValue*(h: Header; pos: LONGINT; VAR val: ARRAY OF CHAR);
		VAR len, i, vlen: LONGINT;
	BEGIN
		COPY("", val);
		len := LEN(h.fields^);
		IF (pos < 0) OR (pos >= len) THEN
			RETURN
		END;
		WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] <= " ") DO
			INC(pos)
		END;
		vlen := LEN(val)-1; i := 0;
		WHILE (pos < len) & (h.fields[pos] # 0X) & (i < vlen) DO
			val[i] := h.fields[pos]; INC(i); INC(pos)
		END;
		val[i] := 0X; DEC(i);
		WHILE (i > 0) & (val[i] <= " ") DO
			val[i] := 0X; DEC(i)
		END;
		DecodeValue(val)
	END ExtractValue;

	PROCEDURE FindParam*(h: Header; pos: LONGINT; param: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
		VAR len, i, vlen: LONGINT;
	BEGIN
		COPY("", val);
		len := LEN(h.fields^);
		IF (pos < 0) OR (pos >= len) THEN
			RETURN
		END;
		WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] <= " ") DO
			INC(pos)
		END;
		vlen := LEN(val)-1;
		WHILE (pos < len) & (h.fields[pos] # 0X) DO
			i := 0;
			WHILE (pos < len) & (param[i] # 0X) & (CAP(param[i]) = CAP(h.fields[pos])) DO
				INC(i); INC(pos)
			END;
			IF param[i] = 0X THEN
				WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] <= " ") DO
					INC(pos)
				END;
				IF h.fields[pos] = "=" THEN
					INC(pos);
					WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] <= " ") DO
						INC(pos)
					END;
					IF h.fields[pos] = 022X THEN
						INC(pos)
					END;
					vlen := LEN(val)-1; i := 0;
					WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] # 022X) & (h.fields[pos] # ";") & (i < vlen) DO
						val[i] := h.fields[pos]; INC(i); INC(pos)
					END;
					val[i] := 0X; DEC(i);
					WHILE (i > 0) & (val[i] <= " ") DO
						val[i] := 0X; DEC(i)
					END
				END;
				RETURN
			END;
			NextValue(h, pos)
		END
	END FindParam;

	PROCEDURE ExtractEMail*(h: Header; pos: LONGINT; VAR email: ARRAY OF CHAR);
		VAR
			len, i, len2: LONGINT;
			end: CHAR;
	BEGIN
		COPY("", email);
		len := LEN(h.fields^);
		IF (pos < 0) OR (pos >= len) THEN
			RETURN
		END;
		WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] # "@") DO
			INC(pos)
		END;
		IF h.fields[pos] = "@" THEN
			WHILE (pos >= 0) & (h.fields[pos] > " ") & (h.fields[pos] # "<") DO
				DEC(pos)
			END;
			IF h.fields[pos] <= " " THEN
				INC(pos)
			END;
			IF h.fields[pos] = "<" THEN
				INC(pos); end := ">"
			ELSE
				end := 0X
			END;
			len2 := LEN(email)-1; i := 0;
			WHILE (i < len2) & (pos < len) & (h.fields[pos] > " ") & (h.fields[pos] # end) DO
				email[i] := h.fields[pos]; INC(i); INC(pos)
			END;
			email[i] := 0X
		END
	END ExtractEMail;

	PROCEDURE StrToMonth(VAR str: ARRAY OF CHAR): LONGINT;
	BEGIN
		CASE CAP(str[0]) OF
			"A": IF (CAP(str[1]) = "P") OR (CAP(str[1]) = "V") THEN (* April, Aprile, Avril *)
						RETURN 4
					ELSE (* August, Agosto, Aout *)
						RETURN 8
					END
			|"D": RETURN 12 (* December, Dezember, Dicembre, Decembre *)
			|"F": RETURN 2 (* February, Febbbraio, Fevrier *)
			|"G": IF CAP(str[1]) = "E" THEN (* Gennaiv *)
						RETURN 1
					ELSE (* Giugno *)
						RETURN 6
					END
			|"J": IF CAP(str[1]) = "A" THEN (* January, Januar, Janvier *)
						RETURN 1
					ELSIF CAP(str[2]) = "L" THEN (* July, Juli, Juillet *)
						RETURN 7
					ELSE (* June, Juni, Juin *)
						RETURN 6
					END
			|"L": RETURN 7 (* Luglio *)
			|"M": IF CAP(str[2]) = "R" THEN (* March, März, Mars *)
						RETURN 3
					ELSIF CAP(str[2]) = "Z" THEN (* Mazzo *)
						RETURN 3
					ELSE (* May, Mai, Maggio *)
						RETURN 5
					END
			|"N": RETURN 11(* November, Novembre *)
			|"O": RETURN 10 (* October, Oktober, Ottobre, Octobre *)
			|"S": RETURN 9 (* September, Seltombre, Septembre *)
		ELSE
		END;
		RETURN 0
	END StrToMonth;

	PROCEDURE GMTTime(h, m, s: LONGINT; zone: ARRAY OF CHAR; VAR time, date: LONGINT): BOOLEAN;
		VAR dH, dM, i: LONGINT;
	BEGIN
		IF (zone[0] = "+") OR (zone[0] = "-") THEN
			IF Strings.Length(zone) > 5 THEN
				dH := 0
			ELSE
				Strings.StrToInt(zone, dH)
			END;
			IF dH < 0 THEN i := -1 ELSE i := 1 END;
			dM := i*ABS(dH MOD 100);
			dH := i*ABS(dH DIV 100)
		ELSE
			dH := 0; dM := 0;
			Strings.Upper(zone, zone);
			IF (zone = "UT") OR (zone = "GMT") OR (zone = "AM") THEN
				(* nix *)
			ELSIF zone = "EST" THEN
				dH := -5
			ELSIF zone = "EDT" THEN
				dH := -4
			ELSIF zone = "CST" THEN
				dH := -6
			ELSIF zone = "CDT" THEN
				dH := -5
			ELSIF zone = "MST" THEN
				dH := -7
			ELSIF zone = "MDT" THEN
				dH := -6
			ELSIF zone = "PST" THEN
				dH := -8
			ELSIF zone = "PDT" THEN
				dH := -7
			ELSIF zone = "MET" THEN
				dH := +2
			ELSIF (zone[1] <= " ") & (zone[0] >= "A") & (zone[0] <= "Y") & (zone[0] # "J") THEN (* military *)
				IF zone[0] >= "N" THEN
					dH := ORD(zone[0])-ORD("N")+1
				ELSIF zone[0] < "J" THEN
					dH := -(ORD(zone[0])-ORD("A")+1)
				ELSE
					dH := -(ORD(zone[0])-ORD("A"))
				END
			ELSIF zone = "PM" THEN
				dH := +12
			ELSE (* local time *)
				dH := Dates.TimeDiff DIV 60;
				dM := Dates.TimeDiff MOD 60
			END
		END;
		h := h-dH; m := m-dM;
		WHILE m < 0 DO
			DEC(h); INC(m, 60)
		END;
		h := h+(m DIV 60); m := m MOD 60;
		date := Dates.AddDay(date, SHORT(h DIV 24)); h := h MOD 24;
		time := h*1000H + m*40H + s;
		RETURN TRUE
	END GMTTime;

	PROCEDURE GetClock*(VAR time, date: LONGINT);
	BEGIN
		Oberon.GetClock(time, date);
		Dates.AddTime(time, date, -Dates.TimeDiff * 60)	(* convert to GMT *)
	END GetClock;

	PROCEDURE ExtractGMTDate*(h: Header; pos: LONGINT; VAR time, date: LONGINT);
		VAR
			len, i, day, year, month, hour, min, sec: LONGINT;
			mo, zone: ARRAY 16 OF CHAR;
			j: INTEGER;
	BEGIN
		time := 0; date := 0;
		len := LEN(h.fields^);
		IF (pos < 0) OR (pos >= len) THEN
			RETURN
		END;
		i := pos;
		WHILE (i < len) & (h.fields[i] # 0X) & (h.fields[i] # ",") DO
			INC(i)
		END;
		IF h.fields[i] = "," THEN
			pos := i+1
		END;
		(* date *)
		j := SHORT(pos); Strings.StrToIntPos(h.fields^, day, j); pos := j;
		WHILE (i < LEN(mo)-1) & (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] <= " ") DO
			INC(pos)
		END;
		i := 0;
		WHILE (pos < len) & (h.fields[pos] > " ") DO
			mo[i] := h.fields[pos]; INC(i); INC(pos)
		END;
		mo[i] := 0X; month := StrToMonth(mo);
		IF (month >= 1) & (month <= 12) THEN
			j := SHORT(pos); Strings.StrToIntPos(h.fields^, year, j);
			IF year >= 1900 THEN
				date := (year-1900)*200H + month*20H + day
			ELSIF year < 80 THEN
				date := (year+100)*200H + month*20H + day
			ELSE
				date := year*200H + month*20H + day
			END;
			(* time *)
			Strings.StrToIntPos(h.fields^, hour, j);
			WHILE (j < len) & (h.fields[j] # 0X) & (h.fields[j] # ":") DO
				INC(j)
			END;
			IF h.fields[j] = ":" THEN
				INC(j); Strings.StrToIntPos(h.fields^, min, j)
			ELSE
				min := 0
			END;
			WHILE (j < len) & (h.fields[j] # 0X) & (h.fields[j] <= " ") DO
				INC(j)
			END;
			IF h.fields[j] = ":" THEN
				INC(j); Strings.StrToIntPos(h.fields^, sec, j)
			ELSE
				sec := 0
			END;
			WHILE (j < len) & (h.fields[j] # 0X) & (h.fields[j] <= " ") DO
				INC(j)
			END;
			i := 0;
			WHILE (j < len) & (h.fields[j] > " ") DO
				zone[i] := h.fields[j]; INC(i); INC(j)
			END;
			zone[i] := 0X;
			IF GMTTime(hour, min, sec, zone, time, date) THEN
				RETURN
			END
		END;
		GetClock(time, date)
	END ExtractGMTDate;

	PROCEDURE EnumMIME(key, value: ARRAY OF CHAR);
		VAR
			contType: ContentType;
			i, j: LONGINT;
	BEGIN
		NEW(contType); contType.next := contTypes; contTypes := contType; contType.support := TRUE;
		i := 0;
		WHILE (key[i] # 0X) & (key[i] # "/") DO
			contType.typ[i] := key[i]; INC(i)
		END;
		contType.typ[i] := 0X; Strings.Lower(contType.typ, contType.typ);
		IF key[i] = "/" THEN
			INC(i)
		END;
		j := 0;
		WHILE key[i] # 0X DO
			contType.subTyp[j] := key[i]; INC(j); INC(i)
		END;
		contType.subTyp[j] := 0X; Strings.Lower(contType.subTyp, contType.subTyp);
		i := 0;
		WHILE value[i] > " " DO
			contType.suffix[i] := value[i]; INC(i)
		END;
		contType.suffix[i] := 0X;
		WHILE (value[i] # 0X) & (value[i] <= " ") DO
			INC(i)
		END;
		j := 0;
		WHILE value[i] > " " DO
			contType.prefix[j] := value[i];
			INC(j); INC(i)
		END;
		contType.prefix[j] := 0X;
		WHILE (value[i] # 0X) & (value[i] <= " ") DO
			INC(i)
		END
	END EnumMIME;

(** Find a content-type description. *)
	PROCEDURE GetContentType*(fullTyp: ARRAY OF CHAR): ContentType;
		VAR
			contType: ContentType;
			typ: ARRAY 32 OF CHAR;
			subTyp: ARRAY 64 OF CHAR;
			i, j: LONGINT;
	BEGIN
		i := 0;
		WHILE (fullTyp[i] # 0X) & (fullTyp[i] # "/") DO
			typ[i] := fullTyp[i]; INC(i)
		END;
		typ[i] := 0X; Strings.Lower(typ, typ);
		IF fullTyp[i] = "/" THEN
			INC(i)
		END;
		j := 0;
		WHILE fullTyp[i] # 0X DO
			subTyp[j] := fullTyp[i]; INC(j); INC(i)
		END;
		subTyp[j] := 0X; Strings.Lower(subTyp, subTyp);
		IF typ = "" THEN
			typ := "text"
		END;
		IF subTyp = "" THEN
			subTyp := "plain"
		END;
		contType := contTypes;
		WHILE (contType # NIL) & ~((contType.typ = typ) & (contType.subTyp = subTyp)) DO
			contType := contType.next
		END;
		IF contType = NIL THEN
			NEW(contType); contType.next := contTypes; contTypes := contType; contType.support := FALSE;
			COPY(typ, contType.typ); COPY(subTyp, contType.subTyp);
			contType.prefix := ""; contType.suffix := ""
		END;
		RETURN contType
	END GetContentType;

	PROCEDURE LoadTypes;
		VAR S: Texts.Scanner; key: ARRAY 64 OF CHAR;
	BEGIN
		contTypes := NIL;
		Oberon.OpenScanner(S, "MIME");
		IF S.class = Texts.Inval THEN
			Out.String("Oberon.Text - MIME not found");  Out.Ln
		END;
		WHILE S.class IN {Texts.Name, Texts.String} DO
			COPY(S.s, key); Texts.Scan(S);
			IF (S.class = Texts.Char) & (S.c = "=") THEN
				Texts.Scan(S);
				IF S.class IN {Texts.Name, Texts.String} THEN
					EnumMIME(key, S.s); Texts.Scan(S)
				END
			ELSE S.class := Texts.Inval
			END
		END;
		NEW(textCont); textCont.typ := GetContentType("text/plain"); textCont.encoding := Enc8Bit;
		textCont.h := NIL; textCont.pos := 0; textCont.len := MAX(LONGINT)-BufLen-1
	END LoadTypes;

(** Create a temporary file name for contType. *)
	PROCEDURE MakeTempName*(contType: ContentType; VAR tempName: ARRAY OF CHAR);
	BEGIN
		COPY(contType.prefix, tempName);
		Strings.Append(tempName, "Temp.");
		Strings.Append(tempName, contType.suffix)
	END MakeTempName;

	PROCEDURE ExtractContentType*(h: Header; pos: LONGINT; VAR cont: Content);
		VAR
			len, i: LONGINT;
			fullTyp: ARRAY 32+64 OF CHAR;
	BEGIN
		NEW(cont); cont.typ := GetContentType(TextMime); cont.encoding := EncBin;
		cont.h := h; cont.pos := pos;
		len := LEN(h.fields^);
		IF (pos < 0) OR (pos >= len) THEN
			RETURN
		END;
		WHILE (pos < len) & (h.fields[pos] # 0X) & (h.fields[pos] <= " ") DO
			INC(pos)
		END;
		i := 0;
		WHILE (pos < len) & (h.fields[pos] > " ") & (h.fields[pos] # ";")DO
			fullTyp[i] := h.fields[pos]; INC(i); INC(pos)
		END;
		fullTyp[i] := 0X; cont.typ := GetContentType(fullTyp);
		cont.pos := pos; cont.len := MAX(LONGINT)
	END ExtractContentType;

	PROCEDURE ReadText*(in: Streams.Stream; VAR W: Texts.Writer; cont: Content; mail: BOOLEAN);
		VAR
			buffer: ARRAY BufLen OF CHAR;
			len, rlen, i, offs, maxLen: LONGINT;
			ch, ch1: CHAR;
			iso, quoted, cr: BOOLEAN;
	BEGIN
		iso := cont.encoding IN {Enc8Bit, Enc7Bit, EncQuoted}; quoted := cont.encoding = EncQuoted;
		IF cont.h # NIL THEN
			FindParam(cont.h, cont.pos, "charset", buffer); iso := iso OR (buffer # "")
		END;
		ch := 0X; cr := FALSE;
		offs := 0; maxLen := cont.len;
		in.mode := Streams.binary; len := in.Available(in);
		WHILE (maxLen > 0) & ((len > 0) OR (~in.eos & in.buffer)) DO
			IF len > (BufLen-2) THEN
				rlen := BufLen-2
			ELSE
				rlen := len
			END;
			IF rlen > maxLen THEN
				rlen := maxLen
			END;
			in.ReadBytes(in, buffer, rlen); DEC(maxLen, rlen);
			i := 0;
			WHILE i < rlen DO
				IF (buffer[i] = Strings.CR) OR (buffer[i] = Strings.LF) THEN
					IF (buffer[i] = Strings.LF) & cr THEN
						(* ignore LF after CR *)
					ELSE
						Texts.WriteLn(W);
						IF mail & (offs = 1) & (ch = ".") THEN
							RETURN
						END;
						offs := 0
					END;
					cr := (buffer[i] = Strings.CR)
				ELSIF iso THEN
					ch := buffer[i];
					IF ~quoted OR (ch # "=") THEN
						ch := Strings.ISOToOberon[ORD(ch)];
						IF ~mail OR (offs > 0) OR (ch # ".") THEN
							Texts.Write(W, ch)
						END
					ELSE
						INC(i);
						IF i < rlen THEN
							ch := buffer[i]; INC(i)
						ELSE
							Streams.Read(in, ch); INC(rlen); DEC(maxLen)
						END;
						IF i < rlen THEN
							ch1 := buffer[i]
						ELSE
							Streams.Read(in, ch1); INC(rlen); DEC(maxLen)
						END;
						IF Strings.IsHexDigit(ch) & Strings.IsHexDigit(ch1) THEN
							ch := Strings.ISOToOberon[HexVal(ch)*16+HexVal(ch1)];
							Texts.Write(W, ch); ch := 0X
						ELSIF (ch1 = Strings.LF) OR (ch = Strings.LF) THEN
							(* Texts.WriteLn(W); offs := 0 *)
						ELSE
							Texts.Write(W, "=");
							Texts.Write(W, ch); Texts.Write(W, ch1);
							INC(offs, 2); ch := ch1
						END
					END;
					INC(offs)
				ELSE
					ch := buffer[i];
					IF ~mail OR (offs > 0) OR (ch # ".") THEN
						Texts.Write(W, ch)
					END;
					INC(offs)
				END;
				INC(i)
			END;
			DEC(len, rlen);
			IF len <= 0 THEN
				len := in.Available(in)
			END
		END
	END ReadText;

	PROCEDURE SearchBoundary(F: Files.File; VAR boundary: ARRAY OF CHAR; VAR pos: LONGINT): BOOLEAN;
		CONST
			MaxPatLen = 128;
		VAR
			sPat: ARRAY MaxPatLen OF CHAR;
			sDv: ARRAY MaxPatLen + 1 OF LONGINT;
			i, l, sPatLen: LONGINT;
			R: Files.Rider;
			prev, ch: CHAR;
		PROCEDURE CalcDispVec;
			VAR i, j, d: LONGINT;
		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] := d; INC(i)
				END;
				INC(d)
			END
		END CalcDispVec;
	BEGIN
		COPY(boundary, sPat);
		sPatLen := Strings.Length(sPat);
		CalcDispVec(); prev := 0X;
		IF sPatLen > 0 THEN
			Files.Set(R, F, pos); prev := ch; Files.Read(R, ch);
			INC(pos); l := Files.Length(F); i := 0;
			WHILE (i # sPatLen) & (pos <= l) DO
				IF (i = 0) & (prev >= " ") THEN
					prev := ch; Files.Read(R, ch); INC(pos)
				ELSE
					IF ch = sPat[i] THEN
						INC(i);
						IF i < sPatLen THEN
							prev := ch; Files.Read(R, ch); INC(pos)
						END
					ELSIF i = 0 THEN
						prev := ch; Files.Read(R, ch); INC(pos)
					ELSE
						i := i - sDv[i]
					END
				END
			END
		ELSE
			i := -1
		END;
		RETURN i = sPatLen
	END SearchBoundary;

	PROCEDURE TextEncoding*(h: Header; pos: LONGINT; cont: Content);
		VAR
			val: ARRAY 64 OF CHAR;
			i: LONGINT;
	BEGIN
		ExtractValue(h, pos, val);
		i := 0; Strings.CAPSearch("quoted", val, i);
		IF i >= 0 THEN
			cont.encoding := EncQuoted
		ELSE
			i := 0; Strings.Search("7", val, i);
			IF i > 0 THEN
				cont.encoding := Enc7Bit
			ELSE
				cont.encoding := Enc8Bit
			END
		END;
		cont.len := MAX(LONGINT)
	END TextEncoding;

	PROCEDURE HorzRule(VAR W: Texts.Writer; name: ARRAY OF CHAR);
		VAR f: BasicFigures.Figure;
	BEGIN
		NEW(f); BasicFigures.InitRect3D(f, Display.Width, 2);
		Gadgets.NameObj(f, name);
		Texts.WriteObj(W, f); Texts.WriteLn(W)
	END HorzRule;

	PROCEDURE DecodePart(F: Files.File; beg, end: LONGINT; T: Texts.Text; VAR W: Texts.Writer; VAR parts: Part; mail: BOOLEAN);
		VAR
			R: Files.Rider;
			S, wS: Streams.Stream;
			h: Header;
			cont: Content;
			pos, begPart, n, oldBeg: LONGINT;
			val: ARRAY 64 OF CHAR;
			part: Part;
			ch: CHAR;
	BEGIN
		Files.Set(R, F, beg);
		Files.Read(R, ch); INC(beg);
		WHILE (ch <= " ") & (beg <= end) DO
			Files.Read(R, ch); INC(beg)
		END;
		IF ch = "-" THEN
			RETURN
		END;
		NEW(part);
		IF parts = NIL THEN
			part.no := 0
		ELSE
			part.no := parts.no+1
		END;
		part.next := parts; parts := part;
		S := Streams.OpenFileReader(F, beg-1); S.mode := Streams.iso8859; oldBeg := beg-1;
		Texts.Append(T, W.buf);
		wS := TextStreams.OpenWriter(T); begPart := T.len;
		ReadHeader(S, wS, h, n);
		IF (n > 0) & ~((h.fields[0] = 0X) & (h.fields[1] = 0X)) THEN
			wS.Flush(wS); INC(beg, n)
		ELSE
			DEC(beg)
		END;
		pos := FindField(h, "Content-Type"); ExtractContentType(h, pos, cont);
		FindParam(h, pos, "name", part.name);
		Strings.IntToStr(part.no, val); HorzRule(W, val);
		Texts.Insert(T, begPart, W.buf);
		S := Streams.OpenFileReader(F, beg); S.mode := Streams.binary;
		pos := FindField(h, "Content-Disposition");
		IF pos > 0 THEN
			pos := FindField(h, "Content-Transfer-Encoding");
			IF pos > 0 THEN
				ExtractValue(h, pos, val);
				IF Strings.CAPPrefix("Base64", val) THEN
					Texts.WriteString(W, "Base64.Decode ");
					pos := FindField(h, "Content-Disposition");
					FindParam(h, pos, "filename", val);
					IF part.name = "" THEN
						COPY(val, part.name)
					END;
					Texts.WriteString(W, val); Texts.WriteString(W, " ~"); Texts.WriteLn(W);
					Texts.Append(T, W.buf); cont.encoding := EncBase64
				ELSIF cont.typ.typ = "text" THEN
					TextEncoding(h, pos, cont)
				ELSIF Strings.CAPPrefix("Quoted", val) THEN
					Texts.WriteString(W, "QuotedPrintable.DecodeFile ");
					pos := FindField(h, "Content-Disposition");
					FindParam(h, pos, "filename", val);
					IF part.name = "" THEN
						COPY(val, part.name)
					END;
					Texts.WriteString(W, val); Texts.WriteString(W, " ~"); Texts.WriteLn(W);
					Texts.Append(T, W.buf); cont.encoding := EncBin
				ELSE
					cont.encoding := EncBin
				END
			ELSE
				cont.encoding := EncBin
			END
		ELSE
			pos := FindField(h, "Content-Transfer-Encoding");
			TextEncoding(h, pos, cont)
		END;
		IF part.name = "" THEN
			COPY(cont.typ.typ, part.name);
			Strings.AppendCh(part.name, "/");
			Strings.Append(part.name, cont.typ.subTyp)
		END;
		Texts.Insert(T, begPart, W.buf); (*Texts.WriteLn(W);*)
		cont.len := end-beg; ReadText(S, W, cont, mail); (*Texts.WriteLn(W)*)
	END DecodePart;

	PROCEDURE DecodeMultipartFile(F: Files.File; VAR T: Texts.Text; boundary: ARRAY OF CHAR; mail: BOOLEAN);
		VAR
			W: Texts.Writer;
			last, next, parts: Part;
			obj: Objects.Object;
			cmd: ARRAY 64 OF CHAR;
			pos, beg, end, len: LONGINT;
	BEGIN
		NEW(T); Texts.Open(T, ""); Texts.OpenWriter(W);
		pos := 0; end := 0; len := Files.Length(F); parts := NIL;
		IF SearchBoundary(F, boundary, pos) THEN
			DecodePart(F, 0, pos-Strings.Length(boundary)-2, T, W, parts, mail);
			WHILE end < len DO
				beg := pos;
				IF SearchBoundary(F, boundary, pos) THEN
					end := pos-Strings.Length(boundary)-2
				ELSE
					end := len+1
				END;
				DecodePart(F, beg, end, T, W, parts, mail)
			END
		END;
		Texts.Append(T, W.buf);
		last := NIL;
		WHILE parts # NIL DO
			next := parts.next; parts.next := last;
			last := parts; parts := next
		END;
		Texts.WriteLn(W);
		parts := last;
		WHILE parts # NIL DO
			Texts.WriteString(W, "[ ");
			Texts.SetColor(W, SHORT(Display3.blue));
			Texts.WriteString(W, parts.name);
			Texts.SetColor(W, SHORT(Display3.textC));
			obj := Gadgets.CreateObject("TextGadgets.NewControl");
			cmd := "HTMLDocs.Locate '";
			Strings.IntToStr(parts.no, boundary);
			Strings.Append(cmd, boundary);
			Attributes.SetString(obj, "Cmd", cmd);
			Texts.WriteObj(W, obj);
			Texts.WriteString(W, " ] ");
			parts := parts.next
		END;
		Texts.WriteLn(W); Texts.WriteLn(W);
		Texts.Insert(T, 0, W.buf)
	END DecodeMultipartFile;

	PROCEDURE ReadMultipartText*(in: Streams.Stream; VAR T: Texts.Text; cont: Content; mail: BOOLEAN);
		VAR
			h: Header;
			F: Files.File;
			R: Files.Rider;
			buffer: ARRAY BufLen OF CHAR;
			boundary: ARRAY 128 OF CHAR;
			len, rlen, i, state, maxLen: LONGINT;
	BEGIN
		maxLen := cont.len; state := 1; h := cont.h;
		F := Files.New(""); Files.Set(R, F, 0);
		in.mode := Streams.binary; len := in.Available(in);
		WHILE (maxLen > 0) & ((len > 0) OR ~in.eos) DO
			IF len > BufLen THEN
				rlen := BufLen
			ELSE
				rlen := len
			END;
			IF rlen > maxLen THEN
				rlen := maxLen
			END;
			in.ReadBytes(in, buffer, rlen); DEC(maxLen, rlen);
			IF mail THEN
				i := 0;
				WHILE (i < rlen) & (state # 2) DO
					IF (buffer[i] = Strings.CR) OR (buffer[i] = Strings.LF) THEN
						state := 1
					ELSIF (state > 0) & (buffer[i] = ".") THEN
						INC(state);
						IF (i < (rlen-1)) & (buffer[i+1] = ".") THEN
							INC(i); INC(state)
						END
					ELSE
						state := 0
					END;
					INC(i)
				END;
				IF state = 2 THEN
					maxLen := 0
				END
			END;
			Files.WriteBytes(R, buffer, rlen);
			len := in.Available(in)
		END;
		FindParam(h, cont.pos, "boundary", buffer);
		boundary := "--"; Strings.Append(boundary, buffer);
		DecodeMultipartFile(F, T, boundary, mail)
	END ReadMultipartText;

	PROCEDURE HexDigit(i: LONGINT): CHAR;
	BEGIN
		IF i < 10 THEN
			RETURN CHR(i+ORD("0"))
		ELSE
			RETURN CHR(i-10+ORD("A"))
		END
	END HexDigit;

	PROCEDURE WriteText*(T: Texts.Text; beg, end: LONGINT; out: Streams.Stream; cont: Content; mail, crlf: BOOLEAN);
		VAR
			buffer: ARRAY BufLen OF CHAR;
			R: Texts.Reader;
			i, j, offs: LONGINT;
			ch: CHAR;
			iso, quoted: BOOLEAN;
	BEGIN
		iso := cont.encoding IN {Enc8Bit, Enc7Bit, EncQuoted}; quoted := cont.encoding = EncQuoted;
		Texts.OpenReader(R, T, beg);
		offs := 0; i := 0; out.mode := Streams.binary;
		Texts.Read(R, ch); INC(beg);
		WHILE ~R.eot & (beg <= end) DO
			IF R.lib IS Fonts.Font THEN
				IF ch = Strings.CR THEN
					out.WriteBytes(out, buffer, i);
					out.WriteBytes(out, Strings.CRLF, 2);
					offs := 0; i := 0
				ELSIF mail & (ch = ".") & (offs = 0) THEN
					IF i > (MaxLine-3) THEN
						out.WriteBytes(out, buffer, i); i := 0
					END;
					buffer[i] := ch; buffer[i+1] := ch; INC(offs, 2); INC(i, 2)
				ELSIF ch # Strings.LF THEN
					IF iso THEN
						ch := Strings.OberonToISO[ORD(ch)];
						IF ~quoted OR ((ch < CHR(128)) & (ch # "=")) THEN
							buffer[i] := ch
						ELSE
							IF i > (MaxLine-3) THEN
								out.WriteBytes(out, buffer, i); i := 0
							END;
							buffer[i] := "=";
							buffer[i+1] := HexDigit((ORD(ch) DIV 16) MOD 16);
							buffer[i+2] := HexDigit(ORD(ch) MOD 16);
							INC(i, 2); INC(offs, 2)
						END
					ELSE
						buffer[i] := ch
					END;
					INC(i);
					IF mail & (offs >= (MaxSMTPLine-5)) THEN
						j := i-1;
						WHILE (j > 0) & (buffer[j] > " ") DO
							DEC(j)
						END;
						IF j > 0 THEN
							INC(j);
							out.WriteBytes(out, buffer, j);
							out.WriteBytes(out, Strings.CRLF, 2);
							IF j < i THEN
								offs := i-j;
								FOR i := j TO offs DO
									out.WriteBytes(out, buffer[i], 1)
								END
							ELSE
								offs := 0
							END
						ELSE
							out.WriteBytes(out, buffer, i);
							out.WriteBytes(out, Strings.CRLF, 2); offs := 0
						END;
						i := 0
					ELSIF i >= MaxLine THEN
						out.WriteBytes(out, buffer, i); i := 0
					END;
					INC(offs)
				END
			END;
			Texts.Read(R, ch); INC(beg)
		END;
		out.WriteBytes(out, buffer, i);
		IF crlf THEN
			out.WriteBytes(out, Strings.CRLF, 2)
		END
	END WriteText;

	PROCEDURE WriteISOMime*(S: Streams.Stream; cont: Content);
	BEGIN
		S.mode := Streams.iso8859;
		TextStreams.WriteString(S, MimeVersion); TextStreams.WriteLn(S);
		TextStreams.WriteString(S, "Content-Type: "); TextStreams.WriteString(S, TextMime);
		TextStreams.WriteString(S, "; charset="); TextStreams.WriteString(S, ISOVer);
		TextStreams.WriteLn(S);
		IF cont.encoding = EncQuoted THEN
			TextStreams.WriteString(S, ContEncQuoted)
		ELSIF cont.encoding = Enc7Bit THEN
			TextStreams.WriteString(S, ContEnc7Bit)
		ELSE
			TextStreams.WriteString(S, ContEnc8Bit)
		END;
		TextStreams.WriteLn(S);
		IF (cont.len > 0) & (cont.len < MAX(LONGINT)) THEN
			TextStreams.WriteString(S, "Content-Length: "); TextStreams.WriteInt(S, cont.len, 0); TextStreams.WriteLn(S)
		END
	END WriteISOMime;

BEGIN
	LoadTypes()
END MIME.