implement WmReadmail;

include "sys.m";
	sys: Sys;

include "draw.m";
	draw: Draw;
	Context: import draw;

include "tk.m";
	tk: Tk;
	Toplevel: import tk;

include "wmlib.m";
	wmlib: Wmlib;

include "string.m";
	str: String;

include "keyring.m";
	kr: Keyring;

WmReadmail: module
{
	init:	fn(ctxt: ref Draw->Context, args: list of string);
};

WmSendmail: module
{
	init:	fn(ctxt: ref Draw->Context, args: list of string);
};

srv: Sys->Connection;
main: ref Toplevel;
ctxt: ref Context;
nmesg: int;
cmesg: int;
map: array of byte;
Ok, Deleted: con iota;
username: string;

mail_cfg := array[] of {
	"frame .top",
	"label .top.l -bitmap email.bit",
	"frame .top.con",
	"frame .top.con.b",
	"button .top.con.b.con -bitmap mailcon -command {send msg connect}",
	"bind .top.con.b.con <Enter> +{.top.status configure -text {connect/disconnect to mail server}}",
	"button .top.con.b.next -bitmap mailnext -command {send msg next}",
	"bind .top.con.b.next <Enter> +{.top.status configure -text {next message}}",
	"button .top.con.b.prev -bitmap mailprev -command {send msg prev}",
	"bind .top.con.b.prev <Enter> +{.top.status configure -text {previous message}}",
	"button .top.con.b.del -bitmap maildel -command {send msg dele}",
	"bind .top.con.b.del <Enter> +{.top.status configure -text {delete message}}",
	"button .top.con.b.reply -bitmap mailreply -command {send msg reply}",
	"bind .top.con.b.reply <Enter> +{.top.status configure -text {reply to message}}",
	"button .top.con.b.fwd -bitmap mailforward",
	"bind .top.con.b.fwd <Enter> +{.top.status configure -text {forward message}}",
	"button .top.con.b.hdr -bitmap mailhdr -command {send msg hdrs}",
	"bind .top.con.b.hdr <Enter> +{.top.status configure -text {fetch message headers}}",
	"button .top.con.b.save -bitmap mailsave -command {send msg save}",
	"bind .top.con.b.save <Enter> +{.top.status configure -text {save message}}",
	"pack .top.con.b.con .top.con.b.prev .top.con.b.next .top.con.b.del .top.con.b.reply .top.con.b.fwd .top.con.b.hdr .top.con.b.save -padx 2 -side left",
	"label .top.status -text {not connected ...} -anchor w",
	"pack .top.l -side left",
	"pack .top.con -side left -padx 10",
	"pack .top.con.b .top.status -in .top.con -fill x -expand 1",
	"frame .hdr",
	"scrollbar .hdr.scroll -command {.hdr.t yview}",
	"text .hdr.t -height 3c -yscrollcommand {.hdr.scroll set} -bg white",
	"frame .hdr.pad -width 2c",
	"pack .hdr.t -side left -fill x -expand 1",
	"pack .hdr.scroll -side left -fill y",
	"pack .hdr.pad",
	"frame .body",
	"scrollbar .body.scroll -command {.body.t yview}",
	"text .body.t -width 15c -height 7c -yscrollcommand {.body.scroll set} -bg white",
	"pack .body.t -side left -expand 1 -fill both",
	"pack .body.scroll -side left -fill y",
	"pack .top -anchor w -padx 5",
	"pack .hdr -fill x -anchor w -padx 5 -pady 5",
	"pack .body -expand 1 -fill both -padx 5 -pady 5",
	"pack .b -padx 5 -pady 5 -fill x",
	"pack propagate . 0",
	"update"
};

con_cfg := array[] of {
	"frame .b",
	"button .b.ok -text {Connect} -command {send cmd ok}",
	"button .b.can -text {Cancel} -command {send cmd can}",
	"pack .b.ok .b.can -side left -fill x -padx 10 -pady 10 -expand 1",
	"frame .l",
	"label .l.h -text {Mail Server:} -anchor w",
	"label .l.u -text {User Name:} -anchor w",
	"label .l.s -text {Secret:} -anchor w",
	"pack .l.h .l.u .l.s -fill both -expand 1",
	"frame .e",
	"entry .e.h",
	"entry .e.u",
	"entry .e.s -show •",
	"pack .e.h .e.u .e.s -fill x",
	"frame .f -borderwidth 2 -relief raised",
	"pack .l .e -fill both -expand 1 -side left -in .f",
	"pack .f",
	"pack .b -fill x -expand 1",
	"bind .e.h <Key-\n> {send cmd ok}",
	"bind .e.u <Key-\n> {send cmd ok}",
	"bind .e.s <Key-\n> {send cmd ok}",
	"focus .e.s",
};

hdr_cfg := array[] of {
	"scrollbar .sh -orient horizontal -command {.f.l xview}",
	"scrollbar .f.sv -command {.f.l yview}",
	"frame .f",
	"listbox .f.l -width 80w -height 20h -yscrollcommand { .f.sv set} -xscrollcommand { .sh set}",
	"pack .f.l -side left -fill both -expand 1",
	"pack .f.sv -side left -fill y",
	"pack .f -fill both -expand 1",
	"pack .sh -fill x",
	"pack propagate . 0",
	"bind .f.l <Double-Button> { send tomain [.f.l get [.f.l curselection]] }",
	"update",
};

init(xctxt: ref Context, argv: list of string)
{
	sys = load Sys Sys->PATH;
	draw = load Draw Draw->PATH;
	tk = load Tk Tk->PATH;
	wmlib = load Wmlib Wmlib->PATH;
	str = load String String->PATH;
	kr = load Keyring Keyring->PATH;

	ctxt = xctxt;

	wmlib->init();

	tkargs := "";
	argv = tl argv;
	if(argv != nil) {
		tkargs = hd argv;
		argv = tl argv;
	}

	titlectl := chan of string;
	(main, titlectl) = wmlib->titlebar(ctxt.screen, tkargs, "MailStop: Reader", Wmlib->Appl);

	msg := chan of string;
	tk->namechan(main, msg, "msg");
	hdr := chan of string;

	wmlib->tkcmds(main, mail_cfg);

	for(;;) alt {
	menu := <-titlectl =>
		if(menu[0] == 'e') {
			if(srv.dfd != nil) {
				status("Updating mail box...");
				pop3cmd("QUIT");
			}
			return;
		}
		wmlib->titlectl(main, menu);
	cmd := <-msg =>
		case cmd {
		"connect" =>
			if(srv.dfd == nil) {
				connect(main);
				if(srv.dfd != nil)
					initialize();
				break;
			}
			disconnect();
		"prev" =>
			if(cmesg > nmesg) {
				status("no more messages.");
				break;
			}
			for(new := cmesg+1; new <= nmesg; new++) {
				if(map[new] == byte Ok) {
					cmesg = new;
					loadmesg();
					break;
				}
			}
		"next" =>
			for(new := cmesg-1; new >= 1; new--) {
				if(map[new] == byte Ok) {
					cmesg = new;
					loadmesg();
					break;
				}
			}
		"dele" =>
			delete();
			if(cmesg > 0) {
				cmesg--;
				loadmesg();
			}
		"hdrs" =>
			headers(hdr);
		"save" =>
			save();
		"reply" =>
			reply();
		}
	get := <-hdr =>
		new := int get;
		if(new < 1 || new > nmesg || map[new] != byte Ok)
			break;		
		cmesg = new;
		loadmesg();
	}
}

headers(tomain: chan of string)
{
	(hdr, hdrctl) := wmlib->titlebar(ctxt.screen, wmlib->geom(main),
				"MailStop: Headers", Wmlib->Appl);

	tk->namechan(hdr, tomain, "tomain");

	wmlib->tkcmds(hdr, hdr_cfg);

	for(i := 1; i <= nmesg; i++) {
		if(map[i] == byte Deleted) {
			info := sys->sprint("%4d ...Deleted...\n", i);
			tk->cmd(hdr, ".f.l insert 0 '"+info);
			continue;
		}
		if(topit(hdr, i) == 0)
			break;
		alt {
		s := <-hdrctl =>
			if(s[0] == 'e')
				return;
			wmlib->titlectl(hdr, s);
		* =>
		}
		if((i%10) == 9)
			tk->cmd(hdr, "update");
	}
	tk->cmd(hdr, "update");

	spawn hproc(hdrctl, hdr);
}

trunc(name: string): string
{
	for(i := 0; i < len name; i++)
		if(name[i] == '<')
			break;
	i++;
	if(i >= len name)
		return name;
	for(j := i; j < len name; j++)
		if(name[j] == '>')
			break;
	return name[i:j];
}

topit(hdr: ref Toplevel, msg: int): int
{
	(err, s) := pop3cmd("TOP "+string msg+" 0");
	if(err != nil) {
		wmlib->dialog(hdr, "error -fg red", "POP3 Error",
				"Ecountered a problem fetching headers\n"+err,
				0, "Dismiss"::nil);
		return 0;
	}

	size := int s;
	b := pop3body(size);
	if(b == nil)
		return 0;

	from := getfield("from", b);
	from = trunc(from);
	date := getfield("date", b);
	subj := getfield("subject", b);
	if(len subj > 20)
		subj = subj[0:19];

	if(len subj > 0)
		info := sys->sprint("%4d %5d %s \"%s\" %s", msg, size, from, subj, date);
	else
		info = sys->sprint("%4d %5d %s %s", msg, size, from, date);

	tk->cmd(hdr, ".f.l insert 0 '"+info);
	return 1;
}

mapdown(b: array of byte): string
{
	lb := len b;
	l := array[lb] of byte;
	for(i := 0; i < lb; i++) {
		c := b[i];
		if(c >= byte 'A' && c <= byte 'Z')
			c += byte('a' - 'A');
		l[i] = c;
	}
	return string l;	
}

getfield(key: string, text: array of byte): string
{
	key[len key] = ':';
	lk := len key;
	cl := byte key[0];
	cu := cl - byte ('a' - 'A');

	lc: byte;
	for(i := 0; i < len text - lk; i++) {
		t := text[i];
		if(t == byte '\n' && lc == byte '\n')		# end header
			break;
		lc = t;
		if(t != cu && t != cl)
			continue;
		if(key == mapdown(text[i:i+lk])) {
			i += lk+1;
			for(j := i+1; j < len text; j++) {
				c := text[j];
				if(c == byte '\r' || c == byte '\n')
					break;
			}
			return string text[i:j];
		}
	}
	return "";
}

hproc(ctl: chan of string, hdr: ref Toplevel)
{
	for(;;) {
		s := <-ctl;
		if(s[0] == 'e')
			return;
		wmlib->titlectl(hdr, s);
	}
}

reply()
{
	if(cmesg == 0) {
		wmlib->dialog(main, "error -fg red", "Reply",
					"No message to reply to",
					0, "Abort"::nil);
		return;
	}

	hdr := tk->cmd(main, ".hdr.t get 1.0 end");
	if(hdr == "") {
		wmlib->dialog(main, "error -fg red", "Reply",
					"Mail has no header to reply to",
					0, "Abort"::nil);
		return;
	}

	wmsender := load WmSendmail "/dis/wm/sendmail.dis";
	if(wmsender == nil) {
		wmlib->dialog(main, "error -fg red", "Reply",
				"Failed to load mail sender:\n"+sys->sprint("%r"),
				0, "Abort"::nil);
		return;
	}

	spawn wmsender->init(ctxt, "sendmail" :: wmlib->geom(main) :: hdr :: nil);
}

save()
{
	if(cmesg == 0) {
		wmlib->dialog(main, "error -fg red", "Save",
				"No current message",
				0, "Continue"::nil);
		return;
	}
	pat := list of {
		"*.let (Saved mail)",
		"* (All files)"
	};

	fd: ref Sys->FD;
	fname: string;
	for(;;) {
		fname = wmlib->filename(ctxt.screen, main, "Save in Mailbox",
					pat, "/usr/"+username+"/mail");
		if(fname == nil)
			return;

		fd = sys->create(fname, sys->OWRITE, 8r660);
		if(fd != nil)
			break;

		labs := list of {
			"New name",
			"Abort"
		};

		r := wmlib->dialog(main, "error -fg red", "Save",
				"Failed to create "+sys->sprint("%s\n%r", fname),
				0, labs);
		if(r == 1)
			return;
	}
	s := tk->cmd(main, ".hdr.t get 1.0 end");
	b := array of byte s;
	r := sys->write(fd, b, len b);
	if(r < 0) {
		wmlib->dialog(main, "error -fg red", "Save",
				"Error writing file"+sys->sprint("%s\n%r", fname),
				0, "Continue (not saved)":: nil);
		return;
	}
	s = tk->cmd(main, ".body.t get 1.0 end");
	b = array of byte s;
	n := sys->write(fd, b, len b);
	if(n < 0) {
		wmlib->dialog(main, "error -fg red", "Save",
				"Error writing file"+sys->sprint("%s\n%r", fname),
				0, "Continue (not saved)":: nil);
		return;
	}
	status("wrote "+string(n+r)+" bytes.");
}

delete()
{
	if(srv.dfd == nil) {
		wmlib->dialog(main, "warning -fg yellow", "Delete",
				"You must be connected to delete messages",
				0, "Continue"::nil);
		return;
	}
	(err, s) := pop3cmd("DELE "+string cmesg);
	if(err != nil) {
		wmlib->dialog(main, "error -fg red", "Delete",
				"Encountered POP3 problem during delete\n"+err,
				0, "Continue"::nil);
		return;
	}
	map[cmesg] = byte Deleted;
	status(s);
}

status(msg: string)
{
	tk->cmd(main, ".top.status configure -text {"+msg+"}; update");
}

disconnect()
{
	(err, s) := pop3cmd("QUIT");
	srv.dfd = nil;
	tk->cmd(main, ".top.con configure -text Connect");
	if(err != nil) {
		wmlib->dialog(main, "error -fg red", "Disconnect",
				"POP3 protocol problem\n"+err,
				0, "Proceed"::nil);
		return;
	}
	status(s);
}

connect(parent: ref Toplevel)
{
	(t, conctl) := wmlib->titlebar(ctxt.screen, postposn(parent),
				"Connection Parameters", 0);

	cmd := chan of string;
	tk->namechan(t, cmd, "cmd");

	wmlib->tkcmds(t, con_cfg);

	username = rf("/dev/user");
	s := rf("/usr/"+username+"/mail/popserver");
	if(s != "")
		tk->cmd(t, ".e.h insert 0 '"+s);

	u := tk->cmd(t, ".e.u get");
	if(u == "")
		tk->cmd(t, ".e.u insert 0 '"+username);

	tk->cmd(t, "update");

	for(;;) alt {
	ctl := <-conctl =>
		if(ctl[0] == 'e')
			return;
		wmlib->titlectl(t, ctl);
	s = <-cmd =>
		if(s == "can")
			return;
		server := tk->cmd(t, ".e.h get");
		if(server == "") {
			wmlib->dialog(t, "error -fg red", "Connect",
					"You must supply a server address",
					0, "Proceed"::nil);
			break;
		}
		user := tk->cmd(t, ".e.u get");
		if(user == "") {
			wmlib->dialog(t, "error -fg red", "Connect",
					"You must supply a user name",
					0, "Proceed"::nil);
			break;
		}
		pass := tk->cmd(t, ".e.s get");
		if(pass == "") {
			wmlib->dialog(t, "error -fg red", "Connect",
					"You must give a secret or password",
					0, "Proceed"::nil);
			break;
		}
		if(dialer(t, server, user, pass) != 0)
			return;
		status("not connected");
	}
	srv.dfd = nil;
}

initialize()
{
	(err, s) := pop3cmd("STAT");
	if(err != nil) {
		wmlib->dialog(main, "error -fg red", "Mailbox Status",
				"The following error occurred while "+
				    "checking your mailbox:\n"+err,
				0, "Dismiss"::nil);
		srv.dfd = nil;
		status("not connected");
		return;
	}

	tk->cmd(main, ".top.con configure -text Disconnect; update");
	nmesg = int s;
	if(nmesg == 0) {
		status("There are no messages.");
		return;
	}

	map = array[nmesg+1] of byte;
	for(i := 0; i <= nmesg; i++)
		map[i] = byte Ok;

	s = "";
	if(nmesg > 1)
		s = "s";
	status("You have "+string nmesg+" message"+s);
	cmesg = nmesg;
	loadmesg();
}

loadmesg()
{
	if(srv.dfd == nil) {
		wmlib->dialog(main, "warning -fg yellow", "Read",
				"You must be connected to read messages",
				0, "Continue"::nil);
		return;
	}
	(err, s) := pop3cmd("RETR "+sys->sprint("%d", cmesg));
	if(err != nil) {
		wmlib->dialog(main, "error -fg red", "Read",
				"Error retrieving message:\n"+err,
				0, "Continue"::nil);
		return;
	}

	tk->cmd(main, ".hdr.t delete 1.0 end; .body.t delete 1.0 end");
	size := int s;

	status("reading "+string size+" bytes ...");

	b := pop3body(size);

	(headr, body) := split(string b);
	b = nil;
	tk->cmd(main, ".hdr.t insert end '"+headr);
	tk->cmd(main, ".body.t insert end '"+body);
	tk->cmd(main, ".hdr.t see 1.0; .body.t see 1.0");
	status("read message "+string cmesg+" of "+string nmesg+" , ready...");
}

split(text: string): (string, string)
{
	c, lc: int;
	hdr, body: string;

	hp := 0;
	for(i := 0; i < len text; i++) {
		c = text[i];
		if(c == '\r')
			continue;
		hdr[hp++] = c;
		if(lc == '\n' && c == '\n')
			break;
		lc = c;
	}
	bp := 0;
	while(i < len text) {
		c = text[i++];
		if(c != '\r')
			body[bp++] = c;
	}
	return (hdr, body);
}

dialer(t: ref Toplevel, server, user, pass: string): int
{
	ok: int;

	for(;;) {
		status("dialing server...");
		(ok, srv) = sys->dial(server+"!110", nil);
		if(ok >= 0)
			break;

			labs := list of {
				"Retry",
				"Cancel"
			};
			ok = wmlib->dialog(t, "error -fg", "Connect",
					"The following error occurred while\n"+
					 "dialing the server: "+sys->sprint("%r"),
					0, labs);
			if(ok != 0)
				return 0;
	}
	status("connected...");
	(err, s) := pop3resp();
	if(err != nil) {
		wmlib->dialog(t, "error -fg red", "Connect",
				 "An error occurred during sign on.\n"+err,
				0, "Proceed"::nil);
		return 0;
	}
	status(s);
	(nil, s) = str->splitl(s, "<");
	(chal, nil) := str->splitr(s, ">");
	if(chal != nil){
		ca := array of byte chal;
		digest := array[kr->MD5dlen] of byte;
		md5state := kr->md5(ca, len ca, nil, nil);
		pa := array of byte pass;
		kr->md5(pa, len pa, digest, md5state);
		s = nil;
		for(i := 0; i < kr->MD5dlen; i++)
			s  += sys->sprint("%2.2ux", int digest[i]);
		(err, s) = pop3cmd("APOP "+user+" "+s);
		if(err == nil) {
			status("ready to serve...");
			return 1;
		} else {
			wmlib->dialog(t, "error -fg red", "Connect",
				 "Challenge/response failed.\n"+err,
				0, "Proceed"::nil);
			return 0;
		}
	}
	(err, s) = pop3cmd("USER "+user);
	if(err != nil) {
		wmlib->dialog(t, "error -fg red", "Connect",
				 "An error occurred during login.\n"+err,
				0, "Proceed"::nil);
		return 0;
	}
	(err, s) = pop3cmd("PASS "+pass);
	if(err != nil) {
		wmlib->dialog(t, "error -fg red", "Connect",
				 "An error occurred during login.\n"+err,
				0, "Proceed"::nil);
		return 0;
	}
	status("ready to serve...");
	return 1;
}

rf(file: string): string
{
	fd := sys->open(file, sys->OREAD);
	if(fd == nil)
		return "";

	buf := array[128] of byte;
	n := sys->read(fd, buf, len buf);
	if(n < 0)
		return "";

	return string buf[0:n];	
}

postposn(parent: ref Toplevel): string
{
	x := int tk->cmd(parent, ".top.con cget -actx");
	y := int tk->cmd(parent, ".top.con cget -acty");
	h := int tk->cmd(parent, ".top.con cget -height");

	return "-x "+string(x-2)+" -y "+string(y+h+2);
}

#
# Talk POP3
#
pop3cmd(cmd: string): (string, string)
{
	cmd += "\r\n";
#	sys->print("->%s", cmd);
	b := array of byte cmd;
	l := len b;
	n := sys->write(srv.dfd, b, l);
	if(n != l)
		return ("send to server:"+sys->sprint("%r"), nil);

	return pop3resp();
}

pop3resp(): (string, string)
{
	s := "";
	i := 0;
	lastc := 0;
	for(;;) {
		c := pop3getc();
		if(c == -1)
			return ("read from server:"+sys->sprint("%r"), nil);
		if(lastc == '\r' && c == '\n')
			break;
		s[i++] = c;
		lastc = c;
	}
#	sys->print("<-%s\n", s);
	if(i < 3)
		return ("short read from server", nil);
	s = s[0:i-1];
	if(s[0:3] == "+OK") {
		i = 3;
		while(i < len s && s[i] == ' ')
			i++;
		return (nil, s[i:]);
	}
	if(s[0:4] == "-ERR") {
		i = 4;
		while(s[i] == ' ' && i < len s)
			i++;
		return (s[i:], nil);
	}
	return ("invalid server response", nil);
}

pop3body(size: int): array of byte
{
	size += 512;
	b := array[size] of byte;

	cnt := emptypopbuf(b);
	size -= cnt;

	for(;;) {

		if(cnt > 5 && string b[cnt-5:cnt] == "\r\n.\r\n") {
			b = b[0:cnt-5];
			break;
		}
		# resize buffer
		if(size == 0) {
			nb := array[len b + 4096] of byte;
			nb[0:] = b;
			size = len nb - len b;
			b = nb;
			nb = nil;
		}
		n := sys->read(srv.dfd, b[cnt:], len b - cnt);
		if(n <= 0) {
			wmlib->dialog(main, "error -fg red", "Read",
				sys->sprint("Error retrieving message: %r"),
					0, "Continue"::nil);
			return nil;
		}
		size -= n;
		cnt += n;
	}
	return b;
}

Iob: adt
{
	nbyte:	int;
	posn:	int;
	buf:	array of byte;
};
popbuf: Iob;

pop3getc(): int
{
	if(popbuf.nbyte > 0) {
		popbuf.nbyte--;
		return int popbuf.buf[popbuf.posn++];
	}
	if(popbuf.buf == nil)
		popbuf.buf = array[512] of byte;

	popbuf.posn = 0;
	n := sys->read(srv.dfd, popbuf.buf, len popbuf.buf);
	if(n < 0)
		return -1;

	popbuf.nbyte = n-1;
	return int popbuf.buf[popbuf.posn++];
}

emptypopbuf(a: array of byte) : int
{
	i := popbuf.nbyte;

	if (i) {
		a[0:] = popbuf.buf[popbuf.posn:(popbuf.posn+popbuf.nbyte)];
		popbuf.nbyte = 0;
	}
	
	return i;
}