xref: /inferno-os/appl/wm/sendmail.b (revision 37da2899f40661e3e9631e497da8dc59b971cbd0)
1implement WmSendmail;
2
3include "sys.m";
4	sys: Sys;
5
6include "draw.m";
7	draw: Draw;
8	Context: import draw;
9
10include "tk.m";
11	tk: Tk;
12	Toplevel: import tk;
13
14include "tkclient.m";
15	tkclient: Tkclient;
16
17include "dialog.m";
18	dialog: Dialog;
19
20include "selectfile.m";
21	selectfile: Selectfile;
22
23WmSendmail: module
24{
25	init:	fn(ctxt: ref Draw->Context, args: list of string);
26};
27
28srv: Sys->Connection;
29main: ref Toplevel;
30ctxt: ref Context;
31username: string;
32
33mail_cfg := array[] of {
34	"frame .top",
35	"label .top.l -bitmap email.bit",
36	"frame .top.con",
37	"frame .top.con.b",
38	"button .top.con.b.con -bitmap mailcon -command {send msg connect}",
39	"bind .top.con.b.con <Enter> +{.top.status configure -text {connect/disconnect to mail server}}",
40	"button .top.con.b.send -bitmap maildeliver -command {send msg send}",
41	"bind .top.con.b.send <Enter> +{.top.status configure -text {deliver mail}}",
42
43	"button .top.con.b.nocc -bitmap mailnocc -command {.hdr.e.cc delete 0 end}",
44	"bind .top.con.b.nocc <Enter> +{.top.status configure -text {no carbon copy}}",
45
46	"button .top.con.b.new -bitmap mailnew -command {send msg new}",
47	"bind .top.con.b.new <Enter> +{.top.status configure -text {start a new message}}",
48	"button .top.con.b.save -bitmap mailsave -command {send msg save}",
49	"bind .top.con.b.save <Enter> +{.top.status configure -text {save message}}",
50	"pack .top.con.b.con .top.con.b.send .top.con.b.nocc .top.con.b.new .top.con.b.save -padx 2 -side left",
51	"label .top.status -text {not connected ...} -anchor w",
52	"pack .top.l -side left",
53	"pack .top.con -side left -padx 10",
54	"pack .top.con.b .top.status -in .top.con -fill x -expand 1",
55	"frame .hdr",
56	"frame .hdr.l",
57	"frame .hdr.e",
58	"label .hdr.l.mt -text {Mail To:}",
59	"label .hdr.l.cc -text {Mail CC:}",
60	"label .hdr.l.sb -text {Subject:}",
61	"pack .hdr.l.mt .hdr.l.cc .hdr.l.sb -fill y -expand 1",
62	"entry .hdr.e.mt -bg white",
63	"entry .hdr.e.cc -bg white",
64	"entry .hdr.e.sb -bg white",
65	"bind .hdr.e.mt <Key-\n> {}",
66	"bind .hdr.e.cc <Key-\n> {}",
67	"bind .hdr.e.sb <Key-\n> {}",
68	"pack .hdr.e.mt .hdr.e.cc .hdr.e.sb -fill x -expand 1",
69	"pack .hdr.l -side left -fill y",
70	"pack .hdr.e -side left -fill x -expand 1",
71	"frame .body",
72	"scrollbar .body.scroll -command {.body.t yview}",
73	"text .body.t -width 15c -height 7c -yscrollcommand {.body.scroll set} -bg white",
74	"pack .body.t -side left -expand 1 -fill both",
75	"pack .body.scroll -side left -fill y",
76	"pack .top -anchor w -padx 5",
77	"pack .hdr -fill x -anchor w -padx 5 -pady 5",
78	"pack .body -expand 1 -fill both -padx 5 -pady 5",
79	"pack .b -padx 5 -pady 5 -fill x",
80	"pack propagate . 0",
81	"update"
82};
83
84con_cfg := array[] of {
85	"frame .b",
86	"button .b.ok -text {Connect} -command {send cmd ok}",
87	"button .b.can -text {Cancel} -command {send cmd can}",
88	"pack .b.ok .b.can -side left -fill x -padx 10 -pady 10 -expand 1",
89	"frame .l",
90	"label .l.h -text {Mail Server:} -anchor w",
91	"label .l.u -text {User Name:} -anchor w",
92	"pack .l.h .l.u -fill both -expand 1",
93	"frame .e",
94	"entry .e.h -width 30w",
95	"entry .e.u -width 30w",
96	"pack .e.h .e.u -fill x",
97	"frame .f -borderwidth 2 -relief raised",
98	"pack .l .e -fill both -expand 1 -side left -in .f",
99	"bind .e.h <Key-\n> {send cmd ok}",
100	"bind .e.u <Key-\n> {send cmd ok}",
101};
102
103con_pack := array[] of {
104	"pack .f",
105	"pack .b -fill x -expand 1",
106	"focus .e.u",
107	"update",
108};
109
110new_cmd := array[] of {
111	".hdr.e.mt delete 0 end",
112	".hdr.e.cc delete 0 end",
113	".hdr.e.sb delete 0 end",
114	".body.t delete 1.0 end",
115	".body.t see 1.0",
116	"update"
117};
118
119init(xctxt: ref Context, argv: list of string)
120{
121	sys = load Sys Sys->PATH;
122	if (xctxt == nil) {
123		sys->fprint(sys->fildes(2), "sendmail: no window context\n");
124		raise "fail:bad context";
125	}
126	draw = load Draw Draw->PATH;
127	tk = load Tk Tk->PATH;
128	tkclient = load Tkclient Tkclient->PATH;
129	dialog = load Dialog Dialog->PATH;
130	selectfile = load Selectfile Selectfile->PATH;
131
132	ctxt = xctxt;
133
134	tkclient->init();
135	dialog->init();
136	selectfile->init();
137
138	tkargs := "";
139	argv = tl argv;
140	if(argv != nil) {
141		tkargs = hd argv;
142		argv = tl argv;
143	}
144
145	titlectl: chan of string;
146	(main, titlectl) = tkclient->toplevel(ctxt, tkargs,
147				"MailStop: Sender", Tkclient->Appl);
148
149	msg := chan of string;
150	tk->namechan(main, msg, "msg");
151
152	for (c:=0; c<len mail_cfg; c++)
153		tk->cmd(main, mail_cfg[c]);
154	tkclient->onscreen(main, nil);
155	tkclient->startinput(main, "kbd"::"ptr"::nil);
156
157	if(argv != nil)
158		fromreadmail(hd argv);
159
160	for(;;) alt {
161		s := <-main.ctxt.kbd =>
162			tk->keyboard(main, s);
163		s := <-main.ctxt.ptr =>
164			tk->pointer(main, *s);
165		s := <-main.ctxt.ctl or
166		s = <-main.wreq or
167		s = <-titlectl =>
168		if(s == "exit") {
169			if(srv.dfd == nil)
170				return;
171			status("Closing connection...");
172			smtpcmd("QUIT");
173			return;
174		}
175		tkclient->wmctl(main, s);
176	cmd := <-msg =>
177		case cmd {
178		"connect" =>
179			if(srv.dfd == nil) {
180				connect(main, 1);
181				fixbutton();
182				break;
183			}
184			disconnect();
185		"save" =>
186			save();
187		"send" =>
188			sendmail();
189		"new" =>
190			for (c=0; c<len new_cmd; c++)
191				tk->cmd(main, new_cmd[c]);
192		}
193	}
194}
195
196fixbutton()
197{
198	s := "Connect";
199	if(srv.dfd != nil)
200		s = "Disconnect";
201
202	tk->cmd(main, ".top.con configure -text "+s+"; update");
203}
204
205sendmail()
206{
207	if(srv.dfd == nil) {
208		dialog->prompt(ctxt, main.image, "error -fg red", "Send",
209				"You must be connected to deliver mail",
210				0, "Continue"::nil);
211		return;
212	}
213
214	mto := tk->cmd(main, ".hdr.e.mt get");
215	if(mto == "") {
216		dialog->prompt(ctxt, main.image, "error -fg red", "Send",
217				"You must fill in the \"Mail To\" entry",
218				0, "Continue (nothing sent)"::nil);
219		return;
220	}
221
222	if(tk->cmd(main, ".body.t index end") == "1.0") {
223		opt := "Cancel" :: "Send anyway" :: nil;
224		if(dialog->prompt(ctxt, main.image, "warning -fg yellow", "Send",
225				"The body of the mail is empty", 0, opt) == 0)
226			return;
227	}
228
229	(err, s) := smtpcmd("MAIL FROM:<"+username+">");
230	if(err != nil) {
231		dialog->prompt(ctxt, main.image, "error -fg red", "Send",
232				"Failed to specify FROM correctly:\n"+err,
233				0, "Continue (nothing sent)"::nil);
234		return;
235	}
236	status(s);
237	(err, s) = smtpcmd("RCPT TO:<"+mto+">");
238	if(err != nil) {
239		dialog->prompt(ctxt, main.image, "error -fg red", "Send",
240				"Failed to specify TO correctly:\n"+err,
241				0, "Continue (nothing sent)"::nil);
242		return;
243	}
244	status(s);
245	cc := tk->cmd(main, ".hdr.e.cc get");
246	if(cc != nil) {
247		(nil, l) := sys->tokenize(cc, "\t ,");
248		while(l != nil) {
249			copy := hd l;
250			(err, s) = smtpcmd("RCPT TO:<"+copy+">");
251			if(err != nil) {
252				dialog->prompt(ctxt, main.image, "error -fg red", "Send",
253					"Carbon copy to "+copy+"failed:\n"+err,
254					0, "Continue (nothing sent)"::nil);
255			}
256		}
257	}
258	(err, s) = smtpcmd("DATA");
259	if(err != nil) {
260		dialog->prompt(ctxt, main.image, "error -fg red", "Send",
261				"Failed to enter DATA mode:\n"+err,
262				0, "Continue (nothing sent)"::nil);
263		return;
264	}
265
266	sub := tk->cmd(main, ".hdr.e.sb get");
267	if(sub != nil)
268		sys->fprint(srv.dfd, "Subject: %s\n", sub);
269
270	b := array of byte tk->cmd(main, ".body.t get 1.0 end");
271	n := sys->write(srv.dfd, b, len b);
272	b = nil;
273	if(n < 0) {
274		dialog->prompt(ctxt, main.image, "error -fg red", "Send",
275				"Error writing server:\n"+sys->sprint("%r"),
276				0, "Abort (partial send)"::nil);
277		return;
278	}
279	(err, s) = smtpcmd("\r\n.");
280	if(err != nil) {
281		dialog->prompt(ctxt, main.image, "error -fg red", "Send",
282				"Failed to terminate message:\n"+err,
283				0, "Abort (partial send)"::nil);
284		return;
285	}
286	status(s);
287}
288
289save()
290{
291	mto := tk->cmd(main, ".hdr.e.to get");
292	if(mto == "") {
293		dialog->prompt(ctxt, main.image, "error -fg red", "Save",
294				"No message to save",
295				0, "Dismiss"::nil);
296		return;
297	}
298
299	pat := list of {
300		"*.letter (Saved mail)",
301		"* (All files)"
302	};
303
304	fname: string;
305	fd: ref Sys->FD;
306
307	for(;;) {
308		fname = selectfile->filename(ctxt, main.image, "Save in Mailbox", pat,
309					  "/usr/"+rf("/dev/user")+"/mail");
310		if(fname == nil)
311			return;
312
313		fd = sys->create(fname, sys->OWRITE, 8r660);
314		if(fd != nil)
315			break;
316		r := dialog->prompt(ctxt, main.image, "error -fg red", "Save",
317			"Failed to create "+sys->sprint("%s\n%r", fname),
318			0, "Retry"::"Cancel"::nil);
319		if(r > 0)
320			return;
321	}
322
323	r := sys->fprint(srv.dfd, "Mail To: %s\n", mto);
324	cc := tk->cmd(main, ".hdr.e.cc get");
325	if(cc != nil)
326		r += sys->fprint(srv.dfd, "Mail CC: %s\n", cc);
327	sb := tk->cmd(main, ".hdr.e.sb get");
328	if(sb != nil)
329		r += sys->fprint(srv.dfd, "Subject: %s\n\n", sb);
330
331	s := tk->cmd(main, ".body.t get 1.0 end");
332	b := array of byte s;
333	n := sys->write(fd, b, len b);
334	if(n < 0) {
335		dialog->prompt(ctxt, main.image, "error -fg red", "Save",
336			"Error writing file "+sys->sprint("%s\n%r", fname),
337			0, "Continue"::nil);
338		return;
339	}
340	status("wrote "+string(n+r)+" bytes.");
341}
342
343status(msg: string)
344{
345	tk->cmd(main, ".top.status configure -text {"+msg+"}; update");
346}
347
348disconnect()
349{
350	(err, s) := smtpcmd("QUIT");
351	srv.dfd = nil;
352	fixbutton();
353	if(err != nil) {
354		dialog->prompt(ctxt, main.image, "error -fg red", "Disconnect",
355					"Server problem:\n"+err,
356				0, "Dismiss"::nil);
357		return;
358	}
359	status(s);
360}
361
362connect(parent: ref Toplevel, interactive: int)
363{
364	(t, conctl) := tkclient->toplevel(ctxt, postposn(parent),
365					"Connection Parameters", 0);
366
367	cmd := chan of string;
368	tk->namechan(t, cmd, "cmd");
369
370	for (c:=0; c<len con_cfg; c++)
371		tk->cmd(t, con_cfg[c]);
372
373	username = rf("/dev/user");
374	s := rf("/usr/"+username+"/mail/smtpserver");
375	if(s != "")
376		tk->cmd(t, ".e.h insert 0 '"+s);
377
378	s = rf("/usr/"+username+"/mail/domain");
379	if(s != nil)
380		username += "@"+s;
381
382	u := tk->cmd(t, ".e.u get");
383	if(u == "")
384		tk->cmd(t, ".e.u insert 0 '"+username);
385
386	if(interactive == 0 && checkthendial(t) != 0)
387		return;
388
389	for (c=0; c<len con_pack; c++)
390		tk->cmd(t, con_pack[c]);
391	tkclient->onscreen(t, nil);
392	tkclient->startinput(t, "kbd"::"ptr"::nil);
393
394	for(;;) alt {
395		ss := <-t.ctxt.kbd =>
396			tk->keyboard(t, ss);
397		ss := <-t.ctxt.ptr =>
398			tk->pointer(t, *ss);
399		ss := <-t.ctxt.ctl or
400		ss = <-t.wreq or
401		ss = <-conctl =>
402			if (ss == "exit")
403				return;
404			tkclient->wmctl(t, ss);
405	s = <-cmd =>
406		if(s == "can")
407			return;
408		if(checkthendial(t) != 0)
409			return;
410		status("not connected");
411	}
412	srv.dfd = nil;
413}
414
415checkthendial(t: ref Toplevel): int
416{
417	server := tk->cmd(t, ".e.h get");
418	if(server == "") {
419		dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
420				"You must supply a server address",
421				0, "Continue"::nil);
422		return 0;
423	}
424	user := tk->cmd(t, ".e.u get");
425	if(user == "") {
426		dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
427				"You must supply a user name",
428				0, "Continue"::nil);
429		return 0;
430	}
431	if(dom(user) == "") {
432		dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
433				"The user name must contain an '@'",
434				0, "Continue"::nil);
435		return 0;
436	}
437	return dialer(t, server, user);
438}
439
440dialer(t: ref Toplevel, server, user: string): int
441{
442	ok: int;
443
444	status("dialing server...");
445	(ok, srv) = sys->dial(netmkaddr(server, nil, "25"), nil);
446	if(ok < 0) {
447		dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
448				"The following error occurred while\n"+
449				 "dialing the server: "+sys->sprint("%r"),
450				0, "Continue"::nil);
451		return 0;
452	}
453	status("connected...");
454	(err, s) := smtpresp();
455	if(err != nil) {
456		dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
457				"An error occurred during sign on.\n"+err,
458				0, "Continue"::nil);
459		return 0;
460	}
461	status(s);
462	(err, s) = smtpcmd("HELO "+dom(user));
463	if(err != nil) {
464		dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
465				"An error occurred during login.\n"+err,
466				0, "Continue"::nil);
467		return 0;
468	}
469	status("ready to send...");
470	return 1;
471}
472
473rf(file: string): string
474{
475	fd := sys->open(file, sys->OREAD);
476	if(fd == nil)
477		return "";
478
479	buf := array[128] of byte;
480	n := sys->read(fd, buf, len buf);
481	if(n < 0)
482		return "";
483
484	return string buf[0:n];
485}
486
487postposn(parent: ref Toplevel): string
488{
489	x := int tk->cmd(parent, ".top.con cget -actx");
490	y := int tk->cmd(parent, ".top.con cget -acty");
491	h := int tk->cmd(parent, ".top.con cget -height");
492
493	return "-x "+string(x-2)+" -y "+string(y+h+2);
494}
495
496dom(name: string): string
497{
498	for(i := 0; i < len name; i++)
499		if(name[i] == '@')
500			return name[i+1:];
501	return nil;
502}
503
504fromreadmail(hdr: string)
505{
506	(nil, l) := sys->tokenize(hdr, "\n");
507	while(l != nil) {
508		s := hd l;
509		l = tl l;
510		n := match(s, "subject: ");
511		if(n != nil) {
512			tk->cmd(main, ".hdr.e.sb insert end '"+n);
513			continue;
514		}
515		n = match(s, "cc: ");
516		if(n != nil) {
517			tk->cmd(main, ".hdr.e.cc insert end '"+n);
518			continue;
519		}
520		n = match(s, "from: ");
521		if(n != nil) {
522			n = extract(n);
523			tk->cmd(main, ".hdr.e.mt insert end '"+n);
524		}
525	}
526	connect(main, 0);
527}
528
529extract(name: string): string
530{
531	for(i := 0; i < len name; i++) {
532		if(name[i] == '<') {
533			for(j := i+1; j < len name; j++)
534				if(name[j] == '>')
535					break;
536			return name[i+1:j];
537		}
538	}
539	for(i = 0; i < len name; i++)
540		if(name[i] == ' ')
541			break;
542	return name[0:i];
543}
544
545lower(c: int): int
546{
547	if(c >= 'A' && c <= 'Z')
548		c = 'a' + (c - 'A');
549	return c;
550}
551
552match(text, pat: string): string
553{
554	for(i := 0; i < len pat; i++) {
555		c := text[i];
556		p := pat[i];
557		if(c != p && lower(c) != p)
558			return "";
559	}
560	return text[i:];
561}
562
563#
564# Talk SMTP
565#
566smtpcmd(cmd: string): (string, string)
567{
568	cmd += "\r\n";
569#	sys->print("->%s", cmd);
570	b := array of byte cmd;
571	l := len b;
572	n := sys->write(srv.dfd, b, l);
573	if(n != l)
574		return ("send to server:"+sys->sprint("%r"), nil);
575
576	return smtpresp();
577}
578
579smtpresp(): (string, string)
580{
581	s := "";
582	i := 0;
583	lastc := 0;
584	for(;;) {
585		c := smtpgetc();
586		if(c == -1)
587			return ("read from server:"+sys->sprint("%r"), nil);
588		if(lastc == '\r' && c == '\n')
589			break;
590		s[i++] = c;
591		lastc = c;
592	}
593#	sys->print("<-%s\n", s);
594	if(i < 3)
595		return ("short read from server", nil);
596	s = s[0:i-1];
597	case s[0] {
598	'1' or '2' or '3' =>
599		i = 3;
600		while(s[i] == ' ' && i < len s)
601			i++;
602		return (nil, s[i:]);
603	'4'or '5' =>
604		i = 3;
605		while(s[i] == ' ' && i < len s)
606			i++;
607		return (s[i:], nil);
608	 * =>
609		return ("invalid server response", nil);
610	}
611}
612
613Iob: adt
614{
615	nbyte:	int;
616	posn:	int;
617	buf:	array of byte;
618};
619smtpbuf: Iob;
620
621smtpgetc(): int
622{
623	if(smtpbuf.nbyte > 0) {
624		smtpbuf.nbyte--;
625		return int smtpbuf.buf[smtpbuf.posn++];
626	}
627	if(smtpbuf.buf == nil)
628		smtpbuf.buf = array[512] of byte;
629
630	smtpbuf.posn = 0;
631	n := sys->read(srv.dfd, smtpbuf.buf, len smtpbuf.buf);
632	if(n < 0)
633		return -1;
634
635	smtpbuf.nbyte = n-1;
636	return int smtpbuf.buf[smtpbuf.posn++];
637}
638
639netmkaddr(addr, net, svc: string): string
640{
641	if(net == nil)
642		net = "net";
643	(n, l) := sys->tokenize(addr, "!");
644	if(n <= 1){
645		if(svc== nil)
646			return sys->sprint("%s!%s", net, addr);
647		return sys->sprint("%s!%s!%s", net, addr, svc);
648	}
649	if(svc == nil || n > 2)
650		return addr;
651	return sys->sprint("%s!%s", addr, svc);
652}
653