summaryrefslogtreecommitdiff
path: root/appl/wm/sendmail.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/wm/sendmail.b')
-rw-r--r--appl/wm/sendmail.b652
1 files changed, 652 insertions, 0 deletions
diff --git a/appl/wm/sendmail.b b/appl/wm/sendmail.b
new file mode 100644
index 00000000..da28eca2
--- /dev/null
+++ b/appl/wm/sendmail.b
@@ -0,0 +1,652 @@
+implement WmSendmail;
+
+include "sys.m";
+ sys: Sys;
+
+include "draw.m";
+ draw: Draw;
+ Context: import draw;
+
+include "tk.m";
+ tk: Tk;
+ Toplevel: import tk;
+
+include "tkclient.m";
+ tkclient: Tkclient;
+
+include "dialog.m";
+ dialog: Dialog;
+
+include "selectfile.m";
+ selectfile: Selectfile;
+
+WmSendmail: module
+{
+ init: fn(ctxt: ref Draw->Context, args: list of string);
+};
+
+srv: Sys->Connection;
+main: ref Toplevel;
+ctxt: ref Context;
+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.send -bitmap maildeliver -command {send msg send}",
+ "bind .top.con.b.send <Enter> +{.top.status configure -text {deliver mail}}",
+
+ "button .top.con.b.nocc -bitmap mailnocc -command {.hdr.e.cc delete 0 end}",
+ "bind .top.con.b.nocc <Enter> +{.top.status configure -text {no carbon copy}}",
+
+ "button .top.con.b.new -bitmap mailnew -command {send msg new}",
+ "bind .top.con.b.new <Enter> +{.top.status configure -text {start a new message}}",
+ "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.send .top.con.b.nocc .top.con.b.new .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",
+ "frame .hdr.l",
+ "frame .hdr.e",
+ "label .hdr.l.mt -text {Mail To:}",
+ "label .hdr.l.cc -text {Mail CC:}",
+ "label .hdr.l.sb -text {Subject:}",
+ "pack .hdr.l.mt .hdr.l.cc .hdr.l.sb -fill y -expand 1",
+ "entry .hdr.e.mt -bg white",
+ "entry .hdr.e.cc -bg white",
+ "entry .hdr.e.sb -bg white",
+ "bind .hdr.e.mt <Key-\n> {}",
+ "bind .hdr.e.cc <Key-\n> {}",
+ "bind .hdr.e.sb <Key-\n> {}",
+ "pack .hdr.e.mt .hdr.e.cc .hdr.e.sb -fill x -expand 1",
+ "pack .hdr.l -side left -fill y",
+ "pack .hdr.e -side left -fill x -expand 1",
+ "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",
+ "pack .l.h .l.u -fill both -expand 1",
+ "frame .e",
+ "entry .e.h -width 30w",
+ "entry .e.u -width 30w",
+ "pack .e.h .e.u -fill x",
+ "frame .f -borderwidth 2 -relief raised",
+ "pack .l .e -fill both -expand 1 -side left -in .f",
+ "bind .e.h <Key-\n> {send cmd ok}",
+ "bind .e.u <Key-\n> {send cmd ok}",
+};
+
+con_pack := array[] of {
+ "pack .f",
+ "pack .b -fill x -expand 1",
+ "focus .e.u",
+ "update",
+};
+
+new_cmd := array[] of {
+ ".hdr.e.mt delete 0 end",
+ ".hdr.e.cc delete 0 end",
+ ".hdr.e.sb delete 0 end",
+ ".body.t delete 1.0 end",
+ ".body.t see 1.0",
+ "update"
+};
+
+init(xctxt: ref Context, argv: list of string)
+{
+ sys = load Sys Sys->PATH;
+ if (xctxt == nil) {
+ sys->fprint(sys->fildes(2), "sendmail: no window context\n");
+ raise "fail:bad context";
+ }
+ draw = load Draw Draw->PATH;
+ tk = load Tk Tk->PATH;
+ tkclient = load Tkclient Tkclient->PATH;
+ dialog = load Dialog Dialog->PATH;
+ selectfile = load Selectfile Selectfile->PATH;
+
+ ctxt = xctxt;
+
+ tkclient->init();
+ dialog->init();
+ selectfile->init();
+
+ tkargs := "";
+ argv = tl argv;
+ if(argv != nil) {
+ tkargs = hd argv;
+ argv = tl argv;
+ }
+
+ titlectl: chan of string;
+ (main, titlectl) = tkclient->toplevel(ctxt, tkargs,
+ "MailStop: Sender", Tkclient->Appl);
+
+ msg := chan of string;
+ tk->namechan(main, msg, "msg");
+
+ for (c:=0; c<len mail_cfg; c++)
+ tk->cmd(main, mail_cfg[c]);
+ tkclient->onscreen(main, nil);
+ tkclient->startinput(main, "kbd"::"ptr"::nil);
+
+ if(argv != nil)
+ fromreadmail(hd argv);
+
+ for(;;) alt {
+ s := <-main.ctxt.kbd =>
+ tk->keyboard(main, s);
+ s := <-main.ctxt.ptr =>
+ tk->pointer(main, *s);
+ s := <-main.ctxt.ctl or
+ s = <-main.wreq or
+ s = <-titlectl =>
+ if(s == "exit") {
+ if(srv.dfd == nil)
+ return;
+ status("Closing connection...");
+ smtpcmd("QUIT");
+ return;
+ }
+ tkclient->wmctl(main, s);
+ cmd := <-msg =>
+ case cmd {
+ "connect" =>
+ if(srv.dfd == nil) {
+ connect(main, 1);
+ fixbutton();
+ break;
+ }
+ disconnect();
+ "save" =>
+ save();
+ "send" =>
+ sendmail();
+ "new" =>
+ for (c=0; c<len new_cmd; c++)
+ tk->cmd(main, new_cmd[c]);
+ }
+ }
+}
+
+fixbutton()
+{
+ s := "Connect";
+ if(srv.dfd != nil)
+ s = "Disconnect";
+
+ tk->cmd(main, ".top.con configure -text "+s+"; update");
+}
+
+sendmail()
+{
+ if(srv.dfd == nil) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Send",
+ "You must be connected to deliver mail",
+ 0, "Continue"::nil);
+ return;
+ }
+
+ mto := tk->cmd(main, ".hdr.e.mt get");
+ if(mto == "") {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Send",
+ "You must fill in the \"Mail To\" entry",
+ 0, "Continue (nothing sent)"::nil);
+ return;
+ }
+
+ if(tk->cmd(main, ".body.t index end") == "1.0") {
+ opt := "Cancel" :: "Send anyway" :: nil;
+ if(dialog->prompt(ctxt, main.image, "warning -fg yellow", "Send",
+ "The body of the mail is empty", 0, opt) == 0)
+ return;
+ }
+
+ (err, s) := smtpcmd("MAIL FROM:<"+username+">");
+ if(err != nil) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Send",
+ "Failed to specify FROM correctly:\n"+err,
+ 0, "Continue (nothing sent)"::nil);
+ return;
+ }
+ status(s);
+ (err, s) = smtpcmd("RCPT TO:<"+mto+">");
+ if(err != nil) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Send",
+ "Failed to specify TO correctly:\n"+err,
+ 0, "Continue (nothing sent)"::nil);
+ return;
+ }
+ status(s);
+ cc := tk->cmd(main, ".hdr.e.cc get");
+ if(cc != nil) {
+ (nil, l) := sys->tokenize(cc, "\t ,");
+ while(l != nil) {
+ copy := hd l;
+ (err, s) = smtpcmd("RCPT TO:<"+copy+">");
+ if(err != nil) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Send",
+ "Carbon copy to "+copy+"failed:\n"+err,
+ 0, "Continue (nothing sent)"::nil);
+ }
+ }
+ }
+ (err, s) = smtpcmd("DATA");
+ if(err != nil) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Send",
+ "Failed to enter DATA mode:\n"+err,
+ 0, "Continue (nothing sent)"::nil);
+ return;
+ }
+
+ sub := tk->cmd(main, ".hdr.e.sb get");
+ if(sub != nil)
+ sys->fprint(srv.dfd, "Subject: %s\n", sub);
+
+ b := array of byte tk->cmd(main, ".body.t get 1.0 end");
+ n := sys->write(srv.dfd, b, len b);
+ b = nil;
+ if(n < 0) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Send",
+ "Error writing server:\n"+sys->sprint("%r"),
+ 0, "Abort (partial send)"::nil);
+ return;
+ }
+ (err, s) = smtpcmd("\r\n.");
+ if(err != nil) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Send",
+ "Failed to terminate message:\n"+err,
+ 0, "Abort (partial send)"::nil);
+ return;
+ }
+ status(s);
+}
+
+save()
+{
+ mto := tk->cmd(main, ".hdr.e.to get");
+ if(mto == "") {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Save",
+ "No message to save",
+ 0, "Dismiss"::nil);
+ return;
+ }
+
+ pat := list of {
+ "*.letter (Saved mail)",
+ "* (All files)"
+ };
+
+ fname: string;
+ fd: ref Sys->FD;
+
+ for(;;) {
+ fname = selectfile->filename(ctxt, main.image, "Save in Mailbox", pat,
+ "/usr/"+rf("/dev/user")+"/mail");
+ if(fname == nil)
+ return;
+
+ fd = sys->create(fname, sys->OWRITE, 8r660);
+ if(fd != nil)
+ break;
+ r := dialog->prompt(ctxt, main.image, "error -fg red", "Save",
+ "Failed to create "+sys->sprint("%s\n%r", fname),
+ 0, "Retry"::"Cancel"::nil);
+ if(r > 0)
+ return;
+ }
+
+ r := sys->fprint(srv.dfd, "Mail To: %s\n", mto);
+ cc := tk->cmd(main, ".hdr.e.cc get");
+ if(cc != nil)
+ r += sys->fprint(srv.dfd, "Mail CC: %s\n", cc);
+ sb := tk->cmd(main, ".hdr.e.sb get");
+ if(sb != nil)
+ r += sys->fprint(srv.dfd, "Subject: %s\n\n", sb);
+
+ 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) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Save",
+ "Error writing file "+sys->sprint("%s\n%r", fname),
+ 0, "Continue"::nil);
+ return;
+ }
+ status("wrote "+string(n+r)+" bytes.");
+}
+
+status(msg: string)
+{
+ tk->cmd(main, ".top.status configure -text {"+msg+"}; update");
+}
+
+disconnect()
+{
+ (err, s) := smtpcmd("QUIT");
+ srv.dfd = nil;
+ fixbutton();
+ if(err != nil) {
+ dialog->prompt(ctxt, main.image, "error -fg red", "Disconnect",
+ "Server problem:\n"+err,
+ 0, "Dismiss"::nil);
+ return;
+ }
+ status(s);
+}
+
+connect(parent: ref Toplevel, interactive: int)
+{
+ (t, conctl) := tkclient->toplevel(ctxt, postposn(parent),
+ "Connection Parameters", 0);
+
+ cmd := chan of string;
+ tk->namechan(t, cmd, "cmd");
+
+ for (c:=0; c<len con_cfg; c++)
+ tk->cmd(t, con_cfg[c]);
+
+ username = rf("/dev/user");
+ s := rf("/usr/"+username+"/mail/smtpserver");
+ if(s != "")
+ tk->cmd(t, ".e.h insert 0 '"+s);
+
+ s = rf("/usr/"+username+"/mail/domain");
+ if(s != nil)
+ username += "@"+s;
+
+ u := tk->cmd(t, ".e.u get");
+ if(u == "")
+ tk->cmd(t, ".e.u insert 0 '"+username);
+
+ if(interactive == 0 && checkthendial(t) != 0)
+ return;
+
+ for (c=0; c<len con_pack; c++)
+ tk->cmd(t, con_pack[c]);
+ tkclient->onscreen(t, nil);
+ tkclient->startinput(t, "kbd"::"ptr"::nil);
+
+ for(;;) alt {
+ ss := <-t.ctxt.kbd =>
+ tk->keyboard(t, ss);
+ ss := <-t.ctxt.ptr =>
+ tk->pointer(t, *ss);
+ ss := <-t.ctxt.ctl or
+ ss = <-t.wreq or
+ ss = <-conctl =>
+ if (ss == "exit")
+ return;
+ tkclient->wmctl(t, ss);
+ s = <-cmd =>
+ if(s == "can")
+ return;
+ if(checkthendial(t) != 0)
+ return;
+ status("not connected");
+ }
+ srv.dfd = nil;
+}
+
+checkthendial(t: ref Toplevel): int
+{
+ server := tk->cmd(t, ".e.h get");
+ if(server == "") {
+ dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
+ "You must supply a server address",
+ 0, "Continue"::nil);
+ return 0;
+ }
+ user := tk->cmd(t, ".e.u get");
+ if(user == "") {
+ dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
+ "You must supply a user name",
+ 0, "Continue"::nil);
+ return 0;
+ }
+ if(dom(user) == "") {
+ dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
+ "The user name must contain an '@'",
+ 0, "Continue"::nil);
+ return 0;
+ }
+ return dialer(t, server, user);
+}
+
+dialer(t: ref Toplevel, server, user: string): int
+{
+ ok: int;
+
+ status("dialing server...");
+ (ok, srv) = sys->dial(netmkaddr(server, nil, "25"), nil);
+ if(ok < 0) {
+ dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
+ "The following error occurred while\n"+
+ "dialing the server: "+sys->sprint("%r"),
+ 0, "Continue"::nil);
+ return 0;
+ }
+ status("connected...");
+ (err, s) := smtpresp();
+ if(err != nil) {
+ dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
+ "An error occurred during sign on.\n"+err,
+ 0, "Continue"::nil);
+ return 0;
+ }
+ status(s);
+ (err, s) = smtpcmd("HELO "+dom(user));
+ if(err != nil) {
+ dialog->prompt(ctxt, t.image, "error -fg red", "Connect",
+ "An error occurred during login.\n"+err,
+ 0, "Continue"::nil);
+ return 0;
+ }
+ status("ready to send...");
+ 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);
+}
+
+dom(name: string): string
+{
+ for(i := 0; i < len name; i++)
+ if(name[i] == '@')
+ return name[i+1:];
+ return nil;
+}
+
+fromreadmail(hdr: string)
+{
+ (nil, l) := sys->tokenize(hdr, "\n");
+ while(l != nil) {
+ s := hd l;
+ l = tl l;
+ n := match(s, "subject: ");
+ if(n != nil) {
+ tk->cmd(main, ".hdr.e.sb insert end '"+n);
+ continue;
+ }
+ n = match(s, "cc: ");
+ if(n != nil) {
+ tk->cmd(main, ".hdr.e.cc insert end '"+n);
+ continue;
+ }
+ n = match(s, "from: ");
+ if(n != nil) {
+ n = extract(n);
+ tk->cmd(main, ".hdr.e.mt insert end '"+n);
+ }
+ }
+ connect(main, 0);
+}
+
+extract(name: string): string
+{
+ for(i := 0; i < len name; i++) {
+ if(name[i] == '<') {
+ for(j := i+1; j < len name; j++)
+ if(name[j] == '>')
+ break;
+ return name[i+1:j];
+ }
+ }
+ for(i = 0; i < len name; i++)
+ if(name[i] == ' ')
+ break;
+ return name[0:i];
+}
+
+lower(c: int): int
+{
+ if(c >= 'A' && c <= 'Z')
+ c = 'a' + (c - 'A');
+ return c;
+}
+
+match(text, pat: string): string
+{
+ for(i := 0; i < len pat; i++) {
+ c := text[i];
+ p := pat[i];
+ if(c != p && lower(c) != p)
+ return "";
+ }
+ return text[i:];
+}
+
+#
+# Talk SMTP
+#
+smtpcmd(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 smtpresp();
+}
+
+smtpresp(): (string, string)
+{
+ s := "";
+ i := 0;
+ lastc := 0;
+ for(;;) {
+ c := smtpgetc();
+ 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];
+ case s[0] {
+ '1' or '2' or '3' =>
+ i = 3;
+ while(s[i] == ' ' && i < len s)
+ i++;
+ return (nil, s[i:]);
+ '4'or '5' =>
+ i = 3;
+ while(s[i] == ' ' && i < len s)
+ i++;
+ return (s[i:], nil);
+ * =>
+ return ("invalid server response", nil);
+ }
+}
+
+Iob: adt
+{
+ nbyte: int;
+ posn: int;
+ buf: array of byte;
+};
+smtpbuf: Iob;
+
+smtpgetc(): int
+{
+ if(smtpbuf.nbyte > 0) {
+ smtpbuf.nbyte--;
+ return int smtpbuf.buf[smtpbuf.posn++];
+ }
+ if(smtpbuf.buf == nil)
+ smtpbuf.buf = array[512] of byte;
+
+ smtpbuf.posn = 0;
+ n := sys->read(srv.dfd, smtpbuf.buf, len smtpbuf.buf);
+ if(n < 0)
+ return -1;
+
+ smtpbuf.nbyte = n-1;
+ return int smtpbuf.buf[smtpbuf.posn++];
+}
+
+netmkaddr(addr, net, svc: string): string
+{
+ if(net == nil)
+ net = "net";
+ (n, l) := sys->tokenize(addr, "!");
+ if(n <= 1){
+ if(svc== nil)
+ return sys->sprint("%s!%s", net, addr);
+ return sys->sprint("%s!%s!%s", net, addr, svc);
+ }
+ if(svc == nil || n > 2)
+ return addr;
+ return sys->sprint("%s!%s", addr, svc);
+}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 22:52:39 +0000