/pliant/appli/mail.pli
1	module "/pliant/language/unsafe.pli"
2	module "/pliant/language/context.pli"
3	module "/pliant/language/stream.pli"
4	module "/pliant/admin/file.pli"
5	module "/pliant/fullpliant/this_computer.pli"
6	module "/pliant/fullpliant/user.pli"
7	module "/pliant/appli/mail/database.pli"
8	module "/pliant/protocol/smtp/mail.pli"
9	module "/pliant/protocol/smtp/meta.pli"
10	module "/pliant/protocol/smtp/forward.pli"
11	module "/pliant/protocol/smtp/spam.pli"
12	module "/pliant/protocol/http/server.pli"
13	module "/pliant/protocol/http/style/default.style"
14	module "/pliant/util/encoding/base64.pli"
15	module "/pliant/util/encoding/date.pli"
16	module "/pliant/util/encoding/http.pli"
17	module "/pliant/util/encoding/qp.pli"
18	module "/pliant/util/crypto/random.pli"
19	module "/pliant/language/schedule/resourcesem.pli"
20	module "/pliant/protocol/smtp/mime.pli"
21	module "/pliant/protocol/common/mime.pli"
22
23	constant emil_is_available false # (file_query "embedded:/usr/bin/emil" standard)=success
24	if emil_is_available
25	module "/pliant/language/stream/pipe.pli"
26	module "/pliant/admin/execute.pli"
27
28	function smart_name s -> n
29	arg Str s n
30	if not (s parse "[dq]" any:n "[dq]" any) or n=""
31	if not (s parse any:n "<" any) or n=""
32	if not (s parse any "<" any:n ">" any) or n=""
33	n := s
34
35	function stripped_name n -> s
36	arg Str n s
37	if not (n parse any "<" any:s ">" any)
38	n parse any:s
39
40
41	function mail_path -> p
42	arg Str p
43	p := this_computer:env:"pliant":"mail":"path"
44	if p=""
45	p := "data:/pliant/mail/"
46
47
48
49
50
51	#  send
52
53
54	function mail_reset user
55	arg Str user
56	mail_database2:data:current delete user
57	file_tree_delete mail_path+"attach/"+user+"/"
58
59
60	function mail_reply user mailbox filename all
61	arg Str user mailbox filename ; arg CBool all
62	(var Stream s) open filename in+safe+anyeol
63	(var MimeStream ms) bind s true ; var Str from subject ; var List:Str to cc
64	while (ms header_line (var Str l))
65	if (l parse acword:"subject" ":" any:(var Str value))
66	ms_decode value
67	subject := value
68	eif (l parse acword:"from" ":" any:(var Str value))
69	from := value
70	eif (l parse acword:"to" ":" any:(var Str value))
71	while value<>""
72	if not (value parse any:(var Str first) "," any:(var Str remain))
73	first := value ; remain := ""
74	if first<>mailbox and not (first parse any "<" pattern:mailbox ">" any)
75	to += first
76	value := remain
77	eif (l parse acword:"cc" ":" any:(var Str value))
78	while value<>""
79	if not (value parse any:(var Str first) "," any:(var Str remain))
80	first := value ; remain := ""
81	if first<>mailbox and not (first parse any "<" pattern:mailbox ">" any)
82	cc += first
83	value := remain
84	var Str body := smart_name:from+" wrote:[lf]>[lf]"
85	if not ms:multipart
86	while (ms body_line l)
87	body += "> "+l
88	else
89	while (ms body_line l)
90	void
91	while not s:atend
92	ms bind s false
93	while (ms header_line l)
94	void
95	while (ms body_line l)
96	if ms:name="" and ms:mime="text/plain"
97	body += "> "+l
98	mail_reset user
99	mail_database2:data:current create user
100	var Data:MailCurrent current :> mail_database2:data:current user
101	current from := mailbox
102	current:target create ""
103	current:target:"" box := from
104	if all
105	var Pointer:Str t :> to first
106	while exists:t
107	var Str id := generate_id
108	current:target create id
109	current:target:id box := t
110	t :> to next t
111	var Pointer:Str t :> cc first
112	while exists:t
113	var Str id := generate_id
114	current:target create id
115	current:target:id box := t
116	current:target:id mode := "cc"
117	t :> cc next t
118	current subject := shunt (lower:subject parse "re:" any) subject "Re: "+subject
119	current body := body
120
121
122	function mail_send user area -> status
123	arg Str user area ; arg Status status
124	part build "build mail file"
125	var Data:MailCurrent current :> mail_database2:data:current user
126	var Data:MailBox m :> mailbox current:from
127	if not exists:m
128	return failure
129	var DateTime timestamp := datetime
130	timestamp split (var Int year) (var Int month) (var Int day) (var Int hour) (var Int minute) (var Int second) (var Float fraction)
131	var Str id := generate_id
132	(var Stream s) open m:out_path+id+".tmp" out+cr+lf+safe+mkdir
133	# console "sending message " user " in file " s:name eol
134	var (Link Database:MailMeta) db :> new Database:MailMeta
135	db load m:out_path+id+".pdb"
136	var Data:MailMeta meta :> db data
137	meta queued_on := timestamp
138	var Str from := (mailbox current:from):name
139	from := from+(shunt from<>"" " " "")+"<"+current:from+">"
140	s writeline "From: "+from
141	meta from := from
142	var Str tos := "" ; var Str ccs := ""
143	each t current:target
144	if t:box<>""
145	if (t:box parse word:"all" any:(var Str keyword))
146	each ubm user_database2:data:user:user:bookmark
147	if ubm:mailbox<>"" and (keyword="" or (ubm:keywords parse any word:keyword any))
148	var Str id2 := "b"+keyof:ubm
149	var Str box2 := ubm:name+" <"+ubm:mailbox+">"
150	meta:target create id2
151	meta:target:id2:box := box2
152	if t:mode<>"cc"
153	tos += (shunt tos<>"" ",[lf]  " "")+box2
154	else
155	ccs += (shunt ccs<>"" ",[lf]  " "")+box2
156	else
157	var Str id2 := keyof t
158	meta:target create id2
159	meta:target:id2:box := t box
160	if t:mode<>"cc"
161	tos += (shunt tos<>"" ",[lf]  " "")+t:box
162	else
163	ccs += (shunt ccs<>"" ",[lf]  " "")+t:box
164	if tos<>""
165	s writeline "To: "+tos
166	if ccs<>""
167	s writeline "Cc: "+ccs
168	s writeline "Subject: "+current:subject
169	s writeline "Date: "+rfc1123_date:timestamp
170	s writeline "Message-ID: <"+generate_id+"@"+computer_fullname+">"
171	s writeline "X-Mailer: Pliant "+string:pliant_release_number
172	var Array:FileInfo attached := file_list mail_path+"attach/"+user+"/" standard+relative
173	if attached:size>0
174	var Str boundary := (repeat 8 "-")
175	for (var Int i) 1 (max 128\8\uInt:size 1)
176	var uInt rnd ; memory_strong_random addressof:rnd Int:size
177	boundary += string rnd "radix 36"
178	s writeline "MIME-Version: 1.0"
179	s writeline "Content-Type: multipart/mixed; boundary=[dq]"+(boundary 2 boundary:len)+"[dq]"
180	else
181	s writeline "Content-Type: text/plain; charset=iso-8859-1"
182	s writeline "Content-Transfer-Encoding: 8bit"
183	s writeline ""
184	if attached:size=0
185	s writeline current:body
186	else
187	s writeline "This is a multi-part message in MIME format."
188	s writeline boundary
189	s writeline "Content-Type: text/plain; charset=iso-8859-1"
190	s writeline "Content-Transfer-Encoding: 8bit"
191	s writeline ""
192	s writeline current:body
193	for (var Int i) 0 attached:size-1
194	s writeline boundary
195	s writeline "Content-Type: application/octet-stream; name=[dq]"+attached:i:name+"[dq]"
196	s writeline "Content-Transfer-Encoding: base64"
197	s writeline "Content-Disposition: attachment; filename=[dq]"+attached:i:name+"[dq]"
198	s writeline ""
199	part attach "encode attached file"
200	(var Stream a) open mail_path+"attach/"+user+"/"+attached:i:name in+safe
201	while not a:atend
202	a read_available (var Address adr) (var Int step) 54
203	if step=54
204	(var Str bytes) set adr step false
205	else
206	bytes set (memory_allocate step null) step true
207	memory_copy adr bytes:characters step
208	while bytes:len<54 and not a:atend
209	a read_available (var Address adr) (var Int step) 54-bytes:len
210	(var Str extra) set adr step false
211	bytes += extra
212	s writeline base64_encode:bytes
213	s writeline boundary+"--"
214	s close
215	db store
216	var Str apath := m:archive_path+string:year+(right string:month 2 "0")+"/"+(right string:day 2 "0")+"/"
217	file_tree_create apath
218	if (file_clone m:out_path+id+".tmp" apath+id+".mail")=failure
219	file_copy m:out_path+id+".tmp" apath+id+".mail"
220	if area<>""
221	if (file_clone m:out_path+id+".tmp" m:area_path+area+"/"+id+".mail")=failure
222	file_copy m:out_path+id+".tmp" m:area_path+area+"/"+id+".mail"
223	file_move m:out_path+id+".tmp" m:out_path+id+".mail"
224	file_directory_flush m:out_path+id+".mail"
225	file_hook m:out_path+id+".mail"
226	file_hook m:out_path+id+"pdb"
227	forward_mails
228	forward_mail m:out_path+id+".mail" true "forward a just posted mail"
229	status := success
230
231
232	method page mail_edit user
233	arg_rw HtmlPage page ; arg Str user
234	mail_database2:data:current create user
235	var Data:MailCurrent current :> mail_database2:data:current:user
236	implicit page
237	title "Send a mail"
238	table columns 3 border 0
239	cell [From]
240	cell
241	each umb user:user:mailbox
242	if current:from=""
243	current:from := umb
244	select "" current:from
245	each umb user:user:mailbox
246	option umb umb
247	cell void
248	each t current:target
249	if t:box<>"" and keyof:t<>""
250	cell
251	text t:mode
252	cell
253	text t:box
254	cell
255	button "Delete"
256	current:target delete keyof:t
257	reload_page
258	current:target create ""
259	cell
260	select "" current:target:"":mode
261	option "To" "to"
262	option "Cc" "cc"
263	cell
264	var Str cvalue := current:target:"":box
265	select "" current:target:"":box noeol
266	option "" ""
267	var CBool already := false
268	each ubm user_database2:data:user:user:bookmark filter ubm:mailbox<>"" and (current:keyword="" or (ubm:keywords parse any (word current:keyword) any)) sort ubm:name+" "+ubm:first_name
269	var Str blabel := (shunt ubm:first_name<>"" ubm:first_name+" " "")+ubm:name
270	var Str bvalue := blabel+" <"+ubm:mailbox+">"
271	option blabel bvalue
272	if current:keyword<>""
273	option "all "+current:keyword "all "+current:keyword
274	input "" current:target:"":box length 30 noeol
275	cell
276	button "One more line"
277	var Str id := string datetime:seconds
278	current:target create id
279	data_copy current:target:"" current:target:id
280	current:target delete ""
281	reload_page
282	cell [Subject]
283	cell
284	input "" current:subject length 40
285	cell void
286	text_input "Message:[lf]" current:body columns 80 rows 20
287	var Array:FileInfo files := file_list mail_path+"attach/"+user+"/" standard+relative
288	if files:size>0
289	var Intn total := 0
290	table columns 3
291	cell header [Attached file]
292	cell header [Size in bytes]
293	cell void
294	for (var Int i) 0 files:size-1
295	cell
296	text files:i:name
297	cell
298	text (string files:i:size)
299	cell
300	var Str attached_file := files:i:name
301	small
302	button "discard"
303	file_delete mail_path+"attach/"+user+"/"+attached_file
304	reload_page
305	total += files:i:size
306	cell header [Total]
307	cell
308	text string:total+" ("+(string (total+2^19)\2^20)+" MB)"
309	cell void
310	file_upload "File name: " (var Str attach) noeol
311	button "Attach the file"
312	var Str remote := attach option "remote_name" Str
313	file_move attach mail_path+"attach/"+user+"/"+remote
314	reload_page
315	para
316	button "Reset the mail" noeol
317	title "Reset the mail"
318	[Are you sure you want to reset the mail content without sending it ?] ; eol
319	button "Yes" noeol
320	mail_reset user
321	goto_backward
322	button "No"
323	goto_backward
324	button "Save the current content" noeol
325	reload_page
326	button "Preview then send"
327	plugin outgoing_mail_control
328	var CBool some := false
329	each t current:target
330	if t:box<>""
331	some := true
332	if not some
333	[You have not set any recipient for the mail !]
334	para
335	button "edit again"
336	goto_backward
337	else
338	goto_url "preview" no_extension
339	para
340	input "Keyword: " current:keyword noeol
341	button "Select bookmarks matching the keyword"
342	reload_page
343
344
345	method page mail_preview user
346	arg_rw HtmlPage page ; arg Str user
347	mail_database2:data:current create user
348	var Data:MailCurrent current :> mail_database2:data:current:user
349	implicit page
350	table columns 1
351	cell color (color hsl 50 5 75)
352	table columns 2 border 0
353	cell [From:]
354	cell
355	text current:from
356	each t current:target
357	if t:box<>""
358	cell
359	text (shunt t:mode<>"cc" "To:" "Cc:")
360	cell
361	text t:box
362	cell [Subject:]
363	cell
364	bold
365	text current:subject
366	fixed
367	text current:body
368	var Array:FileInfo files := file_list mail_path+"attach/"+user+"/" standard+relative
369	if files:size>0
370	para
371	var Intn total := 0
372	table columns 2
373	cell header [Attached file]
374	cell header [Size in bytes]
375	for (var Int i) 0 files:size-1
376	cell
377	text files:i:name
378	cell
379	text (string files:i:size)
380	total += files:i:size
381	cell header [Total]
382	cell
383	text string:total+" ("+(string (total+2^19)\2^20)+" MB)"
384	para
385	var Str area
386	button "Send it" noeol
387	mail_send user area
388	mail_reset user
389	goto_backward 2
390	var Data:MailBox m :> mailbox current:from
391	var Array:FileInfo areas := file_list m:area_path standard+relative+directories
392	if areas:size<>0
393	select "and store in in area " area noeol
394	option "" ""
395	for (var Int i) 0 areas:size-1
396	var Str area := areas:i:name
397	area := area 0 (area search "/" area:len)
398	option area area
399	eol
400	button "Edit again"
401	goto_backward
402
403
404
405	# read
406
407
408	method page send_mime_part filename part http_options emil -> status
409	arg_rw HtmlPage page ; arg Str filename part http_options ; arg CBool emil ; arg Status status
410	var List:Str boundaries
411	var Stream s
412	if emil_is_available and emil
413	stream_pipe (var Str in_stream) (var Str out_stream)
414	execute "emil -F MIME -B BA" root "embedded:/" input filename output out_stream detached
415	s open in_stream in+safe+anyeol
416	else
417	s open filename in+safe+anyeol
418	(var MimeStream ms) bind s true
419	while (ms header_line (var Str l))
420	void
421	if ms:multipart
422	while (ms body_line l)
423	void
424	while not s:atend
425	ms bind s false
426	while (ms header_line l)
427	void
428	if ms:name=part and (http_options<>"html" or ms:mime="text/html") and ms:mime<>"application/applefile"
429	if emil_is_available and ms:encoding_model=undefined and not emil
430	page send_mime_part filename part http_options true
431	return
432	var Str temp := file_temporary
433	(var Stream t) open temp out+safe
434	while (ms body_line l)
435	t writechars l
436	t close
437	var Str ext := lower:part (part search_last "." part:len) part:len
438	if ext=".htm"
439	ext := ".html"
440	page reset_http_answer
441	page:http_request send_static_file temp "mime [dq]"+(shunt http_options="binary" "binary/*" http_options="text" "text/plain" query_mime_type:ext)+"[dq]"
442	file_delete temp
443	return success
444	else
445	while (ms body_line l)
446	void
447	status := failure
448
449
450	method page mail_display user box filename buttons back_level http_options
451	arg_rw HtmlPage page ; arg Str user ; arg Data:MailBox box ; arg Str filename ; arg Str buttons ; arg Int back_level ; arg Str http_options
452	implicit page
453	var CBool detailed := http_options="detailed"
454	var Str subject
455	var Str from
456	var List:Str tos
457	var List:Str ccs
458	var Str date
459	var List:Str extras
460	var List:Str boundaries
461	var CBool quoted := false
462	var CBool spam := false
463	(var Stream s) open filename in+safe+anyeol
464	(var MimeStream ms) bind s true
465	while (ms header_line (var Str l))
466	if (l parse acword:"subject" ":" any:(var Str value))
467	ms_decode value
468	subject := value
469	eif (l parse acword:"from" ":" any:(var Str value))
470	ms_decode value
471	from := value
472	eif (l parse acword:"to" ":" any:(var Str value))
473	ms_decode value
474	tos += value
475	eif (l parse acword:"cc" ":" any:(var Str value))
476	ms_decode value
477	ccs += value
478	eif (l parse acword:"date" ":" any:(var Str value))
479	date := value
480	eif (l parse acword:"spam" any)
481	spam := true
482	if detailed
483	extras += l
484	table columns 1
485	cell color (color hsl 60 5 75)
486	table columns 2 border 0
487	if from<>""
488	cell [From:]
489	cell
490	if (from parse "[dq]" any:(var Str realname) "[dq]" "<" any:(var Str remain))
491	bold text:realname ; text " <"+remain
492	eif (from parse any:(var Str realname) "<" any:(var Str remain))
493	bold text:realname ; text "<"+remain
494	else
495	text from
496	if (exists tos:first)
497	cell [To:]
498	cell
499	var Pointer:Str to :> tos first
500	while exists:to
501	text to ; eol
502	to :> tos next to
503	if (exists ccs:first)
504	cell [Cc:]
505	cell
506	var Pointer:Str cc :> ccs first
507	while exists:cc
508	text cc ; eol
509	cc :> ccs next cc
510	if subject<>""
511	cell [Subject:]
512	cell (bold text:subject)
513	if date<>""
514	cell [Date:]
515	cell text:date
516	cell void
517	cell
518	if http_options<>"detailed"
519	small (link "detailed header" "" options "detailed" relative no_extension)
520	if http_options<>"text"
521	fixed [ ] ; small (link "raw text" "" options "text" relative no_extension)
522	if (exists boundaries:first)
523	fixed [ ] ; small [(this is a multipart message)]
524	fixed [ ]
525	small
526	if spam
527	note "not a spam"
528	set_spam_mark filename false
529	reload_page
530	else
531	note "a spam"
532	set_spam_mark filename true
533	reload_page
534	fixed [ ]
535	small
536	page note "spam rating"
537	spam_load_dictionary (box smart_path "")+"spam_filter.txt" (var (Dictionary Str Float) filter) (var Float html_adust) (var Float suspicious_adjust) (var Float unknown_threshold) (var Float spam_threshold)
538	var Float rating := spam_filter filename filter html_adust suspicious_adjust (var Str report)
539	text "Spam probability for this mail is avaluated to "+(string rating*100 "fixed 0")+"%" ; eol
540	text "Your current unknown threshold for is "+(string unknown_threshold*100 "fixed 0")+"%, "
541	text "and your current spam threshold is "+(string spam_threshold*100 "fixed 0")+"%, " ; eol
542	text "so this one would be "+(shunt rating>spam_threshold "rejected" rating>unknown_threshold "unknown" "accepted")+"."
543	para
544	[Detailed spam filter report:] ; eol
545	fixed text:report
546	cell
547	if detailed
548	small
549	var Pointer:Str extra :> extras first
550	while exists:extra
551	text extra ; eol
552	extra :> extras next extra
553	if (buttons search "R" -1)<>(-1)
554	button "reply" noeol
555	mail_reply user keyof:box filename false
556	goto_url (repeat back_level "../")+"send" no_extension
557	button "reply to all" noeol
558	mail_reply user keyof:box filename true
559	goto_url (repeat back_level "../")+"send" no_extension
560	if (buttons search "D" -1)<>(-1)
561	button "delete" noeol
562	file_delete filename
563	file_hook filename
564	goto_backward
565	if (buttons search "B" -1)<>(-1)
566	var Str mailbox := stripped_name from
567	var (Data Set:UserBookmark) bookmark :> user_database2:data:user:user:bookmark
568	var CBool already := false
569	each b2 bookmark
570	if b2:mailbox=mailbox
571	already := true
572	if not already
573	page button "Add to bookmarks" noeol
574	bookmark create mailbox
575	var Data:UserBookmark b :> bookmark mailbox
576	b name := smart_name from
577	b mailbox := mailbox
578	title "New bookmark"
579	table columns 2
580	cell [Name: ]
581	cell (input "" b:name length 40)
582	cell [Abstract: ]
583	cell (text_input "" b:abstract columns 60 rows 5)
584	cell [Mailbox: ]
585	cell (input "" b:mailbox length 40)
586	cell [Home page / URL: ]
587	cell (input "" b:url length 40)
588	cell [Contact: ]
589	cell (text_input "" b:contact columns 60 rows 5)
590	cell [Keywords: ]
591	cell (input "" b:keywords length 60)
592	button "Record" noeol
593	goto_backward
594	button "Cancel bookmark creation"
595	bookmark delete mailbox
596	goto_backward
597	if (buttons search "M" -1)<>(-1)
598	var Array:FileInfo areas := file_list box:area_path standard+relative+directories
599	if areas:size<>0
600	fixed [  ]
601	select "Area: " (var Str area) noeol
602	for (var Int i) 0 areas:size-1
603	var Str area := areas:i:name
604	area := area 0 (area search "/" area:len)
605	option area area
606	button "move to area" noeol
607	var Str base := filename (filename search_last "/" filename:len)+1 filename:len
608	file_move filename box:area_path+area+"/"+base
609	goto_backward
610	if http_options="text" or spam
611	fixed
612	(var Stream s) open filename in+safe
613	while not s:atend
614	s read_available (var Address adr) (var Int size) 256
615	(var Str chars) set adr size false
616	text chars
617	eif ms:html
618	while (ms body_line l)
619	html l
620	eif  ms:multipart
621	while (ms body_line l)
622	void
623	while not s:atend
624	var List:Str extras := var List:Str empty_list
625	ms bind s false
626	while (ms header_line l)
627	if detailed
628	extras += l
629	if ms:name<>""
630	if ms:mime<>"application/applefile"
631	table columns (shunt detailed 3 2)
632	cell
633	if (ms:name (ms:name search_last "." ms:name:len) ms:name:len)=".htm"
634	link ms:name ms:name options "html" relative no_extension
635	else
636	link ms:name ms:name relative no_extension
637	cell
638	small (link "view" ms:name options "text" relative no_extension)
639	fixed [ ] ; small (link "download" ms:name options "binary" relative no_extension)
640	if detailed
641	cell
642	small
643	var Pointer:Str extra :> extras first
644	while exists:extra
645	text extra ; eol
646	extra :> extras next extra
647	while (ms body_line l)
648	void
649	else
650	while (ms body_line l)
651	void
652	eif ms:mime="text/html"
653	table columns 2 border 0
654	cell color (color hsl 0 0 90)
655	var CBool body := false ; var CBool nobody := false
656	while (ms body_line l)
657	if (l parse "<" word:"BODY" any ">" any:(var Str remain)) or (l parse "<" word:"body" any ">" any:(var Str remain))
658	l := remain ; body := true
659	if (reverse:l parse (pattern reverse:"</HTML>") any:(var Str remain)) or (reverse:l parse (pattern reverse:"</html>") any:(var Str remain))
660	l := reverse remain
661	if (reverse:l parse (pattern reverse:"</BODY>") any:(var Str remain)) or (reverse:l parse (pattern reverse:"</body>") any:(var Str remain))
662	l := reverse remain ; nobody := true
663	if body
664	html l
665	if nobody
666	body := false ; nobody := false
667	cell color (color hsl 0 0 90)
668	small (link "view" "" options "html" relative no_extension)
669	else
670	fixed
671	while (ms body_line l)
672	text l
673	else
674	fixed
675	while (ms body_line l)
676	text l
677
678
679	method page mail_list category box filepath subpath
680	arg_rw HtmlPage page ; arg Str category ; arg Data:MailBox box ; arg Str filepath subpath
681	implicit page
682	var Array:FileInfo files := file_list filepath standard+relative+sorted
683	if files:size>0
684	if exists:box
685	text upper:(category 0 1)+(category 1 category:len)+"s received in" ; fixed (text " "+keyof:box)
686	table columns 3
687	cell header [From]
688	cell header [Subject]
689	cell void
690	for (var Int i) 0 files:size-1
691	if files:i:extension=".mail"
692	var Str filename := filepath+files:i:name
693	var Str from := "" ; var Str subject := ""
694	(var Stream s) open filename in+safe+anyeol
695	(var MimeStream ms) bind s true
696	while (ms header_line (var Str l))
697	if (l parse acword:"from" ":" any:(var Str from1))
698	ms_decode from1
699	from := from1
700	if (l parse acword:"subject" ":" any:(var Str subject1))
701	ms_decode subject1
702	subject := subject1
703	cell
704	text smart_name:from
705	if category="unknown mail"
706	cell color (color hsl 60 50 80)
707	link (shunt subject<>"" subject "no subject") subpath+files:i:stripped_name+"/" relative no_extension
708	else
709	cell
710	link (shunt subject<>"" subject "no subject") subpath+files:i:stripped_name+"/" relative no_extension
711	cell
712	small
713	note "delete"
714	file_delete filename
715	file_hook filename
716	reload_page
717	fixed [ ]
718	if (subpath eparse "in/" any) and (reverse:filename eparse any:(var Str tail) (pattern reverse:"/in/") any:(var Str head))
719	note "a spam"
720	var Str spam := reverse:head+"/spam/"+reverse:tail
721	file_tree_create spam
722	file_move filename spam
723	set_spam_mark spam true
724	file_hook filename
725	file_hook spam
726	reload_page
727	eif ( (subpath eparse "unknown/" any) and (reverse:filename eparse any:(var Str tail) (pattern reverse:"/unknown/") any:(var Str head)) ) or ( (subpath eparse "spam/" any) and (reverse:filename eparse any:(var Str tail) (pattern reverse:"/spam/") any:(var Str head)) )
728	note "not a spam"
729	var Str normal := reverse:head+"/in/"+reverse:tail
730	file_tree_create normal
731	file_move filename normal
732	set_spam_mark normal false
733	file_hook filename
734	file_hook normal
735	reload_page
736
737	method page mail_list user
738	arg_rw HtmlPage page ; arg Str user
739	implicit page
740	title "'"+user+"' mailboxes"
741	each umb user:user:mailbox
742	var Data:MailBox m :> mailbox umb
743	if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
744	mail_list "mail" m m:in_path "in/"+domain+"/"+box+"/"
745	each umb user:user:mailbox
746	var Data:MailBox m :> mailbox umb
747	if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
748	var Array:FileInfo files := file_list m:out_path standard+relative
749	if files:size>0
750	[Mails sent from] ; fixed (text " "+keyof:m)
751	table columns 3
752	cell header [To]
753	cell header [Subject]
754	cell void
755	for (var Int i) 0 files:size-1
756	if files:i:extension=".mail"
757	var Str subject := ""
758	(var Stream s) open m:out_path+files:i:name in+safe
759	(var MimeStream ms) bind s true
760	while (ms header_line (var Str l))
761	if (l parse acword:"subject" ":" any:(var Str subject1))
762	subject := subject1
763	var (Link Database:MailMeta) db :> new Database:MailMeta
764	db load m:out_path+files:i:stripped_name+".pdb"
765	var Data:MailMeta meta :> db data
766	cell
767	each t meta:target
768	if t:status="S"
769	font color (color hsl 120 0 75)
770	text (smart_name t:box) ; eol
771	eif t:status="R"
772	font color (color hsl 0 100 50)
773	text (smart_name t:box) ; eol
774	eif (t:last_error parse word:"sending" any)
775	font color (color hsl 60 80 80)
776	text (smart_name t:box) ; eol
777	eif t:last_error<>""
778	font color (color hsl 30 80 80)
779	text (smart_name t:box) ; eol
780	else
781	text (smart_name t:box) ; eol
782	cell
783	text subject
784	cell
785	var Str name := m:out_path+files:i:stripped_name
786	note "details"
787	var (Link Database:MailMeta) db2 :> new Database:MailMeta
788	db2 load name+".pdb"
789	var Data:MailMeta meta2 :> db2 data
790	table columns 6
791	cell header [Target mailbox]
792	cell header [Status]
793	cell header [Try count]
794	cell header [Last tryed on]
795	cell header [... to server]
796	cell header [... reported error]
797	each t2 meta2:target
798	cell
799	text t2:box
800	if t2:status="S"
801	cell color (color hsl 120 30 80)
802	[Sent]
803	eif t2:status="R"
804	cell color (color hsl 0 30 80)
805	[Rejected]
806	eif (t2:last_error parse word:"sending" any)
807	cell color (color hsl 60 30 80)
808	[Currently sending]
809	eif t2:last_error<>""
810	cell color (color hsl 30 30 80)
811	[Temporary rejected]
812	else
813	cell
814	[Not tried yet]
815	cell
816	text (string t2:try_count)
817	cell
818	text (string t2:last_try)
819	cell
820	text t2:last_server
821	cell
822	if (t2:last_error parse word:"sending" any:(var Str meter))
823	text meter
824	else
825	text t2:last_error
826	button "Try to forward now" noeol
827	forward_mail name+".mail" false "try to forward a mail right now"
828	goto_backward
829	if allowed:"advanced_mail"
830	button "Forward to any SMTP server of the target domain" noeol
831	forward_path name+".mail" "" "indirect"
832	forward_mail name+".mail" false "try to forward a mail to anybody right now"
833	goto_backward
834	if this_computer:env:"pliant":"mail":"forward_isp"<>""
835	button "Forward to our ISP" noeol
836	forward_path name+".mail" this_computer:env:"pliant":"mail":"forward_isp" ""
837	forward_mail name+".mail" false "try to forward a mail to our ISP right now"
838	goto_backward
839	button "Delete"
840	file_delete name+".mail"
841	file_delete name+".pdb"
842	file_hook name+".mail"
843	file_hook name+".pdb"
844	goto_backward
845
846	else
847	text "Mailbox "+keyof:m+" is not defined !"
848
849	method page spam_list user
850	arg_rw HtmlPage page ; arg Str user
851	implicit page
852	para
853	table columns 2 border 0
854	cell
855	var Int total := 0
856	each umb user:user:mailbox
857	var Data:MailBox m :> mailbox umb
858	if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
859	var Array:FileInfo unknown := file_list m:unknown_path standard+relative
860	var Array:FileInfo spam := file_list m:spam_path standard+relative
861	if unknown:size>0 or spam:size>0
862	small
863	fixed (text keyof:m+": ")
864	if unknown:size>0
865	text (string unknown:size)+" unknown mail"+(shunt unknown:size>1 "s" "")
866	if unknown:size>0 and spam:size>0
867	[, ]
868	if spam:size>0
869	text (string spam:size)+" spam"+(shunt spam:size>1 "s" "")
870	eol
871	total += unknown:size+spam:size
872	cell
873	if total>0
874	page note "spams cleanup"
875	var DateTime timestamp := datetime
876	title "Spams cleanup"
877	for (var Int lap) 0 1
878	each umb user:user:mailbox
879	var Data:MailBox m :> mailbox umb
880	if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
881	para
882	mail_list (shunt lap=0 "unknown mail" "spam") m (shunt lap=0 m:unknown_path m:spam_path) (shunt lap=0 "unknown" "spam")+"/"+domain+"/"+box+"/"
883	page button "Delete all at once"
884	for (var Int lap) 0 1
885	each umb user:user:mailbox
886	var Data:MailBox m :> mailbox umb
887	if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
888	var Array:FileInfo spams := file_list (shunt lap=0 m:unknown_path m:spam_path) standard
889	for (var Int i) 0 spams:size-1
890	if spams:i:datetime<timestamp
891	file_delete spams:i:name
892	goto_backward
893
894
895
896	# search
897
898
899	method page mail_search user
900	arg_rw HtmlPage page ; arg Str user
901	var Data:MailCurrent current :> mail_database2:data:current:user
902	implicit page
903	title "Search in the mail archives"
904	table columns 2 border 0
905	cell [From]
906	cell (input "" (var Str from) length 30)
907	cell [To/Cc]
908	cell (input "" (var Str to) length 30)
909	cell [Subject]
910	cell (input "" (var Str subject) length 30)
911	cell [Content]
912	cell (text_input "" (var Str content) columns 30 rows 3)
913	cell [Raw content]
914	cell (text_input "" (var Str raw) columns 30 rows 3)
915	cell [Days]
916	var Int days := 30
917	cell (input "" days length 5)
918	button "Search now"
919	part search "search mail archives"
920	title "Mail archives search result"
921	var Array:Str contents ; var Array:CBool content_oks
922	while content<>""
923	if not (content parse any:(var Str first) "[lf]" any:(var Str remain))
924	first := content ; remain := ""
925	if first<>""
926	contents += lower first ; content_oks += false
927	content := remain
928	var Array:Str raws ; var Array:CBool raw_oks
929	while raw<>""
930	if not (raw parse any:(var Str first) "[lf]" any:(var Str remain))
931	first := raw ; remain := ""
932	if first<>""
933	raws += lower first ; raw_oks += false
934	raw := remain
935	para
936	[Search for mails:]
937	list
938	if from<>""
939	item
940	[containing] ; fixed (text " "+from+" ") ; [in the from field.] ; eol
941	if to<>""
942	item
943	[containing] ; fixed (text " "+to+" ") ; [in one of the to or cc fields.] ; eol
944	if subject<>""
945	item
946	[containing] ; fixed (text " "+subject+" ") ; [in the subject field.] ; eol
947	for (var Int i) 0 contents:size-1
948	item
949	[containing] ; fixed (text " "+contents:i+" ") ; [in the body of the message.] ; eol
950	for (var Int i) 0 raws:size-1
951	item
952	[containing] ; fixed (text " "+raws:i+" ") ; [in the raw message.] ; eol
953	item
954	[received at most] ; fixed (text " "+string:days+" ") ; [days ago.] ; eol
955	table columns 4
956	cell header [Date]
957	cell header [From]
958	cell header [To]
959	cell header [Subject]
960	var Date today := datetime date
961	for (var Int j) days 0 step -1
962	today-j split (var Int year) (var Int month) (var Int day)
963	each umb user:user:mailbox
964	var Data:MailBox m :> mailbox umb
965	if exists:m and (keyof:m parse any:(var Str box) "@" any:(var Str domain))
966	var Str apath := m:archive_path+string:year+(right string:month 2 "0")+"/"+(right string:day 2 "0")+"/"
967	var Array:FileInfo files := file_list apath standard+sorted
968	for (var Int i) 0 files:size-1
969	part scan_one "scan mail "+files:i:name
970	var Str from2 := "" ; var Str to2 := "" ; var Str subject2 := "" ; var Str boundary := ""
971	var CBool from_ok := false
972	var CBool to_ok := false
973	var CBool subject_ok := false
974	(var Stream s) open files:i:name in+safe+anyeol
975	(var MimeStream ms) bind s true
976	while (ms header_line (var Str l))
977	if (l parse acword:"from" ":" any:(var Str value))
978	ms_decode value
979	if from<>"" and (lower:value search lower:from -1)<>(-1)
980	from_ok := true
981	from2 := value
982	eif (l parse acword:"to" ":" any:(var Str value)) or (l parse acword:"cc" ":" any:(var Str value))
983	ms_decode value
984	if to<>"" and (lower:value search lower:to -1)<>(-1)
985	to_ok := true
986	to2 += (shunt to2<>"" "," "")+value
987	eif (l parse acword:"subject" ":" any:(var Str value))
988	ms_decode value
989	if subject<>"" and (lower:value search lower:subject -1)<>(-1)
990	subject_ok := true
991	subject2 := value
992	if (from<>"" and not from_ok) or (to<>"" and not to_ok) or (subject<>"" and not subject_ok)
993	leave scan_one
994	if contents:size>0
995	for (var Int u) 0 content_oks:size-1
996	content_oks u := false
997	if not ms:multipart
998	while (ms body_line l)
999	l := lower l
1000	for (var Int u) 0 content_oks:size-1
1001	if (l search contents:u -1)<>(-1)
1002	content_oks u := true
1003	else
1004	part scan_mime_parts
1005	while (ms body_line l)
1006	void
1007	while not s:atend
1008	ms bind s false
1009	while (ms header_line l)
1010	void
1011	if ms:name="" and ms:mime="text/plain"
1012	while (ms body_line l)
1013	l := lower l
1014	for (var Int u) 0 content_oks:size-1
1015	if (l search contents:u -1)<>(-1)
1016	content_oks u := true
1017	eif ms:name<>""
1018	leave scan_mime_parts
1019	else
1020	while (ms body_line l)
1021	void
1022	for (var Int u) 0 content_oks:size-1
1023	if not content_oks:u
1024	leave scan_one
1025	if raws:size>0
1026	for (var Int u) 0 raw_oks:size-1
1027	raw_oks u := false
1028	s configure "seek 0"
1029	while not s:atend
1030	var Str l := lower s:readline
1031	for (var Int u) 0 raw_oks:size-1
1032	if (l search raws:u -1)<>(-1)
1033	raw_oks u := true
1034	for (var Int u) 0 raw_oks:size-1
1035	if not raw_oks:u
1036	leave scan_one
1037	cell
1038	text (string today-j)
1039	cell
1040	text smart_name:from2
1041	cell
1042	small
1043	while to2<>""
1044	if not (to2 parse any:(var Str value) "," any:(var Str remain))
1045	value := to2 ; remain := ""
1046	text smart_name:value ; eol
1047	to2 := remain
1048	cell
1049	link (shunt subject2<>"" subject2 "no subject") "archive/"+domain+"/"+box+"/"+string:year+(right string:month 2 "0")+"/"+(right string:day 2 "0")+"/"+files:i:stripped_name+"/" relative no_extension
1050	para
1051	[A search on the raw content is slow.]
1052
1053
1054	method page mail_bookmarks user
1055	arg_rw HtmlPage page ; arg Str user
1056	user_database2:data:user create user
1057	var (Data Set:UserBookmark) bookmark :> user_database2:data:user:user:bookmark
1058	implicit page
1059	title "'"+user+"' bookmarks"
1060	table columns 5
1061	cell header [Line ID]
1062	cell header [First name]
1063	cell header [Name]
1064	cell header [Keywords]
1065	cell void
1066	each b bookmark sort b:name+" "+b:first_name
1067	cell
1068	text keyof:b
1069	cell
1070	text b:first_name
1071	cell
1072	text b:name
1073	cell
1074	text b:keywords
1075	cell
1076	button "Edit"
1077	title "Bookmark"
1078	table columns 2
1079	cell [First name: ]
1080	cell (input "" b:first_name length 40)
1081	cell [Name: ]
1082	cell (input "" b:name length 40)
1083	cell [Abstract: ]
1084	cell (text_input "" b:abstract columns 60 rows 5)
1085	cell [Mailbox: ]
1086	cell (input "" b:mailbox length 40)
1087	cell [Home page / URL: ]
1088	cell (input "" b:url length 40)
1089	cell [Contact: ]
1090	cell (text_input "" b:contact columns 60 rows 5)
1091	cell [Keywords: ]
1092	cell (input "" b:keywords length 60)
1093	button "Record"
1094	goto_backward
1095	input "Line ID: " (var Str lid) noeol
1096	button "Create the bookmark" noeol
1097	bookmark create lid
1098	reload_page
1099	button "Delete the bookmark"
1100	bookmark delete lid
1101	reload_page
1102
1103
1104	method page mail_create_area user
1105	arg_rw HtmlPage page ; arg Str user
1106	implicit page
1107	title "Create a new mail area"
1108	select "In which mailbox: " (var Str box)
1109	each umb user:user:mailbox
1110	option umb umb
1111	input "New area name: " (var Str name)
1112	button "Create it"
1113	var Data:MailBox b :> mailbox box
1114	if exists:b
1115	file_tree_create b:area_path+name+"/"
1116	goto_backward
1117
1118	method page mail_delete_area user
1119	arg_rw HtmlPage page ; arg Str user
1120	implicit page
1121	title "Delete a new mail area"
1122	select "Area: " (var Str what)
1123	option "" ""
1124	each umb user:user:mailbox
1125	var Array:FileInfo areas := file_list mailbox:umb:area_path standard+directories+relative
1126	for (var Int i) 0 areas:size-1
1127	if (file_list mailbox:umb:area_path+areas:i:name standard):size=0
1128	var Str name := areas:i:name
1129	name := name 0 (name search_last "/" name:len)
1130	option name+" in "+umb+" mailbox" string:umb+" "+(string areas:i:name)
1131	button "Delete it"
1132	if (what parse (var Str mailbox) (var Str area))
1133	each umb user:user:mailbox
1134	if umb=mailbox
1135	file_delete mailbox:umb:area_path+area+"/"
1136	goto_backward
1137	para
1138	[You can delete an area only if it is empty.]
1139
1140	method page set_spam_filter user
1141	arg_rw HtmlPage page ; arg Str user
1142	implicit page
1143	title "Set the spam filter"
1144	var Str box := "all"
1145	select "Set spam filter for " box
1146	each umb user:user:mailbox
1147	option "mailbox "+umb umb
1148	option "all mailboxes" "all"
1149	var Int days := 120
1150	input "studying " days length 3 noeol ; [ days mail archives] ; eol
1151	var Float html_adjust100 := 50
1152	input "assuming HTML mails spam probablity is " html_adjust100 length 4 noeol ; [%] ; eol
1153	var Float suspicious_adjust100 := 50
1154	input "and suspicious mails spam probability is " suspicious_adjust100 length 4 noeol ; [%] ; eol
1155	var Float unknown_threshold100 := 50
1156	input "using an unknown threshold of " unknown_threshold100 length 4 noeol ; [%] ; eol
1157	var Float spam_threshold100 := 90
1158	input "and a spam threshold of " spam_threshold100 length 4 noeol ; [%] ; eol
1159	var Int vdays := 120
1160	input "then test the filter against " vdays length 3 noeol ; [days mail archives] ; eol
1161	page button "set spam filter" noeol
1162	var Array:Str mailboxes paths
1163	each umb1 user:user:mailbox
1164	var Data:MailBox m1 :> mailbox umb1
1165	if exists:m1 and (keyof:m1=box or box="all")
1166	mailboxes += keyof m1 ; paths += m1 archive_path
1167	var Str temp := file_temporary
1168	var DateTime since := datetime ; since seconds -= days*86400
1169	spam_study paths since html_adjust100/100 suspicious_adjust100/100 unknown_threshold100/100 spam_threshold100/100 temp
1170	for (var Int i) 0 mailboxes:size-1
1171	var Data:MailBox m1 :> mailbox mailboxes:i
1172	file_copy temp (m1 smart_path "")+"spam_filter.txt"
1173	file_delete (m1 smart_path "")+"spam_ip.txt" # old ones
1174	file_delete (m1 smart_path "")+"spam_word.txt"
1175	spam_load_dictionary temp (var (Dictionary Str Float) filter) (var Float html_adjust) (var Float suspicious_adjust) (var Float unknown_threshold) (var Float spam_threshold)
1176	file_delete temp
1177	var DateTime since := datetime ; since seconds -= vdays*86400
1178	var Int count := 0
1179	for (var Int p) 0 paths:size-1
1180	var Array:FileInfo files := file_list paths:p standard+recursive+relative
1181	for (var Int i) 0 files:size-1
1182	if files:i:datetime>=since
1183	count += 1
1184	var Int spam_rejected := 0 ; var Int spam_unknown := 0 ; var Int spam_accepted := 0
1185	var Int valid_rejected := 0 ; var Int valid_unknown := 0 ; var Int valid_accepted := 0
1186	table columns 5
1187	cell header [Date]
1188	cell header [From]
1189	cell header [To]
1190	cell header [Subject]
1191	cell header [Rating]
1192	var Int current := 0
1193	for (var Int p) 0 paths:size-1
1194	var Array:FileInfo files := file_list paths:p standard+recursive+relative
1195	for (var Int i) 0 files:size-1
1196	if files:i:datetime>=since
1197	current += 1
1198	part test "test mail filter "+string:current+"/"+string:count
1199	(var Stream s) open paths:p+files:i:name in+safe
1200	var CBool spam := s:readline parse acword:"spam" any
1201	s close
1202	var Float rating := spam_filter paths:p+files:i:name filter html_adjust suspicious_adjust (var Str report)
1203	var Int level := shunt rating>spam_threshold 1 rating>unknown_threshold 0 -1
1204	if spam
1205	if level>0
1206	spam_rejected += 1
1207	eif level=0
1208	spam_unknown += 1
1209	else
1210	spam_accepted += 1
1211	else
1212	if level>0
1213	valid_rejected += 1
1214	eif level=0
1215	valid_unknown += 1
1216	else
1217	valid_accepted += 1
1218	if (spam and level<0) or (not spam and level>0)
1219	var Str from2 := "" ; var Str to2 := "" ; var Str subject2 := ""
1220	(var Stream s) open paths:p+files:i:name in+safe+anyeol
1221	(var MimeStream ms) bind s true
1222	while (ms header_line (var Str l))
1223	if (l parse acword:"from" ":" any:(var Str value))
1224	ms_decode value
1225	from2 := value
1226	eif (l parse acword:"to" ":" any:(var Str value)) or (l parse acword:"cc" ":" any:(var Str value))
1227	ms_decode value
1228	to2 += (shunt to2<>"" "," "")+value
1229	eif (l parse acword:"subject" ":" any:(var Str value))
1230	ms_decode value
1231	subject2 := value
1232	cell
1233	text (string files:i:datetime:date)
1234	cell
1235	text smart_name:from2
1236	cell
1237	small
1238	while to2<>""
1239	if not (to2 parse any:(var Str value) "," any:(var Str remain))
1240	value := to2 ; remain := ""
1241	text smart_name:value ; eol
1242	to2 := remain
1243	cell color (color hsl (shunt level>0 and not spam 0 60) 50 75)
1244	if (mailboxes:p parse any:(var Str mailbox) "@" any:(var Str domain))
1245	link (shunt subject2<>"" subject2 "no subject") "archive/"+domain+"/"+mailbox+"/"+(replace files:i:name ".mail" "")+"/" options "text" relative no_extension
1246	else
1247	text (shunt subject2<>"" subject2 "no subject")
1248	cell
1249	text (string 100*rating "fixed 0")+"%"
1250	var Int total := spam_rejected+spam_unknown+spam_accepted+valid_rejected+valid_unknown+valid_accepted
1251	para
1252	text "Rejected spams: "
1253	font color (color hsl 120 100 50)
1254	text (string 100.0*spam_rejected/total "fixed 0")+"%"
1255	text " ("+string:spam_rejected+")" ; eol
1256	text "Unknown spams: "
1257	font color (color hsl 240 100 50)
1258	text (string 100.0*spam_unknown/total "fixed 0")+"%"
1259	text " ("+string:spam_unknown+")" ; eol
1260	text "Accepted spams: "
1261	font color (color hsl 60 100 50)
1262	text (string 100.0*spam_accepted/total "fixed 0")+"%"
1263	text" ("+string:spam_accepted+")" ; eol
1264	para
1265	text "Rejected valid mails: "
1266	font color (color hsl 0 100 50)
1267	text (string 100.0*valid_rejected/total "fixed 0")+"%"
1268	text " ("+string:valid_rejected+")" ; eol
1269	text "Unknown valid mails: "
1270	font color (color hsl 240 100 50)
1271	text (string 100.0*valid_unknown/total "fixed 0")+"%"
1272	text " ("+string:valid_unknown+")" ; eol
1273	text "Accepted valid mails: "
1274	font color (color hsl 120 100 50)
1275	text (string 100.0*valid_accepted/total "fixed 0")+"%"
1276	text " ("+string:valid_accepted+")" ; eol
1277	page button "remove spam filter"
1278	var Array:Str mailboxes paths
1279	each umb2 user:user:mailbox
1280	var Data:MailBox m2 :> mailbox umb2
1281	if exists:m2 and (keyof:m2=box or box="all")
1282	file_delete (m2 smart_path "")+"spam_filter.txt"
1283	file_delete (m2 smart_path "")+"spam_ip.txt"
1284	file_delete (m2 smart_path "")+"spam_word.txt"
1285	goto_backward
1286	para
1287	[A threshold of 50% will probably reject all spams, but is also likely to reject some valid mails.] ; eol
1288	[A threshold of 99% will reject very fiew valid mails.] ; eol
1289	[The optimal value depends on the kind of mails you receive and the tradeoff you select between accepting a fiew spams, or rejecting some valid mails.]
1290
1291
1292	method page set_auto_answer_messages user
1293	arg_rw HtmlPage page ; arg Str user
1294	implicit page
1295	title "Set the auto answer messages"
1296	table columns 2
1297	cell header [Mailbox]
1298	cell header [Auto answer message]
1299	each umb user:user:mailbox
1300	var Data:MailBox m :> mailbox umb
1301	cell
1302	text keyof:m
1303	cell
1304	text_input "" m:auto_answer columns 80 rows 5
1305	button "update"
1306	goto_backward
1307
1308
1309
1310	# dispatch
1311
1312
1313	function is_owner user mailbox -> owner
1314	arg Str user mailbox ; arg CBool owner
1315	each umb user:user:mailbox
1316	if umb=mailbox
1317	return true
1318	owner := false
1319
1320
1321	method page mail path http_options
1322	arg_rw HtmlPage page ; arg Str path http_options
1323	implicit page
1324	requires "mail"
1325	if path="/"
1326	mail_list user_name
1327	para
1328	link "send a mail" "send" no_extension ; eol
1329	link "search in the archives" "search" no_extension ; eol
1330	para
1331	each umb user:user_name:mailbox
1332	var Data:MailBox m :> mailbox umb
1333	if (keyof:m parse any:(var Str box) "@" any:(var Str domain))
1334	var Array:FileInfo areas := file_list m:area_path standard+directories+relative
1335	if areas:size<>0
1336	[Areas for mailbox] ; fixed (text " "+keyof:m) ; eol
1337	for (var Int i) 0 areas:size-1
1338	var Str area := areas:i:name
1339	area := area 0 (area search "/" area:len)
1340	link area "area/"+domain+"/"+box+"/"+area+"/" relative
1341	var Int n := (file_list m:area_path+areas:i:name standard) size
1342	if n>0
1343	fixed [  ] ; small (text string:n+" mail"+(shunt n>1 "s" ""))
1344	eol
1345	para
1346	link "edit your bookmarks" "bookmarks" no_extension ; eol
1347	link "create a new area" "create_area" no_extension
1348	fixed [ ] ; link "delete an area" "delete_area" no_extension ; eol
1349	link "set auto answer messages" "auto_answer" no_extension
1350	each umb user:user_name:mailbox
1351	var Data:MailBox m :> mailbox umb
1352	if m:auto_answer<>""
1353	fixed [ ] ; highlight keyof:m
1354	eol
1355	link "set spams filter" "spam_filter" no_extension ; eol
1356	spam_list user_name
1357	eif path="/send"
1358	mail_edit user_name
1359	eif path="/preview"
1360	mail_preview user_name
1361	eif path="/search"
1362	mail_search user_name
1363	eif path="/bookmarks"
1364	mail_bookmarks user_name
1365	eif path="/create_area"
1366	mail_create_area user_name
1367	eif path="/delete_area"
1368	mail_delete_area user_name
1369	eif path="/spam_filter"
1370	set_spam_filter user_name
1371	eif path="/auto_answer"
1372	set_auto_answer_messages user_name
1373	eif (path parse "/in/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str id) "/" any:(var Str part)) and (is_owner user_name box+"@"+domain)
1374	var Data:MailBox b :> mailbox box+"@"+domain
1375	var Str filename := b:in_path+id+".mail"
1376	if part<>"" or http_options="html"
1377	send_mime_part filename part http_options false
1378	else
1379	mail_display user_name b filename "RBMD" 4 http_options
1380	eif (path parse "/unknown/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str id) "/" any:(var Str part)) and (is_owner user_name box+"@"+domain)
1381	var Data:MailBox b :> mailbox box+"@"+domain
1382	var Str filename := b:unknown_path+id+".mail"
1383	if part<>"" or http_options="html"
1384	send_mime_part filename part http_options false
1385	else
1386	mail_display user_name b filename "RBMD" 4 http_options
1387	eif (path parse "/spam/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str id) "/" any:(var Str part)) and (is_owner user_name box+"@"+domain)
1388	var Data:MailBox b :> mailbox box+"@"+domain
1389	var Str filename := b:spam_path+id+".mail"
1390	if part<>"" or http_options="html"
1391	send_mime_part filename part http_options false
1392	else
1393	mail_display user_name b filename "RBMD" 4 http_options
1394	eif (path parse "/area/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str area) "/" any:(var Str remain)) and (is_owner user_name box+"@"+domain)
1395	var Data:MailBox b :> mailbox box+"@"+domain
1396	if (remain parse any:(var Str id) "/"  any:(var Str part))
1397	var Str filename := b:area_path+area+"/"+id+".mail"
1398	if part<>"" or http_options="html"
1399	send_mime_part filename part http_options false
1400	else
1401	mail_display user_name b filename "RBMD" 5 http_options
1402	else
1403	title "'"+area+"' area"
1404	mail_list "mail" (var Data:MailBox no_box) b:area_path+area+"/" ""
1405	eif (path parse "/archive/" any:(var Str domain) "/" any:(var Str box) "/" any:(var Str month) "/" any:(var Str day) "/" any:(var Str id) "/" any:(var Str part)) and (is_owner user_name box+"@"+domain)
1406	var Data:MailBox b :> mailbox box+"@"+domain
1407	var Str filename := b:archive_path+month+"/"+day+"/"+id+".mail"
1408	if part<>"" or http_options="html"
1409	send_mime_part filename part http_options false
1410	else
1411	mail_display user_name b filename "RB" 6 http_options
1412
1413
1414	export '. mail'
1415
1416
1417
1418