1# folders-lib.pl
2# Functions for dealing with mail folders in various formats
3
4$pop3_port = 110;
5$imap_port = 143;
6
7@index_fields = ( "subject", "from", "to", "date", "size",
8		  "x-spam-status", "message-id" );
9$create_cid_count = 0;
10
11# get_folder_cache_directory(&folder)
12# Returns a directory used to cache IMAP or POP3 files for some folder
13sub get_folder_cache_directory
14{
15my ($folder) = @_;
16if ($user_module_config_directory) {
17	return $user_module_config_directory."/".$folder->{'id'}.".cache";
18	}
19else {
20	my $rv = $module_config_directory."/".$folder->{'id'}.".cache";
21	if (!-d $rv) {
22		$rv = $module_var_directory."/".$folder->{'id'}.".cache";
23		}
24	return $rv;
25	}
26}
27
28# mailbox_list_mails(start, end, &folder, [headersonly], [&error])
29# Returns an array whose size is that of the entire folder, with messages
30# in the specified range filled in.
31sub mailbox_list_mails
32{
33my @mail;
34&switch_to_folder_user($_[2]);
35if ($_[2]->{'type'} == 0) {
36	# List a single mbox formatted file
37	@mail = &list_mails($_[2]->{'file'}, $_[0], $_[1]);
38	}
39elsif ($_[2]->{'type'} == 1) {
40	# List a qmail maildir
41	local $md = $_[2]->{'file'};
42	@mail = &list_maildir($md, $_[0], $_[1], $_[3]);
43	}
44elsif ($_[2]->{'type'} == 2) {
45	# Get mail headers/body from a remote POP3 server
46
47	# Login first
48	local @rv = &pop3_login($_[2]);
49	if ($rv[0] != 1) {
50		# Failed to connect or login
51		if ($_[4]) {
52			@{$_[4]} = @rv;
53			return ();
54			}
55		elsif ($rv[0] == 0) { &error($rv[1]); }
56		else { &error(&text('save_elogin', $rv[1])); }
57		}
58	local $h = $rv[1];
59	local @uidl = &pop3_uidl($h);
60	local %onserver = map { &safe_uidl($_), 1 } @uidl;
61
62	# Work out what range we want
63	local ($start, $end) = &compute_start_end($_[0], $_[1], scalar(@uidl));
64	@mail = map { undef } @uidl;
65
66	# For each message in the range, get the headers or body
67	local ($i, $f, %cached, %sizeneed);
68	local $cd = &get_folder_cache_directory($_[2]);
69	if (opendir(CACHE, $cd)) {
70		while($f = readdir(CACHE)) {
71			if ($f =~ /^(\S+)\.body$/) {
72				$cached{$1} = 2;
73				}
74			elsif ($f =~ /^(\S+)\.headers$/) {
75				$cached{$1} = 1;
76				}
77			}
78		closedir(CACHE);
79		}
80	else {
81		mkdir($cd, 0700);
82		}
83	for($i=$start; $i<=$end; $i++) {
84		local $u = &safe_uidl($uidl[$i]);
85		if ($cached{$u} == 2 || $cached{$u} == 1 && $_[3]) {
86			# We already have everything that we need
87			}
88		elsif ($cached{$u} == 1 || !$_[3]) {
89			# We need to get the entire mail
90			&pop3_command($h, "retr ".($i+1));
91			open(CACHE, ">", "$cd/$u.body");
92			while(<$h>) {
93				s/\r//g;
94				last if ($_ eq ".\n");
95				print CACHE $_;
96				}
97			close(CACHE);
98			unlink("$cd/$u.headers");
99			$cached{$u} = 2;
100			}
101		else {
102			# We just need the headers
103			&pop3_command($h, "top ".($i+1)." 0");
104			open(CACHE, ">", "$cd/$u.headers");
105			while(<$h>) {
106				s/\r//g;
107				last if ($_ eq ".\n");
108				print CACHE $_;
109				}
110			close(CACHE);
111			$cached{$u} = 1;
112			}
113		local $mail = &read_mail_file($cached{$u} == 2 ?
114				"$cd/$u.body" : "$cd/$u.headers");
115		if ($cached{$u} == 1) {
116			if ($mail->{'body'} ne "") {
117				$mail->{'size'} = int($mail->{'body'});
118				}
119			else {
120				$sizeneed{$i} = 1;
121				}
122			}
123		$mail->{'idx'} = $i;
124		$mail->{'id'} = $uidl[$i];
125		$mail[$i] = $mail;
126		}
127
128	# Get sizes for mails if needed
129	if (%sizeneed) {
130		&pop3_command($h, "list");
131		while(<$h>) {
132			s/\r//g;
133			last if ($_ eq ".\n");
134			if (/^(\d+)\s+(\d+)/ && $sizeneed{$1-1}) {
135				# Add size to the mail cache
136				$mail[$1-1]->{'size'} = $2;
137				local $u = &safe_uidl($uidl[$1-1]);
138				open(CACHE, ">>", "$cd/$u.headers");
139				print CACHE $2,"\n";
140				close(CACHE);
141				}
142			}
143		}
144
145	# Clean up any cached mails that no longer exist on the server
146	foreach $f (keys %cached) {
147		if (!$onserver{$f}) {
148			unlink($cached{$f} == 1 ? "$cd/$f.headers"
149						: "$cd/$f.body");
150			}
151		}
152	}
153elsif ($_[2]->{'type'} == 3) {
154	# List an MH directory
155	local $md = $_[2]->{'file'};
156	@mail = &list_mhdir($md, $_[0], $_[1], $_[3]);
157	}
158elsif ($_[2]->{'type'} == 4) {
159	# Get headers and possibly bodies from an IMAP server
160
161	# Login and select the specified mailbox
162	local @rv = &imap_login($_[2]);
163	if ($rv[0] != 1) {
164		# Something went wrong
165		if ($_[4]) {
166			@{$_[4]} = @rv;
167			return ();
168			}
169		elsif ($rv[0] == 0) { &error($rv[1]); }
170		elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
171		elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
172		}
173	local $h = $rv[1];
174	local $count = $rv[2];
175	return () if (!$count);
176	$_[2]->{'lastchange'} = $rv[3] if ($rv[3]);
177
178	# Work out what range we want
179	local ($start, $end) = &compute_start_end($_[0], $_[1], $count);
180	@mail = map { undef } (0 .. $count-1);
181
182	# Get the headers or body of messages in the specified range
183	local @rv;
184	if ($_[3]) {
185		# Just the headers
186		@rv = &imap_command($h,
187			sprintf "FETCH %d:%d (RFC822.SIZE UID FLAGS RFC822.HEADER)",
188				$start+1, $end+1);
189		}
190	else {
191		# Whole messages
192		@rv = &imap_command($h,
193			sprintf "FETCH %d:%d (UID FLAGS BODY.PEEK[])", $start+1, $end+1);
194		}
195
196	# Parse the headers or whole messages that came back
197	local $i;
198	for($i=0; $i<@{$rv[1]}; $i++) {
199		# Extract the actual mail part
200		local $mail = &parse_imap_mail($rv[1]->[$i]);
201		if ($mail) {
202			$mail->{'idx'} = $start+$i;
203			$mail[$start+$i] = $mail;
204			}
205		}
206	}
207elsif ($_[2]->{'type'} == 5) {
208	# A composite folder, which combined two or more others.
209
210	# Work out exactly how big the total is
211	local ($sf, %len, $count);
212	foreach $sf (@{$_[2]->{'subfolders'}}) {
213		print DEBUG "working out size of ",&folder_name($sf),"\n";
214		$len{$sf} = &mailbox_folder_size($sf);
215		$count += $len{$sf};
216		}
217
218	# Work out what range we need
219	local ($start, $end) = &compute_start_end($_[0], $_[1], $count);
220
221	# Fetch the needed part of each sub-folder
222	local $pos = 0;
223	foreach $sf (@{$_[2]->{'subfolders'}}) {
224		local ($sfstart, $sfend);
225		local $sfn = &folder_name($sf);
226		$sfstart = $start - $pos;
227		$sfend = $end - $pos;
228		$sfstart = $sfstart < 0 ? 0 :
229			   $sfstart >= $len{$sf} ? $len{$sf}-1 : $sfstart;
230		$sfend = $sfend < 0 ? 0 :
231			 $sfend >= $len{$sf} ? $len{$sf}-1 : $sfend;
232		print DEBUG "getting mail from $sfstart to $sfend in $sfn\n";
233		local @submail =
234			&mailbox_list_mails($sfstart, $sfend, $sf, $_[3]);
235		local $sm;
236		foreach $sm (@submail) {
237			if ($sm) {
238				# ID is the original folder and ID
239				$sm->{'id'} = $sfn."\t".$sm->{'id'};
240				}
241			}
242		push(@mail, @submail);
243		$pos += $len{$sf};
244		}
245	}
246elsif ($_[2]->{'type'} == 6) {
247	# A virtual folder, which just contains ids of mails in other folders
248	local $mems = $folder->{'members'};
249	local ($start, $end) = &compute_start_end($_[0], $_[1], scalar(@$mems));
250
251	# Build a map from sub-folder names to IDs in them
252	local (%wantmap, %namemap);
253	for(my $i=$start; $i<=$end; $i++) {
254		local $sf = $mems->[$i]->[0];
255		local $sid = $mems->[$i]->[1];
256		local $sfn = &folder_name($sf);
257		$namemap{$sfn} = $sf;
258		push(@{$wantmap{$sfn}}, [ $sid, $i ]);
259		}
260
261	# For each sub-folder, get the IDs we need, and put them into the
262	# return array at the right place
263	@mail = map { undef } (0 .. @$mems-1);
264	local $changed = 0;
265	foreach my $sfn (keys %wantmap) {
266		local $sf = $namemap{$sfn};
267		local @wantids = map { $_->[0] } @{$wantmap{$sfn}};
268		local @wantidxs = map { $_->[1] } @{$wantmap{$sfn}};
269		local @sfmail = &mailbox_select_mails($sf, \@wantids, $_[3]);
270		for(my $i=0; $i<@sfmail; $i++) {
271			$mail[$wantidxs[$i]] = $sfmail[$i];
272			if ($sfmail[$i]) {
273				# Original mail exists .. add to results
274				if ($sfmail[$i]->{'id'} ne $wantids[$i]) {
275					# Under new ID now - fix up index
276					print DEBUG "wanted ID ",$wantids[$i],
277						" got ",$sfmail[$i]->{'id'},"\n";
278					local ($m) = grep {
279						$_->[1] eq $wantids[$i] } @$mems;
280					if ($m) {
281						$m->[1] = $sfmail[$i]->{'id'};
282						$changed = 1;
283						}
284					}
285				$sfmail[$i]->{'idx'} = $wantidxs[$i];
286				$sfmail[$i]->{'id'} =
287					$sfn."\t".$sfmail[$i]->{'id'};
288				}
289			else {
290				# Take out of virtual folder index
291				print DEBUG "underlying email $sfn $wantids[$i] is gone!\n";
292				$mems = [ grep { $_->[0] ne $sf ||
293					 $_->[1] ne $wantids[$i] } @$mems ];
294				$changed = 1;
295				$mail[$wantidxs[$i]] = 'GONE';
296				}
297			}
298		}
299	if ($changed) {
300		# Need to save virtual folder
301		$folder->{'members'} = $mems;
302		&save_folder($folder, $folder);
303		}
304
305	# Filter out messages that don't exist anymore
306	@mail = grep { $_ ne 'GONE' } @mail;
307	}
308elsif ($_[2]->{'type'} == 7) {
309	# MBX format folder
310	print DEBUG "listing MBX $_[2]->{'file'}\n";
311	@mail = &list_mbxfile($_[2]->{'file'}, $_[0], $_[1]);
312	}
313&switch_from_folder_user($_[2]);
314return @mail;
315}
316
317# mailbox_select_mails(&folder, &ids, headersonly)
318# Returns only messages from a folder with unique IDs in the given array
319sub mailbox_select_mails
320{
321local ($folder, $ids, $headersonly) = @_;
322my @mail;
323&switch_to_folder_user($_[0]);
324if ($folder->{'type'} == 0) {
325	# mbox folder
326	@mail = &select_mails($folder->{'file'}, $ids, $headersonly);
327	}
328elsif ($folder->{'type'} == 1) {
329	# Maildir folder
330	@mail = &select_maildir($folder->{'file'}, $ids, $headersonly);
331	}
332elsif ($folder->{'type'} == 3) {
333	# MH folder
334	@mail = &select_mhdir($folder->{'file'}, $ids, $headersonly);
335	}
336elsif ($folder->{'type'} == 2) {
337	# POP folder
338
339	# Login first
340	local @rv = &pop3_login($folder);
341	if ($rv[0] != 1) {
342		# Failed to connect or login
343		if ($_[4]) {
344			@{$_[4]} = @rv;
345			return ();
346			}
347		elsif ($rv[0] == 0) { &error($rv[1]); }
348		else { &error(&text('save_elogin', $rv[1])); }
349		}
350	local $h = $rv[1];
351	local @uidl = &pop3_uidl($h);
352	local %uidlmap;		# Map from UIDLs to POP3 indexes
353	for(my $i=0; $i<@uidl; $i++) {
354		$uidlmap{$uidl[$i]} = $i+1;
355		}
356
357	# Work out what we have cached
358	local ($i, $f, %cached, %sizeneed);
359	local $cd = &get_folder_cache_directory($_[2]);
360	if (opendir(CACHE, $cd)) {
361		while($f = readdir(CACHE)) {
362			if ($f =~ /^(\S+)\.body$/) {
363				$cached{$1} = 2;
364				}
365			elsif ($f =~ /^(\S+)\.headers$/) {
366				$cached{$1} = 1;
367				}
368			}
369		closedir(CACHE);
370		}
371	else {
372		mkdir($cd, 0700);
373		}
374
375	# For each requested uidl, get the headers or body
376	foreach my $i (@$ids) {
377		local $u = &safe_uidl($i);
378		print DEBUG "need uidl $i -> $uidlmap{$i}\n";
379		if ($cached{$u} == 2 || $cached{$u} == 1 && $headersonly) {
380			# We already have everything that we need
381			}
382		elsif ($cached{$u} == 1 || !$headersonly) {
383			# We need to get the entire mail
384			&pop3_command($h, "retr ".$uidlmap{$i});
385			open(CACHE, ">", "$cd/$u.body");
386			while(<$h>) {
387				s/\r//g;
388				last if ($_ eq ".\n");
389				print CACHE $_;
390				}
391			close(CACHE);
392			unlink("$cd/$u.headers");
393			$cached{$u} = 2;
394			}
395		else {
396			# We just need the headers
397			&pop3_command($h, "top ".$uidlmap{$i}." 0");
398			open(CACHE, ">", "$cd/$u.headers");
399			while(<$h>) {
400				s/\r//g;
401				last if ($_ eq ".\n");
402				print CACHE $_;
403				}
404			close(CACHE);
405			$cached{$u} = 1;
406			}
407		local $mail = &read_mail_file($cached{$u} == 2 ?
408				"$cd/$u.body" : "$cd/$u.headers");
409		if ($cached{$u} == 1) {
410			if ($mail->{'body'} ne "") {
411				$mail->{'size'} = length($mail->{'body'});
412				}
413			else {
414				$sizeneed{$uidlmap{$i}} = $mail;
415				}
416			}
417		$mail->{'idx'} = $uidlmap{$i}-1;
418		$mail->{'id'} = $i;
419		push(@mail, $mail);
420		}
421
422	# Get sizes for mails if needed
423	if (%sizeneed) {
424		&pop3_command($h, "list");
425		while(<$h>) {
426			s/\r//g;
427			last if ($_ eq ".\n");
428			if (/^(\d+)\s+(\d+)/ && $sizeneed{$1}) {
429				# Find mail in results, and set its size
430				local ($ns) = $sizeneed{$1};
431				$ns->{'size'} = $2;
432				local $u = &safe_uidl($uidl[$1-1]);
433				open(CACHE, ">>", "$cd/$u.headers");
434				print CACHE $2,"\n";
435				close(CACHE);
436				}
437			}
438		}
439	}
440elsif ($folder->{'type'} == 4) {
441	# IMAP folder
442
443	# Login and select the specified mailbox
444	local @irv = &imap_login($folder);
445	if ($irv[0] != 1) {
446		# Something went wrong
447		if ($_[4]) {
448			@{$_[4]} = @irv;
449			return ();
450			}
451		elsif ($irv[0] == 0) { &error($irv[1]); }
452		elsif ($irv[0] == 3) { &error(&text('save_emailbox', $irv[1]));}
453		elsif ($irv[0] == 2) { &error(&text('save_elogin2', $irv[1])); }
454		}
455	local $h = $irv[1];
456	local $count = $irv[2];
457	return () if (!$count);
458        $folder->{'lastchange'} = $irv[3] if ($irv[3]);
459
460	# Build map from IDs to original order, as UID FETCH doesn't return
461	# mail in the order we asked for!
462	local %wantpos;
463	for(my $i=0; $i<@$ids; $i++) {
464		$wantpos{$ids->[$i]} = $i;
465		}
466
467	# Fetch each mail by ID. This is done in blocks of 1000, to avoid
468	# hitting a the IMAP server's max request limit
469	@mail = map { undef } @$ids;
470	local $wanted = $headersonly ? "(RFC822.SIZE UID FLAGS RFC822.HEADER)"
471				     : "(UID FLAGS BODY.PEEK[])";
472	if (@$ids) {
473		for(my $chunk=0; $chunk<@$ids; $chunk+=1000) {
474			local $chunkend = $chunk+999;
475			if ($chunkend >= @$ids) { $chunkend = @$ids-1; }
476			local @cids = @$ids[$chunk .. $chunkend];
477			local @idxrv = &imap_command($h,
478				"UID FETCH ".join(",", @cids)." $wanted");
479			foreach my $idxrv (@{idxrv->[1]}) {
480				local $mail = &parse_imap_mail($idxrv);
481				if ($mail) {
482					$mail->{'idx'} = $mail->{'imapidx'}-1;
483					$mail[$wantpos{$mail->{'id'}}] = $mail;
484					}
485				}
486			}
487		}
488	print DEBUG "imap rv = ",scalar(@mail),"\n";
489	}
490elsif ($folder->{'type'} == 5 || $folder->{'type'} == 6) {
491	# Virtual or composite folder .. for each ID, work out the folder and
492	# build a map from folders to ID lists
493	print DEBUG "selecting ",scalar(@$ids)," ids\n";
494
495	# Build a map from sub-folder names to IDs in them
496	my $i = 0;
497	my %wantmap;
498	foreach my $id (@$ids) {
499		local ($sfn, $sid) = split(/\t+/, $id, 2);
500		push(@{$wantmap{$sfn}}, [ $sid, $i ]);
501		$i++;
502		}
503
504	# Build map from sub-folder names to IDs
505	my (%namemap, @allids, $mems);
506	if ($folder->{'type'} == 6) {
507		# For a virtual folder, we need to find all sub-folders
508		$mems = $folder->{'members'};
509		foreach my $m (@$mems) {
510			local $sfn = &folder_name($m->[0]);
511			$namemap{$sfn} = $m->[0];
512			push(@allids, $sfn."\t".$m->[1]);
513			}
514		}
515	else {
516		# For a composite, they are simply listed
517		foreach my $sf (@{$folder->{'subfolders'}}) {
518			local $sfn = &folder_name($sf);
519			$namemap{$sfn} = $sf;
520			}
521		@allids = &mailbox_idlist($folder);
522		}
523
524	# For each sub-folder, get the IDs we need, and put them into the
525        # return array at the right place
526	@mail = map { undef } @$ids;
527	foreach my $sfn (keys %wantmap) {
528		local $sf = $namemap{$sfn};
529		local @wantids = map { $_->[0] } @{$wantmap{$sfn}};
530		local @wantidxs = map { $_->[1] } @{$wantmap{$sfn}};
531		local @sfmail = &mailbox_select_mails($sf, \@wantids,
532						      $headersonly);
533		for(my $i=0; $i<@sfmail; $i++) {
534			$mail[$wantidxs[$i]] = $sfmail[$i];
535			if ($sfmail[$i]) {
536				# Original mail exists .. add to results
537				$sfmail[$i]->{'id'} =
538					$sfn."\t".$sfmail[$i]->{'id'};
539				$sfmail[$i]->{'idx'} = &indexof(
540					$sfmail[$i]->{'id'}, @allids);
541				print DEBUG "looking for ",$sfmail[$i]->{'id'}," found at ",$sfmail[$i]->{'idx'},"\n";
542				}
543			else {
544				# Take out of virtual folder index
545				print DEBUG "underlying email $sfn $wantids[$i] is gone!\n";
546				$mems = [ grep { $_->[0] ne $sf ||
547					 $_->[1] ne $wantids[$i] } @$mems ];
548				$changed = 1;
549				}
550			}
551		}
552	if ($changed && $folder->{'type'} == 6) {
553		# Need to save virtual folder
554		$folder->{'members'} = $mems;
555		&save_folder($folder, $folder);
556		}
557	}
558elsif ($folder->{'type'} == 7) {
559	# MBX folder
560	@mail = &select_mbxfile($folder->{'file'}, $ids, $headersonly);
561	}
562&switch_from_folder_user($_[0]);
563return @mail;
564}
565
566# mailbox_get_mail(&folder, id, headersonly)
567# Convenience function to get a single mail by ID
568sub mailbox_get_mail
569{
570local ($folder, $id, $headersonly) = @_;
571local ($mail) = &mailbox_select_mails($folder, [ $id ], $headersonly);
572if ($mail) {
573	# Find the sort index for this message
574	local ($field, $dir) = &get_sort_field($folder);
575	if (!$field || !$folder->{'sortable'}) {
576		# No sorting, so sort index is the opposite of real
577		$mail->{'sortidx'} = &mailbox_folder_size($folder, 1) -
578				     $mail->{'idx'} - 1;
579		print DEBUG "idx=$mail->{'idx'} sortidx=$mail->{'sortidx'} size=",&mailbox_folder_size($folder, 1),"\n";
580		}
581	else {
582		# Need to extract from sort index
583		local @sorter = &build_sorted_ids($folder, $field, $dir);
584		$mail->{'sortidx'} = &indexof($id, @sorter);
585		}
586	}
587return $mail;
588}
589
590# mailbox_idlist(&folder)
591# Returns a list of IDs of messages in some folder
592sub mailbox_idlist
593{
594local ($folder) = @_;
595&switch_to_folder_user($_[0]);
596my @idlist;
597if ($folder->{'type'} == 0) {
598	# mbox, for which IDs are mail positions
599	print DEBUG "starting to get IDs from $folder->{'file'}\n";
600	@idlist = &idlist_mails($folder->{'file'});
601	print DEBUG "got ",scalar(@idlist)," ids\n";
602	}
603elsif ($folder->{'type'} == 1) {
604	# maildir, for which IDs are filenames
605	@idlist = &idlist_maildir($folder->{'file'});
606	}
607elsif ($folder->{'type'} == 2) {
608	# pop3, for which IDs are uidls
609	local @rv = &pop3_login($folder);
610	if ($rv[0] != 1) {
611		# Failed to connect or login
612		if ($rv[0] == 0) { &error($rv[1]); }
613		else { &error(&text('save_elogin', $rv[1])); }
614		}
615	local $h = $rv[1];
616	@idlist = &pop3_uidl($h);
617	}
618elsif ($folder->{'type'} == 3) {
619	# MH directory, for which IDs are file numbers
620	@idlist = &idlist_mhdir($folder->{'file'});
621	}
622elsif ($folder->{'type'} == 4) {
623	# IMAP, for which IDs are IMAP UIDs
624	local @rv = &imap_login($folder);
625	if ($rv[0] != 1) {
626		# Something went wrong
627		if ($rv[0] == 0) { &error($rv[1]); }
628		elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
629		elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
630		}
631	local $h = $rv[1];
632	local $count = $rv[2];
633	return () if (!$count);
634        $folder->{'lastchange'} = $irv[3] if ($irv[3]);
635
636	@rv = &imap_command($h, "FETCH 1:$count UID");
637	foreach my $uid (@{$rv[1]}) {
638		if ($uid =~ /UID\s+(\d+)/) {
639			push(@idlist, $1);
640			}
641		}
642	}
643elsif ($folder->{'type'} == 5) {
644	# Composite, IDs come from sub-folders
645	foreach my $sf (@{$folder->{'subfolders'}}) {
646		local $sfn = &folder_name($sf);
647		push(@idlist, map { $sfn."\t".$_ } &mailbox_idlist($sf));
648		}
649	}
650elsif ($folder->{'type'} == 6) {
651	# Virtual, IDs come from sub-folders (where they exist)
652	my (%wantmap, %namemap);
653	foreach my $m (@{$folder->{'members'}}) {
654		local $sf = $m->[0];
655		local $sid = $m->[1];
656		local $sfn = &folder_name($sf);
657		push(@{$wantmap{$sfn}}, $sid);
658		$namemap{$sfn} = $sf;
659		}
660	foreach my $sfn (keys %wantmap) {
661		local %wantids = map { $_, 1 } @{$wantmap{$sfn}};
662		local $sf = $namemap{$sfn};
663		foreach my $sfid (&mailbox_idlist($sf)) {
664			if ($wantids{$sfid}) {
665				push(@idlist, $sfn."\t".$sfid);
666				}
667			}
668		}
669	}
670&switch_from_folder_user($_[0]);
671return @idlist;
672}
673
674# compute_start_end(start, end, count)
675# Given start and end indexes (which may be negative or undef), returns the
676# real mail file indexes.
677sub compute_start_end
678{
679local ($start, $end, $count) = @_;
680if (!defined($start)) {
681	return (0, $count-1);
682	}
683elsif ($end < 0) {
684	local $rstart = $count+$_[1]-1;
685	local $rend = $count+$_[0]-1;
686	$rstart = $rstart < 0 ? 0 : $rstart;
687	$rend = $count - 1 if ($rend >= $count);
688	return ($rstart, $rend);
689	}
690else {
691	local $rend = $_[1];
692	$rend = $count - 1 if ($rend >= $count);
693	return ($start, $rend);
694	}
695}
696
697# mailbox_list_mails_sorted(start, end, &folder, [headeronly], [&error],
698#			    [sort-field, sort-dir])
699# Returns messages in a folder within the given range, but sorted by the
700# given field and condition.
701sub mailbox_list_mails_sorted
702{
703local ($start, $end, $folder, $headersonly, $error, $field, $dir) = @_;
704print DEBUG "mailbox_list_mails_sorted from $start to $end\n";
705if (!$field) {
706	# Default to current ordering
707	($field, $dir) = &get_sort_field($folder);
708	}
709if (!$field || !$folder->{'sortable'}) {
710	# No sorting .. just return newest first
711	local @rv = reverse(&mailbox_list_mails(
712		-$start, -$end-1, $folder, $headersonly, $error));
713	local $i = 0;
714	foreach my $m (@rv) {
715		$m->{'sortidx'} = $i++;
716		}
717	return @rv;
718	}
719
720# For IMAP, login first so that the lastchange can be found
721if ($folder->{'type'} == 4 && !$folder->{'lastchange'}) {
722	&mailbox_select_mails($folder, [ ], 1);
723	}
724
725# Get a sorted list of IDs, and then find the real emails within the range
726local @sorter = &build_sorted_ids($folder, $field, $dir);
727($start, $end) = &compute_start_end($start, $end, scalar(@sorter));
728print DEBUG "for ",&folder_name($folder)," sorter = ",scalar(@sorter),"\n";
729print DEBUG "start = $start end = $end\n";
730local @rv = map { undef } (0 .. scalar(@sorter)-1);
731local @wantids = map { $sorter[$_] } ($start .. $end);
732print DEBUG "wantids = ",scalar(@wantids),"\n";
733local @mails = &mailbox_select_mails($folder, \@wantids, $headersonly);
734for(my $i=0; $i<@mails; $i++) {
735	$rv[$start+$i] = $mails[$i];
736	print DEBUG "setting $start+$i to ",$mails[$i]," id ",$wantids[$i],"\n";
737	$mails[$i]->{'sortidx'} = $start+$i;
738	}
739print DEBUG "rv = ",scalar(@rv),"\n";
740return @rv;
741}
742
743# build_sorted_ids(&folder, field, dir)
744# Returns a list of message IDs in some folder, sorted on some field
745sub build_sorted_ids
746{
747local ($folder, $field, $dir) = @_;
748
749# Delete old sort indexes
750&delete_old_sort_index($folder);
751
752# Build or update the sort index. This is a file mapping unique IDs and fields
753# to sortable values.
754local %index;
755&build_new_sort_index($folder, $field, \%index);
756
757# Get message indexes, sorted by the field
758my @sorter;
759while(my ($k, $v) = each %index) {
760	if ($k =~ /^(.*)_\Q$field\E$/) {
761		push(@sorter, [ $1, lc($v) ]);
762		}
763	}
764if ($field eq "size" || $field eq "date" || $field eq "x-spam-status") {
765	# Numeric sort
766	@sorter = sort { my $s = $a->[1] <=> $b->[1]; $dir ? $s : -$s } @sorter;
767	}
768else {
769	# Alpha sort
770	@sorter = sort { my $s = $a->[1] cmp $b->[1]; $dir ? $s : -$s } @sorter;
771	}
772return map { $_->[0] } @sorter;
773}
774
775# delete_old_sort_index(&folder)
776# Delete old index DBM files
777sub delete_old_sort_index
778{
779local ($folder) = @_;
780local $ifile = &folder_sort_index_file($folder);
781$ifile =~ /^(.*)\/([^\/]+)$/;
782local ($idir, $iname) = ($1, $2);
783opendir(IDIR, $idir);
784foreach my $f (readdir(IDIR)) {
785	if ($f eq $iname || $f =~ /^\Q$iname\E\.[^\.]+$/) {
786		unlink("$idir/$f");
787		}
788	}
789closedir(IDIR);
790}
791
792# build_new_sort_index(&folder, field, &index)
793# Builds and/or loads the index for sorting a folder on some field. The
794# index uses the mail number as the key, and the field value as the value.
795sub build_new_sort_index
796{
797local ($folder, $field, $index) = @_;
798return 0 if (!$folder->{'sortable'});
799local $ifile = &folder_new_sort_index_file($folder);
800
801&open_dbm_db($index, $ifile, 0600);
802print DEBUG "indexchange=$index->{'lastchange'} folderchange=$folder->{'lastchange'}\n";
803if ($index->{'lastchange'} != $folder->{'lastchange'} ||
804    !$folder->{'lastchange'}) {
805	# The mail file has changed .. get IDs and update the index with any
806	# that are missing
807	local @ids = &mailbox_idlist($folder);
808
809	# Find IDs that are new
810	local @newids;
811	foreach my $id (@ids) {
812		if (!defined($index->{$id."_size"})) {
813			push(@newids, $id);
814			}
815		}
816	local @mails = scalar(@newids) ?
817			&mailbox_select_mails($folder, \@newids, 1) : ( );
818	foreach my $mail (@mails) {
819		foreach my $f (@index_fields) {
820			if ($f eq "date") {
821				# Convert date to Unix time
822				$index->{$mail->{'id'}."_date"} =
823				  &parse_mail_date($mail->{'header'}->{'date'});
824				}
825			elsif ($f eq "size") {
826				# Get mail size
827				$index->{$mail->{'id'}."_size"} =
828					$mail->{'size'};
829				}
830			elsif ($f eq "from" || $f eq "to") {
831				# From: header .. convert to display version
832				$index->{$mail->{'id'}."_".$f} =
833					&simplify_from($mail->{'header'}->{$f});
834				}
835			elsif ($f eq "subject") {
836				# Convert subject to display version
837				$index->{$mail->{'id'}."_".$f} =
838				    &simplify_subject($mail->{'header'}->{$f});
839				}
840			elsif ($f eq "x-spam-status") {
841				# Extract spam score
842				$index->{$mail->{'id'}."_".$f} =
843					$mail->{'header'}->{$f} =~ /(hits|score)=([0-9\.]+)/ ? $2 : undef;
844				}
845			else {
846				# Just a header
847				$index->{$mail->{'id'}."_".$f} =
848					$mail->{'header'}->{$f};
849				}
850			}
851		}
852	print DEBUG "added ",scalar(@mails)," messages to index\n";
853
854	# Remove IDs that no longer exist
855	local %ids = map { $_, 1 } (@ids, @wantids);
856	local $dc = 0;
857	local @todelete;
858	while(my ($k, $v) = each %$index) {
859		if ($k =~ /^(.*)_([^_]+)$/ && !$ids{$1}) {
860			push(@todelete, $k);
861			$dc++ if ($2 eq "size");
862			}
863		}
864	foreach my $k (@todelete) {
865		delete($index->{$k});
866		}
867	print DEBUG "deleted $dc messages from index\n";
868
869	# Record index update time
870	$index->{'lastchange'} = $folder->{'lastchange'} || time();
871	$index->{'mailcount'} = scalar(@ids);
872	print DEBUG "new indexchange=$index->{'lastchange'}\n";
873	}
874return 1;
875}
876
877# delete_new_sort_index_message(&folder, id)
878# Removes a message ID from a sort index
879sub delete_new_sort_index_message
880{
881local ($folder, $id) = @_;
882local %index;
883&build_new_sort_index($folder, undef, \%index);
884foreach my $field (@index_fields) {
885	delete($index{$id."_".$field});
886	}
887dbmclose(%index);
888if ($folder->{'type'} == 5 || $folder->{'type'} == 6) {
889	# Remove from underlying folder's index too
890	local ($sfn, $sid) = split(/\t+/, $id, 2);
891	local $sf = &find_subfolder($folder, $sfn);
892	if ($sf) {
893		&delete_new_sort_index_message($sf, $sid);
894		}
895	}
896}
897
898# force_new_index_recheck(&folder)
899# Resets the last-updated time on a folder's index, to force a re-check
900sub force_new_index_recheck
901{
902local ($folder) = @_;
903local %index;
904&build_new_sort_index($folder, undef, \%index);
905$index{'lastchange'} = 0;
906dbmclose(%index);
907}
908
909# delete_new_sort_index(&folder)
910# Trashes the sort index for a folder, to force a rebuild
911sub delete_new_sort_index
912{
913local ($folder) = @_;
914local $ifile = &folder_new_sort_index_file($folder);
915
916my %index;
917&open_dbm_db(\%index, $ifile, 0600);
918%index = ( );
919}
920
921# folder_sort_index_file(&folder)
922# Returns the index file to use for some folder
923sub folder_sort_index_file
924{
925local ($folder) = @_;
926return &user_index_file(($folder->{'file'} || $folder->{'id'}).".sort");
927}
928
929# folder_new_sort_index_file(&folder)
930# Returns the new ID-style index file to use for some folder
931sub folder_new_sort_index_file
932{
933local ($folder) = @_;
934return &user_index_file(($folder->{'file'} || $folder->{'id'}).".byid");
935}
936
937# mailbox_search_mail(&fields, andmode, &folder, [&limit], [headersonly])
938# Search a mailbox for multiple matching fields
939sub mailbox_search_mail
940{
941local ($fields, $andmode, $folder, $limit, $headersonly) = @_;
942
943# For folders other than IMAP and composite and mbox where we already have
944# an index, build a sort index and use that for
945# the search, if it is simple enough (Subject, From and To only)
946local @idxfields = grep { $_->[0] eq 'from' || $_->[0] eq 'to' ||
947                          $_->[0] eq 'subject' } @{$_[0]};
948if ($folder->{'type'} != 4 &&
949    $folder->{'type'} != 5 &&
950    $folder->{'type'} != 6 &&
951    ($folder->{'type'} != 0 || !&has_dbm_index($folder->{'file'})) &&
952    scalar(@idxfields) == scalar(@$fields) && @idxfields &&
953    &get_product_name() eq 'usermin') {
954	print DEBUG "using index to search\n";
955	local %index;
956	&build_new_sort_index($folder, undef, \%index);
957	local @rv;
958
959	# Work out which mail IDs match the requested headers
960	local %idxmatches = map { ("$_->[0]/$_->[1]", [ ]) } @idxfields;
961	while(my ($k, $v) = each %index) {
962		$k =~ /^(.+)_(\S+)$/ || next;
963                local ($ki, $kf) = ($1, $2);
964                next if (!$kf || $ki eq '');
965
966		# Check all of the fields to see which ones match
967		foreach my $if (@idxfields) {
968			local $iff = $if->[0];
969			local ($neg) = ($iff =~ s/^\!//);
970			next if ($kf ne $iff);
971			local $re = $if->[2] ? $if->[1] : "\Q$if->[1]\E";
972			if (!$neg && $v =~ /$re/i ||
973			    $neg && $v !~ /$re/i) {
974				push(@{$idxmatches{"$if->[0]/$if->[1]"}}, $ki);
975				}
976			}
977		}
978	local @matches;
979	if ($_[1]) {
980		# Find indexes in all arrays
981		local %icount;
982		foreach my $if (keys %idxmatches) {
983			foreach my $i (@{$idxmatches{$if}}) {
984				$icount{$i}++;
985				}
986			}
987		foreach my $i (keys %icount) {
988			}
989		local $fif = $idxfields[0];
990		@matches = grep { $icount{$_} == scalar(@idxfields) }
991				@{$idxmatches{"$fif->[0]/$fif->[1]"}};
992		}
993	else {
994		# Find indexes in any array
995		foreach my $if (keys %idxmatches) {
996			push(@matches, @{$idxmatches{$if}});
997			}
998		@matches = &unique(@matches);
999		}
1000	@matches = sort { $a cmp $b } @matches;
1001	print DEBUG "matches = ",join(" ", @matches),"\n";
1002
1003	# Select the actual mails
1004	return &mailbox_select_mails($_[2], \@matches, $headersonly);
1005	}
1006
1007if ($folder->{'type'} == 0) {
1008	# Just search an mbox format file (which will use its own special
1009	# field-level index)
1010	return &advanced_search_mail($folder->{'file'}, $fields,
1011				     $andmode, $limit, $headersonly);
1012	}
1013elsif ($folder->{'type'} == 1) {
1014	# Search a maildir directory
1015	return &advanced_search_maildir($folder->{'file'}, $fields,
1016				        $andmode, $limit, $headersonly);
1017	}
1018elsif ($folder->{'type'} == 2) {
1019	# Get all of the mail from the POP3 server and search it
1020	local ($min, $max);
1021	if ($limit && $limit->{'latest'}) {
1022		$min = -1;
1023		$max = -$limit->{'latest'};
1024		}
1025	local @mails = &mailbox_list_mails($min, $max, $folder,
1026			&indexof('body', &search_fields($fields)) < 0 &&
1027			$headersonly);
1028	local @rv = grep { $_ && &mail_matches($fields, $andmode, $_) } @mails;
1029	}
1030elsif ($folder->{'type'} == 3) {
1031	# Search an MH directory
1032	return &advanced_search_mhdir($folder->{'file'}, $fields,
1033				      $andmode, $limit, $headersonly);
1034	}
1035elsif ($folder->{'type'} == 4) {
1036	# Use IMAP's remote search feature
1037	local @rv = &imap_login($_[2]);
1038	if ($rv[0] == 0) { &error($rv[1]); }
1039	elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
1040	elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
1041	local $h = $rv[1];
1042        $_[2]->{'lastchange'} = $rv[3] if ($rv[3]);
1043
1044	# Do the search to get back a list of matching numbers
1045	local @search;
1046	foreach $f (@{$_[0]}) {
1047		local $field = $f->[0] eq "date" ? "on" :
1048			       $f->[0] eq "all" ? "body" : $f->[0];
1049		local $neg = ($field =~ s/^\!//);
1050		local $what = $f->[1];
1051		if ($field ne "size") {
1052			$what = "\"".$what."\""
1053			}
1054		$field = "LARGER" if ($field eq "size");
1055		local $search;
1056		if ($field =~ /^X-/i) {
1057			$search = "header ".uc($field)." ".$what."";
1058			}
1059		else {
1060			$search = uc($field)." ".$what."";
1061			}
1062		$search = "NOT $search" if ($neg);
1063		push(@searches, $search);
1064		}
1065	local $searches;
1066	if (@searches == 1) {
1067		$searches = $searches[0];
1068		}
1069	elsif ($_[1]) {
1070		$searches = join(" ", @searches);
1071		}
1072	else {
1073		$searches = $searches[$#searches];
1074		for($i=$#searches-1; $i>=0; $i--) {
1075			$searches = "or $searches[$i] ($searches)";
1076			}
1077		}
1078	@rv = &imap_command($h, "UID SEARCH $searches");
1079	&error(&text('save_esearch', $rv[3])) if (!$rv[0]);
1080
1081	# Get back the IDs we want
1082	local ($srch) = grep { $_ =~ /^\*\s+SEARCH/i } @{$rv[1]};
1083	local @ids = split(/\s+/, $srch);
1084	shift(@ids); shift(@ids);	# lose * SEARCH
1085
1086	# Call the select function to get the mails
1087	return &mailbox_select_mails($folder, \@ids, $headersonly);
1088	}
1089elsif ($folder->{'type'} == 5) {
1090	# Search each sub-folder and combine the results - taking any count
1091	# limits into effect
1092	local $sf;
1093	local $pos = 0;
1094	local @mail;
1095	local (%start, %len);
1096	foreach $sf (@{$folder->{'subfolders'}}) {
1097		$len{$sf} = &mailbox_folder_size($sf);
1098		$start{$sf} = $pos;
1099		$pos += $len{$sf};
1100		}
1101	local $limit = $limit ? { %$limit } : undef;
1102	$limit = undef;
1103	foreach $sf (reverse(@{$folder->{'subfolders'}})) {
1104		local $sfn = &folder_name($sf);
1105		print DEBUG "searching on sub-folder ",&folder_name($sf),"\n";
1106		local @submail = &mailbox_search_mail($fields, $andmode, $sf,
1107					$limit, $headersonly);
1108		print DEBUG "found ",scalar(@submail),"\n";
1109		foreach my $sm (@submail) {
1110			$sm->{'id'} = $sfn."\t".$sm->{'id'};
1111			}
1112		push(@mail, reverse(@submail));
1113		if ($limit && $limit->{'latest'}) {
1114			# Adjust latest down by size of this folder
1115			$limit->{'latest'} -= $len{$sf};
1116			last if ($limit->{'latest'} <= 0);
1117			}
1118		}
1119	return reverse(@mail);
1120	}
1121elsif ($folder->{'type'} == 6) {
1122	# Just run a search on the sub-mails
1123	local @rv;
1124	local ($min, $max);
1125	if ($limit && $limit->{'latest'}) {
1126		$min = -1;
1127		$max = -$limit->{'latest'};
1128		}
1129	local $mail;
1130	local $sfn = &folder_name($sf);
1131	print DEBUG "searching virtual folder ",&folder_name($folder),"\n";
1132	foreach $mail (&mailbox_list_mails($min, $max, $folder)) {
1133		if ($mail && &mail_matches($fields, $andmode, $mail)) {
1134			push(@rv, $mail);
1135			}
1136		}
1137	return @rv;
1138	}
1139}
1140
1141# mailbox_delete_mail(&folder, mail, ...)
1142# Delete multiple messages from some folder
1143sub mailbox_delete_mail
1144{
1145return undef if (&is_readonly_mode());
1146local $f = shift(@_);
1147&switch_to_folder_user($f);
1148if ($userconfig{'delete_mode'} == 1 && !$f->{'trash'} && !$f->{'spam'} &&
1149    !$f->{'notrash'}) {
1150	# Copy to trash folder first .. if we have one
1151	local ($trash) = grep { $_->{'trash'} } &list_folders();
1152	if ($trash) {
1153		my $r;
1154		my $save_read = &get_product_name() eq "usermin";
1155		foreach my $m (@_) {
1156			$r = &get_mail_read($f, $m) if ($save_read);
1157			my $mcopy = { %$m };	  # Because writing changes id
1158			&write_mail_folder($mcopy, $trash);
1159			&set_mail_read($trash, $mcopy, $r) if ($save_read);
1160			}
1161		}
1162	}
1163
1164if ($f->{'type'} == 0) {
1165	# Delete from mbox
1166	&delete_mail($f->{'file'}, @_);
1167	}
1168elsif ($f->{'type'} == 1) {
1169	# Delete from Maildir
1170	&delete_maildir(@_);
1171	}
1172elsif ($f->{'type'} == 2) {
1173	# Login and delete from the POP3 server
1174	local @rv = &pop3_login($f);
1175	if ($rv[0] == 0) { &error($rv[1]); }
1176	elsif ($rv[0] == 2) { &error(&text('save_elogin', $rv[1])); }
1177	local $h = $rv[1];
1178	local @uidl = &pop3_uidl($h);
1179	local $m;
1180	local $cd = &get_folder_cache_directory($f);
1181	foreach $m (@_) {
1182		local $idx = &indexof($m->{'id'}, @uidl);
1183		if ($idx >= 0) {
1184			&pop3_command($h, "dele ".($idx+1));
1185			local $u = &safe_uidl($m->{'id'});
1186			unlink("$cd/$u.headers", "$cd/$u.body");
1187			}
1188		}
1189	}
1190elsif ($f->{'type'} == 3) {
1191	# Delete from MH dir
1192	&delete_mhdir(@_);
1193	}
1194elsif ($f->{'type'} == 4) {
1195	# Delete from the IMAP server
1196	local @rv = &imap_login($f);
1197	if ($rv[0] == 0) { &error($rv[1]); }
1198	elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
1199	elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
1200	local $h = $rv[1];
1201
1202	local $m;
1203	foreach $m (@_) {
1204		@rv = &imap_command($h, "UID STORE ".$m->{'id'}.
1205					" +FLAGS (\\Deleted)");
1206		&error(&text('save_edelete', $rv[3])) if (!$rv[0]);
1207		}
1208	@rv = &imap_command($h, "EXPUNGE");
1209	&error(&text('save_edelete', $rv[3])) if (!$rv[0]);
1210	}
1211elsif ($f->{'type'} == 5 || $f->{'type'} == 6) {
1212	# Delete from underlying folder(s), and from virtual index
1213	foreach my $sm (@_) {
1214		local ($sfn, $sid) = split(/\t+/, $sm->{'id'}, 2);
1215		local $sf = &find_subfolder($f, $sfn);
1216		$sf || &error("Failed to find sub-folder named $sfn");
1217		if ($f->{'type'} == 5 || $f->{'type'} == 6 && $f->{'delete'}) {
1218			$sm->{'id'} = $sid;
1219			&mailbox_delete_mail($sf, $sm);
1220			$sm->{'id'} = $sfn."\t".$sm->{'id'};
1221			}
1222		if ($f->{'type'} == 6) {
1223			$f->{'members'} = [
1224				grep { $_->[0] ne $sf ||
1225				       $_->[1] ne $sid } @{$f->{'members'}} ];
1226			}
1227		}
1228	if ($f->{'type'} == 6) {
1229		# Save new ID list
1230		&save_folder($f, $f);
1231		}
1232	}
1233&switch_from_folder_user($f);
1234
1235# Always force a re-check of the index when deleting, as we may not detect
1236# the change (especially for IMAP, where UIDNEXT may not change). This isn't
1237# needed for Maildir or MH, as indexing is reliable enough
1238if ($f->{'type'} != 1 && $f->{'type'} != 3) {
1239	&force_new_index_recheck($f);
1240	}
1241}
1242
1243# mailbox_empty_folder(&folder)
1244# Remove the entire contents of a mail folder
1245sub mailbox_empty_folder
1246{
1247return undef if (&is_readonly_mode());
1248local $f = $_[0];
1249&switch_to_folder_user($f);
1250if ($f->{'type'} == 0) {
1251	# mbox format mail file
1252	&empty_mail($f->{'file'});
1253	}
1254elsif ($f->{'type'} == 1) {
1255	# qmail format maildir
1256	&empty_maildir($f->{'file'});
1257	}
1258elsif ($f->{'type'} == 2) {
1259	# POP3 server .. delete all messages
1260	local @rv = &pop3_login($f);
1261	if ($rv[0] == 0) { &error($rv[1]); }
1262	elsif ($rv[0] == 2) { &error(&text('save_elogin', $rv[1])); }
1263	local $h = $rv[1];
1264	@rv = &pop3_command($h, "stat");
1265	$rv[1] =~ /^(\d+)/ || return;
1266	local $count = $1;
1267	local $i;
1268	for($i=1; $i<=$count; $i++) {
1269		&pop3_command($h, "dele ".$i);
1270		}
1271	}
1272elsif ($f->{'type'} == 3) {
1273	# mh format maildir
1274	&empty_mhdir($f->{'file'});
1275	}
1276elsif ($f->{'type'} == 4) {
1277	# IMAP server .. delete all messages
1278	local @rv = &imap_login($f);
1279	if ($rv[0] == 0) { &error($rv[1]); }
1280	elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
1281	elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
1282	local $h = $rv[1];
1283	local $count = $rv[2];
1284	local $i;
1285	for($i=1; $i<=$count; $i++) {
1286		@rv = &imap_command($h, "STORE ".$i.
1287					" +FLAGS (\\Deleted)");
1288		&error(&text('save_edelete', $rv[3])) if (!$rv[0]);
1289		}
1290	@rv = &imap_command($h, "EXPUNGE");
1291	&error(&text('save_edelete', $rv[3])) if (!$rv[0]);
1292	}
1293elsif ($f->{'type'} == 5) {
1294	# Empty each sub-folder
1295	local $sf;
1296	foreach $sf (@{$f->{'subfolders'}}) {
1297		&mailbox_empty_folder($sf);
1298		}
1299	}
1300elsif ($f->{'type'} == 6) {
1301	if ($folder->{'delete'}) {
1302		# Delete all underlying messages
1303		local @dmails = &mailbox_list_mails(undef, undef, $f, 1);
1304		&mailbox_delete_mail($f, @dmails);
1305		}
1306	else {
1307		# Clear the virtual index
1308		$f->{'members'} = [ ];
1309		&save_folder($f);
1310		}
1311	}
1312&switch_from_folder_user($f);
1313
1314# Trash the folder index
1315if ($folder->{'sortable'}) {
1316	&delete_new_sort_index($folder);
1317	}
1318}
1319
1320# mailbox_copy_folder(&source, &dest)
1321# Copy all messages from one folder to another. This is done in an optimized
1322# way if possible.
1323sub mailbox_copy_folder
1324{
1325local ($src, $dest) = @_;
1326if ($src->{'type'} == 0 && $dest->{'type'} == 0) {
1327	# mbox to mbox .. just read and write the files
1328	&switch_to_folder_user($src);
1329	&open_as_mail_user(SOURCE, $src->{'file'});
1330	&switch_from_folder_user($src);
1331	&switch_to_folder_user($dest);
1332	&open_as_mail_user(DEST, ">>$dest->{'file'}");
1333	while(read(SOURCE, $buf, 32768) > 0) {
1334		print DEST $buf;
1335		}
1336	close(DEST);
1337	close(SOURCE);
1338	&switch_from_folder_user($dest);
1339	}
1340elsif ($src->{'type'} == 1 && $dest->{'type'} == 1) {
1341	# maildir to maildir .. just copy the files
1342	local @files = &get_maildir_files($src->{'file'});
1343	foreach my $f (@files) {
1344		local $fn = &unique_maildir_filename($dest);
1345		&copy_source_dest_as_mail_user($f, "$dest->{'file'}/$fn");
1346		}
1347	&mailbox_fix_permissions($dest);
1348	}
1349elsif ($src->{'type'} == 1 && $dest->{'type'} == 0) {
1350	# maildir to mbox .. append all the files
1351	&switch_to_folder_user($dest);
1352	&open_as_mail_user(DEST, ">>$dest->{'file'}");
1353	&switch_from_folder_user($dest);
1354	local $fromline = &make_from_line("webmin\@example.com")."\n";
1355	&switch_to_folder_user($src);
1356	local @files = &get_maildir_files($src->{'file'});
1357	foreach my $f (@files) {
1358		&open_as_mail_user(SOURCE, $f);
1359		print DEST $fromline;
1360		my $bs = &get_buffer_size();
1361		while(read(SOURCE, $buf, $bs) > 0) {
1362			print DEST $buf;
1363			}
1364		close(SOURCE);
1365		}
1366	close(DEST);
1367	&switch_from_folder_user($src);
1368	}
1369else {
1370	# read in all mail and write out, in 100 message blocks
1371	local $max = &mailbox_folder_size($src);
1372	for(my $s=0; $s<$max; $s+=100) {
1373		local $e = $s+99;
1374		$e = $max-1 if ($e >= $max);
1375		local @mail = &mailbox_list_mails($s, $e, $src);
1376		local @want = @mail[$s..$e];
1377		&mailbox_copy_mail($src, $dest, @want);
1378		}
1379	}
1380}
1381
1382# mailbox_move_mail(&source, &dest, mail, ...)
1383# Move mail from one folder to another
1384sub mailbox_move_mail
1385{
1386return undef if (&is_readonly_mode());
1387local $src = shift(@_);
1388local $dst = shift(@_);
1389local $now = time();
1390local $hn = &get_system_hostname();
1391local $fix_index;
1392if (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 1) {
1393	# Can just move mail files to Maildir names
1394	if ($src->{'user'} eq $dst->{'user'}) {
1395		&switch_to_folder_user($dst);
1396		}
1397	&create_folder_maildir($dst);
1398	local $dd = $dst->{'file'};
1399	foreach my $m (@_) {
1400		&rename_as_mail_user($m->{'file'}, "$dd/cur/$now.$$.$hn");
1401		$now++;
1402		}
1403	&mailbox_fix_permissions($dst);
1404	if ($src->{'user'} eq $dst->{'user'}) {
1405		&switch_from_folder_user($dst);
1406		}
1407	$fix_index = 1;
1408	}
1409elsif (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 3) {
1410	# Can move and rename to MH numbering
1411	if ($src->{'user'} eq $dst->{'user'}) {
1412		&switch_to_folder_user($dst);
1413		}
1414	&create_folder_maildir($dst);
1415	local $dd = $dst->{'file'};
1416	local $num = &max_mhdir($dst->{'file'}) + 1;
1417	foreach my $m (@_) {
1418		&rename_as_mail_user($m->{'file'}, "$dd/$num");
1419		$num++;
1420		}
1421	&mailbox_fix_permissions($dst);
1422	if ($src->{'user'} eq $dst->{'user'}) {
1423		&switch_from_folder_user($dst);
1424		}
1425	$fix_index = 1;
1426	}
1427else {
1428	# Append to new folder file, or create in folder directory
1429	my @mdel;
1430	my $r;
1431	my $save_read = &get_product_name() eq "usermin";
1432	&switch_to_folder_user($dst);
1433	&create_folder_maildir($dst);
1434	foreach my $m (@_) {
1435		$r = &get_mail_read($src, $m) if ($save_read);
1436		my $mcopy = { %$m };
1437		&write_mail_folder($mcopy, $dst);
1438		&set_mail_read($dst, $mcopy, $r) if ($save_read);
1439		push(@mdel, $m);
1440		}
1441	local $src->{'notrash'} = 1;	# Prevent saving to trash
1442	&switch_from_folder_user($dst);
1443	&mailbox_delete_mail($src, @mdel);
1444	}
1445}
1446
1447# mailbox_fix_permissions(&folder, [&stat])
1448# Set the ownership on all files in a folder correctly, either based on its
1449# current stat or a structure passed in.
1450sub mailbox_fix_permissions
1451{
1452local ($f, $st) = @_;
1453return 0 if ($< != 0);			# Only makes sense when running as root
1454return 0 if ($main::mail_open_user);	# File ops are already done as the
1455					# correct user
1456$st ||= [ stat($f->{'file'}) ];
1457if ($f->{'type'} == 0) {
1458	# Set perms on a single file
1459	&set_ownership_permissions($st->[4], $st->[5], $st->[2], $f->{'file'});
1460	return 1;
1461	}
1462elsif ($f->{'type'} == 1 || $f->{'type'} == 3) {
1463	# Do a whole directory
1464	&execute_command("chown -R $st->[4]:$st->[5] ".
1465			 quotemeta($dst->{'file'}));
1466	return 1;
1467	}
1468return 0;
1469}
1470
1471# mailbox_move_folder(&source, &dest)
1472# Moves all mail from one folder to another, possibly converting the type
1473sub mailbox_move_folder
1474{
1475local ($src, $dst) = @_;
1476return undef if (&is_readonly_mode());
1477&switch_to_folder_user($dst);
1478if ($src->{'type'} == $dst->{'type'} && !$src->{'remote'}) {
1479	# Can just move the file or dir
1480	local @st = stat($src->{'file'});
1481	&unlink_file($dst->{'file'});
1482	&rename_as_mail_user($src->{'file'}, $dst->{'file'});
1483	if (@st) {
1484		&mailbox_fix_permissions($dst, \@st);
1485		}
1486	}
1487elsif (($src->{'type'} == 1 || $src->{'type'} == 3) && $dst->{'type'} == 0) {
1488	# For Maildir or MH to mbox moves, just append files
1489	local @files = $src->{'type'} == 1 ? &get_maildir_files($src->{'file'})
1490					   : &get_mhdir_files($src->{'file'});
1491	&open_as_mail_user(DEST, ">>$dst->{'file'}");
1492	local $fromline = &make_from_line("webmin\@example.com");
1493	foreach my $f (@files) {
1494		&open_as_mail_user(SOURCE, $f);
1495		print DEST $fromline;
1496		while(read(SOURCE, $buf, 32768) > 0) {
1497			print DEST $buf;
1498			}
1499		close(SOURCE);
1500		&unlink_as_mail_user($f);
1501		}
1502	close(DEST);
1503	}
1504else {
1505	# Need to read in and write out. But do it in 1000-message blocks
1506	local $count = &mailbox_folder_size($src);
1507	local $step = 1000;
1508	for(my $start=0; $start<$count; $start+=$step) {
1509		local $end = $start + $step - 1;
1510		$end = $count-1 if ($end >= $count);
1511		local @mails = &mailbox_list_mails($start, $end, $src);
1512		@mails = @mails[$start..$end];
1513		&mailbox_copy_mail($src, $dst, @mails);
1514		}
1515	&mailbox_empty_folder($src);
1516	}
1517&switch_from_folder_user($dst);
1518
1519# Delete source folder index
1520if ($src->{'sortable'}) {
1521	&delete_new_sort_index($src);
1522	}
1523}
1524
1525# mailbox_copy_mail(&source, &dest, mail, ...)
1526# Copy mail from one folder to another
1527sub mailbox_copy_mail
1528{
1529return undef if (&is_readonly_mode());
1530local $src = shift(@_);
1531local $dst = shift(@_);
1532local $now = time();
1533if ($src->{'type'} == 6 && $dst->{'type'} == 6) {
1534	# Copying from one virtual folder to another, so just copy the
1535	# reference
1536	foreach my $m (@_) {
1537		push(@{$dst->{'members'}}, [ $m->{'subfolder'}, $m->{'subid'},
1538					     $m->{'header'}->{'message-id'} ]);
1539		}
1540	}
1541elsif ($dst->{'type'} == 6) {
1542	# Add this mail to the index of the virtual folder
1543	foreach my $m (@_) {
1544		push(@{$dst->{'members'}}, [ $src, $m->{'idx'},
1545					     $m->{'header'}->{'message-id'} ]);
1546		}
1547	&save_folder($dst);
1548	}
1549else {
1550	# Just write to destination folder. The read status is preserved, but
1551	# only if in Usermin.
1552	my $r;
1553	my $save_read = &get_product_name() eq "usermin";
1554	&switch_to_folder_user($dst);
1555	&create_folder_maildir($dst);
1556	foreach my $m (@_) {
1557		$r = &get_mail_read($src, $m) if ($save_read);
1558		my $mcopy = { %$m };
1559		&write_mail_folder($mcopy, $dst);
1560		&set_mail_read($dst, $mcopy, $r) if ($save_read);
1561		}
1562	&switch_from_folder_user($dst);
1563	}
1564}
1565
1566# folder_type(file_or_dir)
1567# Returns a numeric folder type based on the contents
1568sub folder_type
1569{
1570my ($f) = @_;
1571if (-d "$f/cur") {
1572	# Maildir directory
1573	return 1;
1574	}
1575elsif (-d $f) {
1576	# MH directory
1577	return 3;
1578	}
1579else {
1580	# Check for MBX format
1581	open(MBXTEST, "<", $f);
1582	my $first;
1583	read(MBXTEST, $first, 5);
1584	close(MBXTEST);
1585	return $first eq "*mbx*" ? 7 : 0;
1586	}
1587}
1588
1589# create_folder_maildir(&folder)
1590# Ensure that a maildir folder has the needed new, cur and tmp directories
1591sub create_folder_maildir
1592{
1593if ($folders_dir) {
1594	mkdir($folders_dir, 0700);
1595	}
1596if ($_[0]->{'type'} == 1) {
1597	local $id = $_[0]->{'file'};
1598	&mkdir_as_mail_user($id, 0700);
1599	&mkdir_as_mail_user("$id/cur", 0700);
1600	&mkdir_as_mail_user("$id/new", 0700);
1601	&mkdir_as_mail_user("$id/tmp", 0700);
1602	}
1603}
1604
1605# write_mail_folder(&mail, &folder, textonly)
1606# Writes some mail message to a folder
1607sub write_mail_folder
1608{
1609return undef if (&is_readonly_mode());
1610&switch_to_folder_user($_[1]);
1611&create_folder_maildir($_[1]);
1612local $needid;
1613if ($_[1]->{'type'} == 1) {
1614	# Add to a maildir directory. ID is set by write_maildir to the new
1615	# relative filename
1616	local $md = $_[1]->{'file'};
1617	&write_maildir($_[0], $md, $_[2]);
1618	}
1619elsif ($_[1]->{'type'} == 3) {
1620	# Create a new MH file. ID is just the new message number
1621	local $num = &max_mhdir($_[1]->{'file'}) + 1;
1622	local $md = $_[1]->{'file'};
1623	local @st = stat($_[1]->{'file'});
1624	&send_mail($_[0], "$md/$num", $_[2], 1);
1625	if ($< == 0) {
1626		&set_ownership_permissions($st[4], $st[5], undef, "$md/$num");
1627		}
1628	$_[0]->{'id'} = $num;
1629	}
1630elsif ($_[1]->{'type'} == 0) {
1631	# Just append to the folder file.
1632	&send_mail($_[0], $_[1]->{'file'}, $_[2], 1);
1633	$needid = 1;
1634	}
1635elsif ($_[1]->{'type'} == 4) {
1636	# Upload to the IMAP server
1637	local @rv = &imap_login($_[1]);
1638	if ($rv[0] == 0) { &error($rv[1]); }
1639	elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
1640	elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
1641	local $h = $rv[1];
1642
1643	# Create a temp file and use it to create the IMAP command
1644	local $temp = &transname();
1645	&send_mail($_[0], $temp, $_[2], 0, "dummy");
1646	local $text = &read_file_contents($temp);
1647	unlink($temp);
1648	$text =~ s/^From.*\r?\n//;	# Not part of IMAP format
1649	@rv = &imap_command($h, sprintf "APPEND \"%s\" {%d}\r\n%s",
1650			$_[1]->{'mailbox'} || "INBOX", length($text), $text);
1651	&error(&text('save_eappend', $rv[3])) if (!$rv[0]);
1652	$needid = 1;
1653	}
1654elsif ($_[1]->{'type'} == 5) {
1655	# Just append to the last subfolder
1656	local @sf = @{$_[1]->{'subfolders'}};
1657	&write_mail_folder($_[0], $sf[$#sf], $_[2]);
1658	$needid = 1;
1659	}
1660elsif ($_[1]->{'type'} == 6) {
1661	# Add mail to first sub-folder, and to virtual index
1662	# XXX not done
1663	&error("Cannot add mail to virtual folders");
1664	}
1665&switch_from_folder_user($_[1]);
1666if ($needid) {
1667	# Get the ID of the new mail
1668	local @idlist = &mailbox_idlist($_[1]);
1669	print DEBUG "new idlist=",join(" ", @idlist),"\n";
1670	$_[0]->{'id'} = $idlist[$#idlist];
1671	}
1672}
1673
1674# mailbox_modify_mail(&oldmail, &newmail, &folder, textonly)
1675# Replaces some mail message with a new one
1676sub mailbox_modify_mail
1677{
1678local ($oldmail, $mail, $folder, $textonly) = @_;
1679return undef if (&is_readonly_mode());
1680&switch_to_folder_user($_[2]);
1681if ($folder->{'type'} == 1) {
1682	# Just replace the existing file
1683	&modify_maildir($oldmail, $mail, $textonly);
1684	}
1685elsif ($folder->{'type'} == 3) {
1686	# Just replace the existing file
1687	&modify_mhdir($oldmail, $mail, $textonly);
1688	}
1689elsif ($folder->{'type'} == 0) {
1690	# Modify the mail file
1691	&modify_mail($folder->{'file'}, $oldmail, $mail, $textonly);
1692	}
1693elsif ($folder->{'type'} == 5 || $folder->{'type'} == 6) {
1694	# Modify in the underlying folder
1695	local ($oldsfn, $oldsid) = split(/\t+/, $oldmail->{'id'}, 2);
1696	local ($sfn, $sid) = split(/\t+/, $mail->{'id'}, 2);
1697	local $sf = &find_subfolder($folder, $sfn);
1698	$oldmail->{'id'} = $oldsid;
1699	$mail->{'id'} = $sid;
1700	&mailbox_modify_mail($oldmail, $mail, $sf, $textonly);
1701	$oldmail->{'id'} = $oldsfn."\t".$oldsid;
1702	$mail->{'id'} = $sfn."\t".$sid;
1703	}
1704else {
1705	&error("Cannot modify mail in this type of folder!");
1706	}
1707&switch_from_folder_user($_[2]);
1708
1709# Delete the message being modified from its index, to force re-generation
1710# with new details
1711$mail->{'id'} = $oldmail->{'id'};	# Assume that it will replace the old
1712if ($folder->{'sortable'}) {
1713	&delete_new_sort_index_message($folder, $mail->{'id'});
1714	}
1715}
1716
1717# mailbox_folder_size(&folder, [estimate])
1718# Returns the number of messages in some folder
1719sub mailbox_folder_size
1720{
1721local ($f, $est) = @_;
1722&switch_to_folder_user($f);
1723local $rv;
1724if ($f->{'type'} == 0) {
1725	# A mbox formatted file
1726	$rv = &count_mail($f->{'file'});
1727	}
1728elsif ($f->{'type'} == 1) {
1729	# A qmail maildir
1730	$rv = &count_maildir($f->{'file'});
1731	}
1732elsif ($f->{'type'} == 2) {
1733	# A POP3 server
1734	local @rv = &pop3_login($f);
1735	if ($rv[0] != 1) {
1736		if ($rv[0] == 0) { &error($rv[1]); }
1737		else { &error(&text('save_elogin', $rv[1])); }
1738		}
1739	local @st = &pop3_command($rv[1], "stat");
1740	if ($st[0] == 1) {
1741		local ($count, $size) = split(/\s+/, $st[1]);
1742		return $count;
1743		}
1744	else {
1745		&error($st[1]);
1746		}
1747	}
1748elsif ($f->{'type'} == 3) {
1749	# An MH directory
1750	$rv = &count_mhdir($f->{'file'});
1751	}
1752elsif ($f->{'type'} == 4) {
1753	# An IMAP server
1754	local @rv = &imap_login($f);
1755	if ($rv[0] != 1) {
1756		if ($rv[0] == 0) { &error($rv[1]); }
1757		elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
1758		elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
1759		}
1760        $f->{'lastchange'} = $rv[3];
1761	$rv = $rv[2];
1762	}
1763elsif ($f->{'type'} == 5) {
1764	# A composite folder - the size is just that of the sub-folders
1765	$rv = 0;
1766	foreach my $sf (@{$f->{'subfolders'}}) {
1767		$rv += &mailbox_folder_size($sf);
1768		}
1769	}
1770elsif ($f->{'type'} == 6 && !$est) {
1771	# A virtual folder .. we need to exclude messages that no longer
1772	# exist in the parent folders
1773	$rv = 0;
1774	foreach my $msg (@{$f->{'members'}}) {
1775		if (&mailbox_get_mail($msg->[0], $msg->[1])) {
1776			$rv++;
1777			}
1778		}
1779	}
1780elsif ($f->{'type'} == 6 && $est) {
1781	# A virtual folder .. but we can just use the last member count
1782	$rv = scalar(@{$f->{'members'}});
1783	}
1784&switch_from_folder_user($f);
1785return $rv;
1786}
1787
1788# mailbox_folder_unread(&folder)
1789# Returns the total messages in some folder, the number unread and the number
1790# flagged as special.
1791sub mailbox_folder_unread
1792{
1793local ($folder) = @_;
1794if ($folder->{'type'} == 4) {
1795	# For IMAP, the server knows
1796	local @rv = &imap_login($folder);
1797	if ($rv[0] != 1) {
1798		return ( );
1799		}
1800	local @data = ( $rv[2] );
1801	local $h = $rv[1];
1802	foreach my $s ("UNSEEN", "FLAGGED") {
1803		@rv = &imap_command($h, "SEARCH ".$s);
1804		local ($srch) = grep { $_ =~ /^\*\s+SEARCH/i } @{$rv[1]};
1805		local @ids = split(/\s+/, $srch);
1806		shift(@ids); shift(@ids);	# lose * SEARCH
1807		push(@data, scalar(@ids));
1808		}
1809	return @data;
1810	}
1811elsif ($folder->{'type'} == 5) {
1812	# Composite folder - counts are sums of sub-folders
1813	local @data;
1814	foreach my $sf (@{$folder->{'subfolders'}}) {
1815		local @sfdata = &mailbox_folder_unread($sf);
1816		if (scalar(@sfdata)) {
1817			$data[0] += $sfdata[0];
1818			$data[1] += $sfdata[1];
1819			$data[2] += $sfdata[2];
1820			}
1821		}
1822	return @data;
1823	}
1824else {
1825	# For all other folders, just check individual messages
1826	# XXX faster for maildir?
1827	local @data = ( 0, 0, 0 );
1828	local @mails;
1829	eval {
1830		$main::error_must_die = 1;
1831		@mails = &mailbox_list_mails(undef, undef, $folder, 1);
1832		};
1833	return ( ) if ($@);
1834	foreach my $m (@mails) {
1835		local $rf = &get_mail_read($folder, $m);
1836		if ($rf == 2) {
1837			$data[2]++;
1838			}
1839		elsif ($rf == 0) {
1840			$data[1]++;
1841			}
1842		$data[0]++;
1843		}
1844	return @data;
1845	}
1846}
1847
1848# mailbox_set_read_flags(&folder, &mail, read, special, replied)
1849# Updates the status flags on some message
1850sub mailbox_set_read_flag
1851{
1852local ($folder, $mail, $read, $special, $replied) = @_;
1853if ($folder->{'type'} == 4) {
1854	# Set flags on IMAP server
1855	local @rv = &imap_login($folder);
1856	if ($rv[0] == 0) { &error($rv[1]); }
1857	elsif ($rv[0] == 3) { &error(&text('save_emailbox', $rv[1])); }
1858	elsif ($rv[0] == 2) { &error(&text('save_elogin2', $rv[1])); }
1859	local $h = $rv[1];
1860	foreach my $f ([ $read, "\\Seen" ],
1861		       [ $special, "\\Flagged" ],
1862		       [ $replied, "\\Answered" ]) {
1863		print DEBUG "setting '$f->[0]' '$f->[1]' for $mail->{'id'}\n";
1864		next if (!defined($f->[0]));
1865		local $pm = $f->[0] ? "+" : "-";
1866		@rv = &imap_command($h, "UID STORE ".$mail->{'id'}.
1867					" ".$pm."FLAGS (".$f->[1].")");
1868		&error(&text('save_eflag', $rv[3])) if (!$rv[0]);
1869		}
1870	}
1871elsif ($folder->{'type'} == 1) {
1872	# Add flag to special characters at end of filename
1873	my $file = $mail->{'file'} || $mail->{'id'};
1874	my $path;
1875	if (!$mail->{'file'}) {
1876		$path = "$folder->{'file'}/";
1877		}
1878	my ($base, %flags);
1879	if ($file =~ /^(.*):2,([A-Z]*)$/) {
1880		$base = $1;
1881		%flags = map { $_, 1 } split(//, $2);
1882		}
1883	else {
1884		$base = $file;
1885		}
1886	$flags{'S'} = $read;
1887	$flags{'F'} = $special;
1888	$flags{'R'} = $replied if (defined($replied));
1889	my $newfile = $base.":2,".
1890			 join("", grep { $flags{$_} } sort(keys %flags));
1891	if ($newfile ne $file) {
1892		# Need to rename file
1893		rename("$path$file", "$path$newfile");
1894		$newfile =~ s/^(.*)\/((cur|tmp|new)\/.*)$/$2/;
1895		$mail->{'id'} = $newfile;
1896		&flush_maildir_cachefile($folder->{'file'});
1897		}
1898	}
1899else {
1900	&error("Read flags cannot be set on folders of type $folder->{'type'}");
1901	}
1902
1903# Update the mail object too
1904$mail->{'read'} = $read if (defined($read));
1905$mail->{'special'} = $special if (defined($special));
1906$mail->{'replied'} = $replied if (defined($replied));
1907}
1908
1909# pop3_login(&folder)
1910# Logs into a POP3 server and returns a status (1=ok, 0=connect failed,
1911# 2=login failed) and handle or error message
1912sub pop3_login
1913{
1914local $h = $pop3_login_handle{$_[0]->{'id'}};
1915return (1, $h) if ($h);
1916$h = "POP3".time().++$pop3_login_count;
1917local $error;
1918&open_socket($_[0]->{'server'}, $_[0]->{'port'} || 110, $h, \$error);
1919print DEBUG "pop3 open_socket to $_[0]->{'server'} : $error\n";
1920return (0, $error) if ($error);
1921local $os = select($h); $| = 1; select($os);
1922local @rv = &pop3_command($h);
1923return (0, $rv[1]) if (!$rv[0]);
1924local $user = $_[0]->{'user'} eq '*' ? $remote_user : $_[0]->{'user'};
1925@rv = &pop3_command($h, "user $user");
1926return (2, $rv[1]) if (!$rv[0]);
1927@rv = &pop3_command($h, "pass $_[0]->{'pass'}");
1928return (2, $rv[1]) if (!$rv[0]);
1929return (1, $pop3_login_handle{$_[0]->{'id'}} = $h);
1930}
1931
1932# pop3_command(handle, command)
1933# Executes a command and returns the status (1 or 0 for OK or ERR) and message
1934sub pop3_command
1935{
1936local ($h, $c) = @_;
1937print $h "$c\r\n" if ($c);
1938local $rv = <$h>;
1939$rv =~ s/\r|\n//g;
1940print DEBUG "pop3 $c -> $rv\n";
1941return !$rv ? ( 0, "Connection closed" ) :
1942       $rv =~ /^\+OK\s*(.*)/ ? ( 1, $1 ) :
1943       $rv =~ /^\-ERR\s*(.*)/ ? ( 0, $1 ) : ( 0, $rv );
1944}
1945
1946# pop3_logout(handle, doquit)
1947sub pop3_logout
1948{
1949local @rv = $_[1] ? &pop3_command($_[0], "quit") : (1, undef);
1950local $f;
1951foreach $f (keys %pop3_login_handle) {
1952	delete($pop3_login_handle{$f}) if ($pop3_login_handle{$f} eq $_[0]);
1953	}
1954close($_[0]);
1955return @rv;
1956}
1957
1958# pop3_uidl(handle)
1959# Returns the uidl list
1960sub pop3_uidl
1961{
1962local @rv;
1963local $h = $_[0];
1964local @urv = &pop3_command($h, "uidl");
1965if (!$urv[0] && $urv[1] =~ /not\s+implemented/i) {
1966	# UIDL is not available?! Use numeric list instead
1967	&pop3_command($h, "list");
1968	while(<$h>) {
1969		s/\r//g;
1970		last if ($_ eq ".\n");
1971		if (/^(\d+)\s+(\d+)/) {
1972			push(@rv, "size$2");
1973			}
1974		}
1975	}
1976elsif (!$urv[0]) {
1977	&error("uidl failed! $urv[1]") if (!$urv[0]);
1978	}
1979else {
1980	# Can get normal UIDL list
1981	while(<$h>) {
1982		s/\r//g;
1983		last if ($_ eq ".\n");
1984		if (/^(\d+)\s+(\S+)/) {
1985			push(@rv, $2);
1986			}
1987		}
1988	}
1989return @rv;
1990}
1991
1992# pop3_logout_all()
1993# Properly closes all open POP3 and IMAP sessions
1994sub pop3_logout_all
1995{
1996local $f;
1997foreach $f (keys %pop3_login_handle) {
1998	&pop3_logout($pop3_login_handle{$f}, 1);
1999	}
2000foreach $f (keys %imap_login_handle) {
2001	&imap_logout($imap_login_handle{$f}, 1);
2002	}
2003}
2004
2005# imap_login(&folder)
2006# Logs into a POP3 server, selects a mailbox and returns a status
2007# (1=ok, 0=connect failed, 2=login failed, 3=mailbox error), a handle or error
2008# message, the number of messages in the mailbox, the next UID, the number
2009# unread, and the number special.
2010sub imap_login
2011{
2012local ($folder) = @_;
2013local $defport = $folder->{'ssl'} ? 993 : 143;
2014local $port = $folder->{'port'} || $defport;
2015local $key = join("/", $folder->{'server'}, $port, $folder->{'user'});
2016local $h = $imap_login_handle{$key};
2017local @rv;
2018if (!$h) {
2019	# Need to open socket
2020	$h = ($folder->{'ssl'} ? "SSL" : "")."IMAP".time().++$imap_login_count;
2021	local $error;
2022	print DEBUG "Connecting to IMAP server $folder->{'server'}:$port\n";
2023	&open_socket($folder->{'server'}, $port, $h, \$error);
2024	print DEBUG "IMAP error=$error\n" if ($error);
2025	return (0, $error) if ($error);
2026	local $os = select($h); $| = 1; select($os);
2027	if ($folder->{'ssl'}) {
2028		# Switch to SSL mode
2029                eval "use Net::SSLeay";
2030                $@ && return (0, "Net::SSLeay module is not installed");
2031                eval "Net::SSLeay::SSLeay_add_ssl_algorithms()";
2032                eval "Net::SSLeay::load_error_strings()";
2033                my $ssl_ctx = Net::SSLeay::CTX_new() ||
2034                        return (0, "Failed to create SSL context");
2035                my $ssl_con = Net::SSLeay::new($ssl_ctx) ||
2036                        return (0, "Failed to create SSL connection");
2037                Net::SSLeay::set_fd($ssl_con, fileno($h));
2038                Net::SSLeay::connect($ssl_con) ||
2039                        return (0, "SSL connect() failed");
2040		$imap_login_ssl{$h} = $ssl_con;
2041		}
2042
2043	# Login normally
2044	@rv = &imap_command($h);
2045	return (0, $rv[3] || "No response") if (!$rv[0]);
2046	local $user = $folder->{'user'} eq '*' ? $remote_user
2047					       : $folder->{'user'};
2048	local $pass = $folder->{'pass'};
2049	$pass =~ s/\\/\\\\/g;
2050	$pass =~ s/"/\\"/g;
2051	@rv = &imap_command($h,"login \"$user\" \"$pass\"");
2052	return (2, $rv[3] || "No response") if (!$rv[0]);
2053
2054	$imap_login_handle{$key} = $h;
2055	}
2056
2057# Select the right folder (if one was given)
2058@rv = &imap_command($h, "select \"".($folder->{'mailbox'} || "INBOX")."\"");
2059return (3, $rv[3]) if (!$rv[0]);
2060local $count = $rv[2] =~ /\*\s+(\d+)\s+EXISTS/i ? $1 : undef;
2061local $uidnext = $rv[2] =~ /UIDNEXT\s+(\d+)/ ? $1 : undef;
2062return (1, $h, $count, $uidnext);
2063}
2064
2065# imap_command(handle, command)
2066# Executes an IMAP command and returns 1 for success or 0 for failure, and
2067# a reference to an array of results (some of which may be multiline), and
2068# all of the results joined together, and the stuff after OK/BAD
2069sub imap_command
2070{
2071my ($h, $c) = @_;
2072if (!$h) {
2073	my $err = "Invalid IMAP handle";
2074	return (0, [ $err ], $err, $err);
2075	}
2076my $ssl_con = $imap_login_ssl{$h};
2077my @rv;
2078
2079# Send the command, and read lines until a non-* one is found
2080my $id = $$."-".$imap_command_count++;
2081my ($first, $rest) = split(/\r?\n/, $c, 2);
2082if ($rest) {
2083	# Multi-line - send first line, then wait for continuation, then rest
2084	print DEBUG "imap command $id $first\n";
2085	my $l;
2086	if ($ssl_con) {
2087		Net::SSLeay::write($ssl_con, "$id $first\r\n");
2088		$l = Net::SSLeay::ssl_read_until($ssl_con);
2089		}
2090	else {
2091		print $h "$id $first\r\n";
2092		$l = <$h>;
2093		}
2094	print DEBUG "imap line $l";
2095	if ($l =~ /^\+/) {
2096		if ($ssl_con) {
2097			Net::SSLeay::write($ssl_con, $rest."\r\n");
2098			}
2099		else {
2100			print $h $rest."\r\n";
2101			}
2102		}
2103	else {
2104		my $err = "Server did not ask for continuation : $l";
2105		return (0, [ $err ], $err, $err);
2106		}
2107	}
2108elsif ($c) {
2109	# Single line command
2110	if ($ssl_con) {
2111		Net::SSLeay::write($ssl_con, "$id $c\r\n");
2112		}
2113	else {
2114		print $h "$id $c\r\n";
2115		}
2116	print DEBUG "imap command $id $c\n";
2117	}
2118while(1) {
2119	my $l;
2120	if ($ssl_con) {
2121		$l = Net::SSLeay::ssl_read_until($ssl_con);
2122		}
2123	else {
2124		$l = <$h>;
2125		}
2126	print DEBUG "imap line $l";
2127	last if (!$l);
2128	if ($l =~ /^(\*|\+)/) {
2129		# Another response, and possibly the only one if no command
2130		# was sent.
2131		push(@rv, $l);
2132		last if (!$c);
2133		if ($l =~ /\{(\d+)\}\s*$/) {
2134			# Start of multi-line text .. read the specified size
2135			my $size = $1;
2136			my $got;
2137			my $err = "Error reading email";
2138			while($got < $size) {
2139				my $buf;
2140				my $r;
2141				if ($ssl_con) {
2142					$buf = Net::SSLeay::read($ssl_con, $size-$got);
2143					$r = length($buf);
2144					}
2145				else {
2146					$r = read($h, $buf, $size-$got);
2147					}
2148				return (0, [ $err ], $err, $err) if ($r <= 0);
2149				$rv[$#rv] .= $buf;
2150				$got += $r;
2151				}
2152			}
2153		}
2154	elsif ($l =~ /^(\S+)\s+/ && $1 eq $id) {
2155		# End of responses
2156		push(@rv, $l);
2157		last;
2158		}
2159	else {
2160		# Part of last response
2161		if (!@rv) {
2162			my $err = "Got unknown line $l";
2163			return (0, [ $err ], $err, $err);
2164			}
2165		$rv[$#rv] .= $l;
2166		}
2167	}
2168my $j = join("", @rv);
2169print DEBUG "imap response $j\n";
2170my $lline = $rv[$#rv];
2171if ($lline =~ /^(\S+)\s+OK\s*(.*)/) {
2172	# Looks like the command worked
2173	return (1, \@rv, $j, $2);
2174	}
2175else {
2176	# Command failed!
2177	return (0, \@rv, $j, $lline =~ /^(\S+)\s+(\S+)\s*(.*)/ ? $3 : $lline);
2178	}
2179}
2180
2181# imap_logout(handle, doquit)
2182sub imap_logout
2183{
2184local @rv = $_[1] ? &imap_command($_[0], "close") : (1, undef);
2185local $f;
2186foreach $f (keys %imap_login_handle) {
2187	delete($imap_login_handle{$f}) if ($imap_login_handle{$f} eq $_[0]);
2188	}
2189close($_[0]);
2190return @rv;
2191}
2192
2193# lock_folder(&folder)
2194sub lock_folder
2195{
2196return if ($_[0]->{'remote'} || $_[0]->{'type'} == 5 || $_[0]->{'type'} == 6);
2197local $f = $_[0]->{'file'} ? $_[0]->{'file'} :
2198	   $_[0]->{'type'} == 0 ? &user_mail_file($remote_user) :
2199				  $qmail_maildir;
2200if (&lock_file($f)) {
2201	$_[0]->{'lock'} = $f;
2202	}
2203else {
2204	# Cannot lock if in /var/mail
2205	local $ff = $f;
2206	$ff =~ s/\//_/g;
2207	$ff = "/tmp/$ff";
2208	$_[0]->{'lock'} = $ff;
2209	&lock_file($ff);
2210	}
2211
2212# Also, check for a .filename.pop3 file
2213if ($config{'pop_locks'} && $f =~ /^(\S+)\/([^\/]+)$/) {
2214	local $poplf = "$1/.$2.pop";
2215	local $count = 0;
2216	while(-r $poplf) {
2217		sleep(1);
2218		if ($count++ > 5*60) {
2219			# Give up after 5 minutes
2220			&error(&text('epop3lock_tries', "<tt>$f</tt>", 5));
2221			}
2222		}
2223	}
2224}
2225
2226# unlock_folder(&folder)
2227sub unlock_folder
2228{
2229return if ($_[0]->{'remote'});
2230&unlock_file($_[0]->{'lock'});
2231}
2232
2233# folder_file(&folder)
2234# Returns the full path to the file or directory containing the folder's mail,
2235# or undef if not appropriate (such as for POP3)
2236sub folder_file
2237{
2238return $_[0]->{'remote'} ? undef : $_[0]->{'file'};
2239}
2240
2241# parse_imap_mail(response)
2242# Parses a response from the IMAP server into a standard mail structure
2243sub parse_imap_mail
2244{
2245local ($imap) = @_;
2246
2247# Extract the actual mail part
2248local $mail = { };
2249local $realsize;
2250if ($imap =~ /RFC822.SIZE\s+(\d+)/) {
2251	$realsize = $1;
2252	}
2253if ($imap =~ /UID\s+(\d+)/) {
2254	$mail->{'id'} = $1;
2255	}
2256if ($imap =~ /FLAGS\s+\(([^\)]+)\)/ ||
2257    $imap =~ /FLAGS\s+(\S+)/) {
2258	# Got read flags .. use them
2259	local @flags = split(/\s+/, $1);
2260	$mail->{'read'} = &indexoflc("\\Seen", @flags) >= 0 ? 1 : 0;
2261	$mail->{'special'} = &indexoflc("\\Flagged", @flags) >= 0 ? 1 : 0;
2262	$mail->{'replied'} = &indexoflc("\\Answered", @flags) >= 0 ? 1 : 0;
2263	$mail->{'deleted'} = &indexoflc("\\Deleted", @flags) >= 0 ? 1 : 0;
2264	}
2265$imap =~ s/^\*\s+(\d+)\s+FETCH.*\{(\d+)\}\r?\n// || return undef;
2266$mail->{'imapidx'} = $1;
2267local $size = $2;
2268local @lines = split(/\n/, substr($imap, 0, $size));
2269
2270# Parse the headers
2271local $lnum = 0;
2272local @headers;
2273while(1) {
2274	local $line = $lines[$lnum++];
2275	$mail->{'size'} += length($line);
2276	$line =~ s/\r//g;
2277	last if ($line eq '');
2278	if ($line =~ /^(\S+):\s*(.*)/) {
2279		push(@headers, [ $1, $2 ]);
2280		}
2281	elsif ($line =~ /^(\s+.*)/) {
2282		$headers[$#headers]->[1] .= $1
2283			unless($#headers < 0);
2284		}
2285	}
2286$mail->{'headers'} = \@headers;
2287foreach $h (@headers) {
2288	$mail->{'header'}->{lc($h->[0])} = $h->[1];
2289	}
2290
2291# Parse the body
2292while($lnum < @lines) {
2293	$mail->{'size'} += length($lines[$lnum]+1);
2294	$mail->{'body'} .= $lines[$lnum]."\n";
2295	$lnum++;
2296	}
2297$mail->{'size'} = $realsize if ($realsize);
2298return $mail;
2299}
2300
2301# find_body(&mail, mode)
2302# Returns the plain text body, html body and the one to use
2303sub find_body
2304{
2305local ($a, $body, $textbody, $htmlbody);
2306foreach $a (@{$_[0]->{'attach'}}) {
2307	next if ($a->{'header'}->{'content-disposition'} =~ /^attachment/i);
2308	if ($a->{'type'} =~ /^text\/plain/i || $a->{'type'} eq 'text') {
2309		$textbody = $a if (!$textbody && $a->{'data'} =~ /\S/);
2310		}
2311	elsif ($a->{'type'} =~ /^text\/html/i) {
2312		$htmlbody = $a if (!$htmlbody && $a->{'data'} =~ /\S/);
2313		}
2314	}
2315if ($_[1] == 0) {
2316	$body = $textbody;
2317	}
2318elsif ($_[1] == 1) {
2319	$body = $textbody || $htmlbody;
2320	}
2321elsif ($_[1] == 2) {
2322	$body = $htmlbody || $textbody;
2323	}
2324elsif ($_[1] == 3) {
2325	# Convert HTML to text if needed
2326	if ($textbody) {
2327		$body = $textbody;
2328		}
2329	elsif ($htmlbody) {
2330		local $text = &html_to_text($htmlbody->{'data'});
2331		$body = $textbody =
2332			{ 'data' => $text };
2333		}
2334	}
2335return ($textbody, $htmlbody, $body);
2336}
2337
2338# safe_html(html)
2339# Converts HTML to a form safe for inclusion in a page
2340sub safe_html
2341{
2342local $html = $_[0];
2343local $bodystuff;
2344if ($html =~ s/^[\000-\377]*?<BODY([^>]*)>//i) {
2345	$bodystuff = $1;
2346	}
2347$html =~ s/<\/BODY>[\000-\377]*$//i;
2348$html =~ s/<base[^>]*>//i;
2349$html = &filter_javascript($html);
2350$html = &safe_urls($html);
2351$bodystuff = &safe_html($bodystuff) if ($bodystuff);
2352return wantarray ? ($html, $bodystuff) : $html;
2353}
2354
2355# head_html(html)
2356# Returns HTML in the <head> section of a document
2357sub head_html
2358{
2359local $html = $_[0];
2360return undef if ($html !~ /<HEAD[^>]*>/i || $html !~ /<\/HEAD[^>]*>/i);
2361$html =~ s/^[\000-\377]*<HEAD[^>]*>//gi || &error("Failed to filter <pre>".&html_escape($html)."</pre>");
2362$html =~ s/<\/HEAD[^>]*>[\000-\377]*//gi || &error("Failed to filter <pre>".&html_escape($html)."</pre>");
2363$html =~ s/<base[^>]*>//i;
2364return &filter_javascript($html);
2365}
2366
2367# safe_urls(html)
2368# Replaces dangerous-looking URLs in HTML
2369sub safe_urls
2370{
2371local $html = $_[0];
2372$html =~ s/((src|href|background)\s*=\s*)([^ '">]+)()/&safe_url($1, $3, $4)/gei;
2373$html =~ s/((src|href|background)\s*=\s*')([^']+)(')/&safe_url($1, $3, $4)/gei;
2374$html =~ s/((src|href|background)\s*=\s*")([^"]+)(")/&safe_url($1, $3, $4)/gei;
2375return $html;
2376}
2377
2378# safe_url(before, url, after)
2379sub safe_url
2380{
2381local ($before, $url, $after) = @_;
2382if ($url =~ /^#/) {
2383	# Relative link - harmless
2384	return $before.$url.$after;
2385	}
2386elsif ($url =~ /^cid:/i) {
2387	# Definitely safe (CIDs are harmless)
2388	return $before.$url.$after;
2389	}
2390elsif ($url =~ /^(http:|https:)/) {
2391	# Possibly safe, unless refers to local
2392	local ($host, $port, $page, $ssl) = &parse_http_url($url);
2393	local ($hhost, $hport) = split(/:/, $ENV{'HTTP_HOST'});
2394	$hport ||= $ENV{'SERVER_PORT'};
2395	if ($host ne $hhost ||
2396	    $port != $hport ||
2397	    $ssl != (uc($ENV{'HTTPS'}) eq 'ON' ? 1 : 0)) {
2398		return $before.$url.$after;
2399		}
2400	else {
2401		return $before."_unsafe_link_".$after;
2402		}
2403	}
2404elsif ($url =~ /^mailto:([a-z0-9\.\-\_\@\%]+)/i) {
2405	# A mailto link which is URL-escaped
2406	return $before."reply_mail.cgi?new=1&to=".
2407	       &urlize(&un_urlize($1)).$after;
2408	}
2409elsif ($url =~ /^mailto:([a-z0-9\.\-\_\@]+)/i) {
2410	# A mailto link, which we can convert
2411	return $before."reply_mail.cgi?new=1&to=".&urlize($1).$after;
2412	}
2413elsif ($url =~ /\.cgi/) {
2414	# Relative URL like foo.cgi or /foo.cgi or ../foo.cgi - unsafe!
2415	return $before."_unsafe_link_".$after;
2416	}
2417else {
2418	# Non-CGI URL .. assume safe
2419	return $before.$url.$after;
2420	}
2421}
2422
2423# safe_uidl(string)
2424sub safe_uidl
2425{
2426local $rv = $_[0];
2427$rv =~ s/\/|\./_/g;
2428return $rv;
2429}
2430
2431# html_to_text(html)
2432# Attempts to convert some HTML to text form
2433sub html_to_text
2434{
2435local ($h2, $lynx);
2436if (($h2 = &has_command("html2text")) || ($lynx = &has_command("lynx"))) {
2437	# Can use a commonly available external program
2438	local $temp = &transname().".html";
2439	open(TEMP, ">", $temp);
2440	print TEMP $_[0];
2441	close(TEMP);
2442	open(OUT, ($lynx ? "$lynx -dump $temp" : "$h2 $temp")." 2>/dev/null |");
2443	while(<OUT>) {
2444		if ($lynx && $_ =~ /^\s*References\s*$/) {
2445			# Start of Lynx references output
2446			$gotrefs++;
2447			}
2448		elsif ($lynx && $gotrefs &&
2449		       $_ =~ /^\s*(\d+)\.\s+(http|https|ftp|mailto)/) {
2450			# Skip this URL reference line
2451			}
2452		else {
2453			$text .= $_;
2454			}
2455		}
2456	close(OUT);
2457	unlink($temp);
2458	return $text;
2459	}
2460else {
2461	# Do conversion manually :(
2462	local $html = $_[0];
2463	$html =~ s/\s+/ /g;
2464	$html =~ s/<p>/\n\n/gi;
2465	$html =~ s/<br>/\n/gi;
2466	$html =~ s/<[^>]+>//g;
2467	$html = &entities_to_ascii($html);
2468	return $html;
2469	}
2470}
2471
2472# folder_select(&folders, selected-folder, name, [extra-options], [by-id],
2473#		[auto-submit])
2474# Returns HTML for selecting a folder
2475sub folder_select
2476{
2477local ($folders, $folder, $name, $extra, $byid, $auto) = @_;
2478local @opts;
2479push(@opts, @$extra) if ($extra);
2480foreach my $f (@$folders) {
2481	next if ($f->{'hide'} && $f ne $_[1]);
2482	local $umsg;
2483	if (&should_show_unread($f)) {
2484		local ($c, $u) = &mailbox_folder_unread($f);
2485		if ($u) {
2486			$umsg = " ($u)";
2487			}
2488		}
2489	push(@opts, [ $byid ? &folder_name($f) : $f->{'index'},
2490		      $f->{'name'}.$umsg ]);
2491	}
2492return &ui_select($name, $byid ? &folder_name($folder) : $folder->{'index'},
2493		  \@opts, 1, 0, 0, 0, $auto ? "onChange='form.submit()'" : "");
2494}
2495
2496# folder_size(&folder, ...)
2497# Sets the 'size' field of one or more folders, and returns the total
2498sub folder_size
2499{
2500local ($f, $total);
2501foreach $f (@_) {
2502	if ($f->{'type'} == 0 || $f->{'type'} == 7) {
2503		# Single mail file - size is easy
2504		local @st = stat($f->{'file'});
2505		$f->{'size'} = $st[7];
2506		}
2507	elsif ($f->{'type'} == 1) {
2508		# Maildir folder size is that of all files in it, except
2509		# sub-folders.
2510		$f->{'size'} = 0;
2511		foreach my $sd ("cur", "new", "tmp") {
2512			$f->{'size'} += &recursive_disk_usage(
2513					$f->{'file'}."/".$sd, '^\\.');
2514			}
2515		}
2516	elsif ($f->{'type'} == 3) {
2517		# MH folder size is that of all mail files
2518		local $mf;
2519		$f->{'size'} = 0;
2520		opendir(MHDIR, $f->{'file'});
2521		while($mf = readdir(MHDIR)) {
2522			next if ($mf eq "." || $mf eq "..");
2523			local @st = stat("$f->{'file'}/$mf");
2524			$f->{'size'} += $st[7];
2525			}
2526		closedir(MHDIR);
2527		}
2528	elsif ($f->{'type'} == 4) {
2529		# Get size of IMAP folder
2530		local ($ok, $h, $count, $uidnext) = &imap_login($f);
2531		if ($ok) {
2532			$f->{'size'} = 0;
2533			$f->{'lastchange'} = $uidnext;
2534			local @rv = &imap_command($h,
2535				"FETCH 1:$count (RFC822.SIZE)");
2536			foreach my $r (@{$rv[1]}) {
2537				if ($r =~ /RFC822.SIZE\s+(\d+)/) {
2538					$f->{'size'} += $1;
2539					}
2540				}
2541			}
2542		}
2543	elsif ($f->{'type'} == 5) {
2544		# Size of a combined folder is the size of all sub-folders
2545		return &folder_size(@{$f->{'subfolders'}});
2546		}
2547	else {
2548		# Cannot get size of a POP3 folder
2549		$f->{'size'} = undef;
2550		}
2551	$total += $f->{'size'};
2552	}
2553return $total;
2554}
2555
2556# parse_boolean(string)
2557# Separates a string into a series of and/or separated values. Returns a
2558# mode number (0=or, 1=and, 2=both) and a list of words
2559sub parse_boolean
2560{
2561local @rv;
2562local $str = $_[0];
2563local $mode = -1;
2564local $lastandor = 0;
2565while($str =~ /^\s*"([^"]*)"(.*)$/ ||
2566      $str =~ /^\s*"([^"]*)"(.*)$/ ||
2567      $str =~ /^\s*(\S+)(.*)$/) {
2568	local $word = $1;
2569	$str = $2;
2570	if (lc($word) eq "and") {
2571		if ($mode < 0) { $mode = 1; }
2572		elsif ($mode != 1) { $mode = 2; }
2573		$lastandor = 1;
2574		}
2575	elsif (lc($word) eq "or") {
2576		if ($mode < 0) { $mode = 0; }
2577		elsif ($mode != 0) { $mode = 2; }
2578		$lastandor = 1;
2579		}
2580	else {
2581		if (!$lastandor && @rv) {
2582			$rv[$#rv] .= " ".$word;
2583			}
2584		else {
2585			push(@rv, $word);
2586			}
2587		$lastandor = 0;
2588		}
2589	}
2590$mode = 0 if ($mode < 0);
2591return ($mode, \@rv);
2592}
2593
2594# recursive_files(dir, treat-dirs-as-folders)
2595sub recursive_files
2596{
2597local ($f, @rv);
2598opendir(DIR, $_[0]);
2599local @files = readdir(DIR);
2600closedir(DIR);
2601foreach $f (@files) {
2602	next if ($f eq "." || $f eq ".." || $f =~ /\.lock$/i ||
2603		 $f eq "cur" || $f eq "tmp" || $f eq "new" ||
2604		 $f =~ /^\.imap/i || $f eq ".customflags" ||
2605		 $f eq "dovecot-uidlist" || $f =~ /^courierimap/ ||
2606		 $f eq "maildirfolder" || $f eq "maildirsize" ||
2607		 $f eq "maildircache" || $f eq ".subscriptions" ||
2608                 $f eq ".usermin-maildircache" || $f =~ /^dovecot\.index/ ||
2609		 $f =~ /^dovecot-uidvalidity/ || $f eq "subscriptions" ||
2610		 $f =~ /\.webmintmp\.\d+$/ || $f eq "dovecot-keywords" ||
2611		 $f =~ /^dovecot\.mailbox/);
2612	local $p = "$_[0]/$f";
2613	local $added = 0;
2614	if ($_[1] || !-d $p || -d "$p/cur") {
2615		push(@rv, $p);
2616		$added = 1;
2617		}
2618	# If this directory wasn't a folder (or it it in Maildir format),
2619	# search it too.
2620	if (-d "$p/cur" || !$added) {
2621		push(@rv, &recursive_files($p));
2622		}
2623	}
2624return @rv;
2625}
2626
2627# editable_mail(&mail)
2628# Returns 0 if some mail message should not be editable (ie. internal folder)
2629sub editable_mail
2630{
2631return $_[0]->{'header'}->{'subject'} !~ /DON'T DELETE THIS MESSAGE.*FOLDER INTERNAL DATA/;
2632}
2633
2634# fix_cids(html, &attachments, url-prefix)
2635# Replaces HTML like img src=cid:XXX with img src=detach.cgi?whatever
2636sub fix_cids
2637{
2638local $rv = $_[0];
2639
2640# Fix images referring to CIDs
2641$rv =~ s/(src="|href="|background=")cid:([^"]+)(")/$1.&fix_cid($2,$_[1],$_[2]).$3/gei;
2642$rv =~ s/(src='|href='|background=')cid:([^']+)(')/$1.&fix_cid($2,$_[1],$_[2]).$3/gei;
2643$rv =~ s/(src=|href=|background=)cid:([^\s>]+)()/$1.&fix_cid($2,$_[1],$_[2]).$3/gei;
2644
2645# Fix images whose URL is actually in an attachment
2646$rv =~ s/(src="|href="|background=")([^"]+)(")/$1.&fix_contentlocation($2,$_[1],$_[2]).$3/gei;
2647$rv =~ s/(src='|href='|background=')([^']+)(')/$1.&fix_contentlocation($2,$_[1],$_[2]).$3/gei;
2648$rv =~ s/(src=|href=|background=)([^\s>]+)()/$1.&fix_contentlocation($2,$_[1],$_[2]).$3/gei;
2649return $rv;
2650}
2651
2652# fix_cid(cid, &attachments, url-prefix)
2653sub fix_cid
2654{
2655local ($cont) = grep { $_->{'header'}->{'content-id'} eq $_[0] ||
2656		       $_->{'header'}->{'content-id'} eq "<$_[0]>" } @{$_[1]};
2657if ($cont) {
2658	return "$_[2]&attach=$cont->{'idx'}";
2659	}
2660else {
2661	return "cid:$_[0]";
2662	}
2663}
2664
2665# fix_contentlocation(url, &attachments, url-prefix)
2666sub fix_contentlocation
2667{
2668local ($cont) = grep { $_->{'header'}->{'content-location'} eq $_[0] ||
2669	       $_->{'header'}->{'content-location'} eq "<$_[0]>" } @{$_[1]};
2670if ($cont) {
2671	return "$_[2]&attach=$cont->{'idx'}";
2672	}
2673else {
2674	return $_[0];
2675	}
2676}
2677
2678# create_cids(html, &results-map)
2679# Replaces all image references in the body like <img src=detach.cgi?...> with
2680# cid: tags, stores in the results map pointers from the index to the CID.
2681sub create_cids
2682{
2683local ($html, $cidmap) = @_;
2684$html =~ s/(src="|href="|background=")detach.cgi\?([^"]+)(")/$1.&create_cid($2,$cidmap).$3/gei;
2685$html =~ s/(src='|href='|background=')detach.cgi\?([^']+)(')/$1.&create_cid($2,$cidmap).$3/gei;
2686$html =~ s/(src=|href=|background=)detach.cgi\?([^\s>]+)()/$1.&create_cid($2,$cidmap).$3/gei;
2687return $html;
2688}
2689
2690sub create_cid
2691{
2692local ($args, $cidmap) = @_;
2693if ($args =~ /attach=(\d+)/) {
2694	$create_cid_count++;
2695	$cidmap->{$1} = time().$$.$create_cid_count;
2696	return "cid:".$cidmap->{$1};
2697	}
2698else {
2699	# No attachment ID!
2700	return "";
2701	}
2702}
2703
2704# disable_html_images(html, disable?, &urls)
2705# Turn off some or all images in HTML email. Mode 0=Do nothing, 1=Offsite only,
2706# 2=All images. Returns the URL of images found in &urls
2707sub disable_html_images
2708{
2709local ($html, $dis, $urls) = @_;
2710local $newhtml;
2711while($html =~ /^([\000-\377]*?)(<\s*img[^>]*src=('[^']*'|"[^"]*"|\S+)[^>]*>)([\000-\377]*)/i) {
2712	local ($before, $allimg, $img, $after) = ($1, $2, $3, $4);
2713	$img =~ s/^'(.*)'$/$1/ || $img =~ s/^"(.*)"$/$1/;
2714	push(@$urls, $img) if ($urls);
2715	if ($dis == 0) {
2716		# Don't harm image
2717		$newhtml .= $before.$allimg;
2718		}
2719	elsif ($dis == 1) {
2720		# Don't touch unless offsite
2721		if ($img =~ /^(http|https|ftp):/) {
2722			$newhtml .= $before;
2723			}
2724		else {
2725			$newhtml .= $before.$allimg;
2726			}
2727		}
2728	elsif ($dis == 2) {
2729		# Always remove image
2730		$newhtml .= $before;
2731		}
2732	$html = $after;
2733	}
2734$newhtml .= $html;
2735return $newhtml;
2736}
2737
2738# remove_body_attachments(&mail, &attach)
2739# Returns attachments except for those that make up the message body, and those
2740# that have sub-attachments.
2741sub remove_body_attachments
2742{
2743local ($mail, $attach) = @_;
2744local ($textbody, $htmlbody) = &find_body($mail);
2745return grep { $_ ne $htmlbody && $_ ne $textbody && !$_->{'attach'} &&
2746	      $_->{'type'} ne 'message/delivery-status' } @$attach;
2747}
2748
2749# remove_cid_attachments(&mail, &attach)
2750# Returns attachments except for those that are used for inline images in the
2751# HTML body.
2752sub remove_cid_attachments
2753{
2754local ($mail, $attach) = @_;
2755local ($textbody, $htmlbody) = &find_body($mail);
2756local @rv;
2757foreach my $a (@$attach) {
2758	my $cid = $a->{'header'}->{'content-id'};
2759	$cid =~ s/^<(.*)>$/$1/g;
2760	my $cl = $a->{'header'}->{'content-location'};
2761	$cl =~ s/^<(.*)>$/$1/g;
2762	local $inline;
2763	if ($cid && $htmlbody->{'data'} =~ /cid:\Q$cid\E|cid:"\Q$cid\E"|cid:'\Q$cid\E'/) {
2764		# CID-based attachment
2765		$inline = 1;
2766		}
2767	elsif ($cl && $htmlbody->{'data'} =~ /\Q$cl\E/) {
2768		# Content-location based attachment
2769		$inline = 1;
2770		}
2771	if (!$inline) {
2772		push(@rv, $a);
2773		}
2774	}
2775return @rv;
2776}
2777
2778# quoted_message(&mail, quote-mode, sig, 0=any,1=text,2=html, sig-at-top?)
2779# Returns the quoted text, html-flag and body attachment
2780sub quoted_message
2781{
2782local ($mail, $qu, $sig, $bodymode, $sigtop) = @_;
2783local $mode = $bodymode == 1 ? 1 :
2784	      $bodymode == 2 ? 2 :
2785	      %userconfig ? $userconfig{'view_html'} :
2786			    $config{'view_html'};
2787local ($plainbody, $htmlbody) = &find_body($mail, $mode);
2788local ($quote, $html_edit, $body);
2789local $cfg = %userconfig ? \%userconfig : \%config;
2790local @writers = &split_addresses($mail->{'header'}->{'from'});
2791local $writer;
2792if ($writers[0]->[1]) {
2793	$writer = &decode_mimewords($writers[0]->[1])." <".
2794		  &decode_mimewords($writers[0]->[0])."> wrote ..";
2795	}
2796else {
2797	$writer = &decode_mimewords($writers[0]->[0])." wrote ..";
2798	}
2799local $tm;
2800if ($cfg->{'reply_date'} &&
2801    ($tm = &parse_mail_date($_[0]->{'header'}->{'date'}))) {
2802	local $tmstr = &make_date($tm);
2803	$writer = "On $tmstr $writer";
2804	}
2805local $qm = %userconfig ? $userconfig{'html_quote'} : $config{'html_quote'};
2806if (($cfg->{'html_edit'} == 2 ||
2807     $cfg->{'html_edit'} == 1 && $htmlbody) &&
2808     $bodymode != 1) {
2809	# Create quoted body HTML
2810	if ($htmlbody) {
2811		$body = $htmlbody;
2812		$sig =~ s/\n/<br>\n/g;
2813		if ($qu && $qm == 0) {
2814			# Quoted HTML as cite
2815			$quote = &html_escape($writer)."\n".
2816				 "<blockquote type=cite>\n".
2817				 &safe_html($htmlbody->{'data'}).
2818				 "</blockquote>";
2819			if ($sigtop) {
2820				$quote = $sig."<br>\n".$quote;
2821				}
2822			else {
2823				$quote = $quote.$sig."<br>\n";
2824				}
2825			}
2826		elsif ($qu && $qm == 1) {
2827			# Quoted HTML below line
2828			$quote = "<br>$sig<hr>".
2829			         &html_escape($writer)."<br>\n".
2830				 &safe_html($htmlbody->{'data'});
2831			}
2832		else {
2833			# Un-quoted HTML
2834			$quote = &safe_html($htmlbody->{'data'});
2835			if ($sigtop) {
2836				$quote = $sig."<br>\n".$quote;
2837				}
2838			else {
2839				$quote = $quote.$sig."<br>\n";
2840				}
2841			}
2842		}
2843	elsif ($plainbody) {
2844		$body = $plainbody;
2845		local $pd = $plainbody->{'data'};
2846		$pd =~ s/^\s+//g;
2847		$pd =~ s/\s+$//g;
2848		if ($qu && $qm == 0) {
2849			# Quoted plain text as HTML as cite
2850			$quote = &html_escape($writer)."\n".
2851				 "<blockquote type=cite>\n".
2852				 "<pre>$pd</pre>".
2853				 "</blockquote>";
2854			if ($sigtop) {
2855				$quote = $sig."<br>\n".$quote;
2856				}
2857			else {
2858				$quote = $quote.$sig."<br>\n";
2859				}
2860			}
2861		elsif ($qu && $qm == 1) {
2862			# Quoted plain text as HTML below line
2863			$quote = "<br>$sig<hr>".
2864				 &html_escape($writer)."<br>\n".
2865				 "<pre>$pd</pre><br>\n";
2866			}
2867		else {
2868			# Un-quoted plain text as HTML
2869			$quote = "<pre>$pd</pre>";
2870			if ($sigtop) {
2871				$quote = $sig."<br>\n".$quote;
2872				}
2873			else {
2874				$quote = $quote.$sig."<br>\n";
2875				}
2876			}
2877		}
2878	$html_edit = 1;
2879	}
2880else {
2881	# Create quoted body text
2882	if ($plainbody) {
2883		$body = $plainbody;
2884		$quote = $plainbody->{'data'};
2885		}
2886	elsif ($htmlbody) {
2887		$body = $htmlbody;
2888		$quote = &html_to_text($htmlbody->{'data'});
2889		}
2890	if ($quote && $qu) {
2891		$quote = join("", map { "> $_\n" }
2892			&wrap_lines($quote, 78));
2893		}
2894	$quote = $writer."\n".$quote if ($quote && $qu);
2895	if ($sig && $sigtop) {
2896		$quote = $sig."\n".$quote;
2897		}
2898	elsif ($sig && !$sigtop) {
2899		$quote = $quote.$sig."\n";
2900		}
2901	}
2902return ($quote, $html_edit, $body);
2903}
2904
2905# modification_time(&folder)
2906# Returns the unix time on which this folder was last modified, or 0 if unknown
2907sub modification_time
2908{
2909if ($_[0]->{'type'} == 0) {
2910	# Modification time of file
2911	local @st = stat($_[0]->{'file'});
2912	return $st[9];
2913	}
2914elsif ($_[0]->{'type'} == 1) {
2915	# Greatest modification time of cur/new directory
2916	local @stcur = stat("$_[0]->{'file'}/cur");
2917	local @stnew = stat("$_[0]->{'file'}/new");
2918	return $stcur[9] > $stnew[9] ? $stcur[9] : $stnew[9];
2919	}
2920elsif ($_[0]->{'type'} == 2 || $_[0]->{'type'} == 4) {
2921	# Cannot know for POP3 or IMAP folders
2922	return 0;
2923	}
2924elsif ($_[0]->{'type'} == 3) {
2925	# Modification time of MH folder
2926	local @st = stat($_[0]->{'file'});
2927	return $st[9];
2928	}
2929else {
2930	# Huh?
2931	return 0;
2932	}
2933}
2934
2935# requires_delivery_notification(&mail)
2936sub requires_delivery_notification
2937{
2938return $_[0]->{'header'}->{'disposition-notification-to'} ||
2939       $_[0]->{'header'}->{'read-reciept-to'};
2940}
2941
2942# send_delivery_notification(&mail, [from-addr], manual)
2943# Send an email containing delivery status information
2944sub send_delivery_notification
2945{
2946local ($mail, $from) = @_;
2947$from ||= $mail->{'header'}->{'to'};
2948local $host = &get_display_hostname();
2949local $to = &requires_delivery_notification($mail);
2950local $product = &get_product_name();
2951$product = ucfirst($product);
2952local $version = &get_webmin_version();
2953local ($taddr) = &split_addresses($mail->{'header'}->{'to'});
2954local $disp = $manual ? "manual-action/MDN-sent-manually"
2955		      : "automatic-action/MDN-sent-automatically";
2956local $dsn = <<EOF;
2957Reporting-UA: $host; $product $version
2958Original-Recipient: rfc822;$taddr->[0]
2959Final-Recipient: rfc822;$taddr->[0]
2960Original-Message-ID: $mail->{'header'}->{'message-id'}
2961Disposition: $disp; displayed
2962EOF
2963local $dmail = {
2964	'headers' =>
2965	   [ [ 'From' => $from ],
2966	     [ 'To' => $to ],
2967	     [ 'Subject' => 'Delivery notification' ],
2968	     [ 'Content-type' => 'multipart/report; report-type=disposition-notification' ],
2969	     [ 'Content-Transfer-Encoding' => '7bit' ] ],
2970	'attach' => [
2971	   { 'headers' => [ [ 'Content-type' => 'text/plain' ] ],
2972	     'data' => "This is a delivery status notification for the email sent to:\n$mail->{'header'}->{'to'}\non the date:\n$mail->{'header'}->{'date'}\nwith the subject:\n$mail->{'header'}->{'subject'}\n" },
2973	   { 'headers' => [ [ 'Content-type' =>
2974				'message/disposition-notification' ],
2975			    [ 'Content-Transfer-Encoding' => '7bit' ] ],
2976	     'data' => $dsn }
2977		] };
2978eval { local $main::errors_must_die = 1; &send_mail($dmail); };
2979return $to;
2980}
2981
2982# find_subfolder(&folder, name)
2983# Returns the sub-folder with some name
2984sub find_subfolder
2985{
2986local ($folder, $sfn) = @_;
2987if ($folder->{'type'} == 5) {
2988	# Composite
2989	foreach my $sf (@{$folder->{'subfolders'}}) {
2990		return $sf if (&folder_name($sf) eq $sfn);
2991		}
2992	}
2993elsif ($folder->{'type'} == 6) {
2994	# Virtual
2995	foreach my $m (@{$folder->{'members'}}) {
2996		return $m->[0] if (&folder_name($m->[0]) eq $sfn);
2997		}
2998	}
2999return undef;
3000}
3001
3002# find_named_folder(name, &folders, [&cache])
3003# Finds a folder by ID, filename, server name or displayed name
3004sub find_named_folder
3005{
3006local ($name, $folders, $cache) = @_;
3007local $rv;
3008if ($cache && exists($cache->{$name})) {
3009	# In cache
3010	$rv = $cache->{$name};
3011	}
3012else {
3013	# Need to lookup
3014	($rv) = grep { &folder_name($_) eq $name } @$folders if (!$rv);
3015	($rv) = grep { my $escfile = $_->{'file'};
3016		       $escfile =~ s/\s/_/g;
3017		       $escfile eq $name ||
3018		       $_->{'file'} eq $name ||
3019		       $_->{'server'} eq $name } @$folders if (!$rv);
3020	($rv) = grep { my $escname = $_->{'name'};
3021		       $escname =~ s/\s/_/g;
3022		       $escname eq $name ||
3023		       $_->{'name'} eq $name } @$folders if (!$rv);
3024	$cache->{$name} = $rv if ($cache);
3025	}
3026return $rv;
3027}
3028
3029# folder_name(&folder)
3030# Returns a unique identifier for a folder, based on it's filename or ID
3031sub folder_name
3032{
3033my $rv = $_[0]->{'id'} ||
3034         $_[0]->{'file'} ||
3035         $_[0]->{'server'} ||
3036         $_[0]->{'name'};
3037$rv =~ s/\s/_/g;
3038return $rv;
3039}
3040
3041# set_folder_lastmodified(&folders)
3042# Sets the last-modified time and sortable flag on all given folders
3043sub set_folder_lastmodified
3044{
3045local ($folders) = @_;
3046foreach my $folder (@$folders) {
3047	if ($folder->{'type'} == 0 || $folder->{'type'} == 3) {
3048		# For an mbox or MH folder, the last modified date is just that
3049		# of the file or directory itself
3050		local @st = stat($folder->{'file'});
3051		$folder->{'lastchange'} = $st[9];
3052		$folder->{'sortable'} = 1;
3053		}
3054	elsif ($folder->{'type'} == 1) {
3055		# For a Maildir folder, the date is that of the newest
3056		# sub-directory (cur, tmp or new)
3057		$folder->{'lastchange'} = 0;
3058		foreach my $sf ("cur", "tmp", "new") {
3059			local @st = stat("$folder->{'file'}/$sf");
3060			$folder->{'lastchange'} = $st[9]
3061				if ($st[9] > $folder->{'lastchange'});
3062			}
3063		$folder->{'sortable'} = 1;
3064		}
3065	elsif ($folder->{'type'} == 5) {
3066		# For a composite folder, the date is that of the newest
3067		# sub-folder, OR the folder file itself
3068		local @st = stat($folder->{'folderfile'});
3069		$folder->{'lastchange'} = $st[9];
3070		&set_folder_lastmodified($folder->{'subfolders'});
3071		foreach my $sf (@{$folder->{'subfolders'}}) {
3072			$folder->{'lastchange'} = $sf->{'lastchange'}
3073				if ($sf->{'lastchange'} >
3074				    $folder->{'lastchange'});
3075			}
3076		$folder->{'sortable'} = 1;
3077		}
3078	elsif ($folder->{'type'} == 6) {
3079		# For a virtual folder, the date is that of the newest
3080		# sub-folder, OR the folder file itself
3081		local @st = stat($folder->{'folderfile'});
3082		$folder->{'lastchange'} = $st[9];
3083		my %done;
3084		foreach my $m (@{$folder->{'members'}}) {
3085			if (!$done{$m->[0]}++) {
3086				&set_folder_lastmodified([ $m->[0] ]);
3087				$folder->{'lastchange'} =
3088					$m->[0]->{'lastchange'}
3089					if ($m->[0]->{'lastchange'} >
3090					    $folder->{'lastchange'});
3091				}
3092			}
3093		$folder->{'sortable'} = 1;
3094		}
3095	else {
3096		# For POP3 and IMAP folders, we don't know the last change
3097		$folder->{'lastchange'} = undef;
3098		$folder->{'sortable'} = 1;
3099		}
3100	}
3101}
3102
3103# mail_preview(&mail, [characters])
3104# Returns a short text preview of a message body
3105sub mail_preview
3106{
3107local ($mail, $chars) = @_;
3108$chars ||= 100;
3109local ($textbody, $htmlbody, $body) = &find_body($mail, 0);
3110local $data = $body->{'data'};
3111$data =~ s/\r?\n/ /g;
3112$data = substr($data, 0, $chars);
3113if ($data =~ /\S/) {
3114	return $data;
3115	}
3116return undef;
3117}
3118
3119# open_dbm_db(&hash, file, mode)
3120# Attempts to open a DBM, first using SDBM_File, and then NDBM_File
3121sub open_dbm_db
3122{
3123local ($hash, $file, $mode) = @_;
3124eval "use SDBM_File";
3125dbmopen(%$hash, $file, $mode);
3126eval { $hash->{'1111111111'} = 'foo bar' };
3127if ($@) {
3128	dbmclose(%$hash);
3129	eval "use NDBM_File";
3130	dbmopen(%$hash, $file, $mode);
3131	}
3132}
3133
3134# generate_message_id(from-address)
3135# Returns a unique ID for a new message
3136sub generate_message_id
3137{
3138local ($fromaddr) = @_;
3139local ($finfo) = &split_addresses($fromaddr);
3140local $dom;
3141if ($finfo && $finfo->[0] =~ /\@(\S+)$/) {
3142	$dom = $1;
3143	}
3144else {
3145	$dom = &get_system_hostname();
3146	}
3147return "<".time().".".$$."\@".$dom.">";
3148}
3149
3150# type_to_extension(type)
3151# Returns a good extension for a MIME type
3152sub type_to_extension
3153{
3154local ($type) = @_;
3155$type =~ s/;.*$//;
3156local ($mt) = grep { lc($_->{'type'}) eq lc($type) } &list_mime_types();
3157if ($mt && $m->{'exts'}->[0]) {
3158	return $m->{'exts'}->[0];
3159	}
3160elsif ($type =~ /^text\//) {
3161	return ".txt";
3162	}
3163else {
3164	my @p = split(/\//, $type);
3165	return $p[1];
3166	}
3167}
3168
3169# should_show_unread(&folder)
3170# Returns 1 if we should show unread counts for some folder
3171sub should_show_unread
3172{
3173local ($folder) = @_;
3174local $su = $userconfig{'show_unread'} || $config{'show_unread'};
3175
3176# Work out if all sub-folders are IMAP
3177local $allimap;
3178if ($su == 2) {
3179	# Doesn't matter
3180	}
3181elsif ($su == 1 && $config{'mail_system'} == 4) {
3182	# Totally IMAP mode
3183	$allimap = 1;
3184	}
3185elsif ($su == 1) {
3186	if ($folder->{'type'} == 5) {
3187		$allimap = 1;
3188		foreach my $sf (@{$folder->{'subfolders'}}) {
3189			$allimap = 0 if (!&should_show_unread($sf));
3190			}
3191		}
3192	elsif ($folder->{'type'} == 6) {
3193		$allimap = 1;
3194		foreach my $mem (@{$folder->{'members'}}) {
3195			$allimap = 0 if (!&should_show_unread($mem->[0]));
3196			}
3197		}
3198	}
3199
3200return $su == 2 ||				# All folders
3201       ($folder->{'type'} == 4 ||		# Only IMAP and derived
3202	$folder->{'type'} == 5 && $allimap ||
3203	$folder->{'type'} == 6 && $allimap) && $su == 1;
3204}
3205
3206# mail_has_attachments(&mail|&mails, &folder)
3207# Returns an array of flags, each being 1 if the message has attachments, 0
3208# if not. Uses a cache DBM by message ID and fetches the whole mail if needed.
3209sub mail_has_attachments
3210{
3211local ($mails, $folder) = @_;
3212if (ref($mails) ne 'ARRAY') {
3213	# Just one
3214	$mails = [ $mails ];
3215	}
3216
3217# Open cache DBM
3218if (!%hasattach) {
3219	local $hasattach_file;
3220	if ($module_info{'usermin'}) {
3221		$hasattach_file = "$user_module_config_directory/attach";
3222		}
3223	else {
3224		$hasattach_file = "$module_config_directory/attach";
3225		if (!glob($hasattach_file."*")) {
3226			$hasattach_file = "$module_var_directory/attach";
3227			}
3228		}
3229	&open_dbm_db(\%hasattach, $hasattach_file, 0600);
3230	}
3231
3232# See which mail we already know about
3233local @rv = map { undef } @$mails;
3234local @needbody;
3235for(my $i=0; $i<scalar(@rv); $i++) {
3236	local $mail = $mails->[$i];
3237	local $mid = &get_mail_message_id($mail);
3238	if ($mid && defined($hasattach{$mid})) {
3239		# Already cached .. use it
3240		$rv[$i] = $hasattach{$mid};
3241		}
3242	elsif (!$mail->{'body'} && $mail->{'size'} > 1024*1024) {
3243		# Message is big .. just assume it has attachments
3244		$rv[$i] = 1;
3245		}
3246	elsif (!$mail->{'body'}) {
3247		# Need to get body
3248		push(@needbody, $i);
3249		}
3250	}
3251
3252# We need to actually fetch some message bodies to check for attachments
3253if (@needbody) {
3254	local (@needmail, %oldread);
3255	foreach my $i (@needbody) {
3256		push(@needmail, $mails->[$i]);
3257		}
3258	@needmail = &mailbox_select_mails($folder,
3259		[ map { $_->{'id'} } @needmail ], 0);
3260	foreach my $i (@needbody) {
3261		$mails->[$i] = shift(@needmail);
3262		}
3263	}
3264
3265# Now we have bodies, check for attachments
3266for(my $i=0; $i<scalar(@rv); $i++) {
3267	next if (defined($rv[$i]));
3268	local $mail = $mails->[$i];
3269	if (!$mail) {
3270		# Couldn't read from server
3271		$rv[$i] = 0;
3272		next;
3273		}
3274	if (!@{$mail->{'attach'}}) {
3275		# Parse out attachments
3276		&parse_mail($mail, undef, 0);
3277		}
3278
3279	# Check for non-text attachments
3280	$rv[$i] = 0;
3281	foreach my $a (@{$mail->{'attach'}}) {
3282		if ($a->{'type'} =~ /^text\/(plain|html)/i ||
3283		    $a->{'type'} eq 'text') {
3284			# Text part .. may be an attachment
3285			if ($a->{'header'}->{'content-disposition'} =~
3286			    /^attachment/i) {
3287				$rv[$i] = 1;
3288				}
3289			}
3290		elsif ($a->{'type'} !~ /^multipart\/(mixed|alternative)/) {
3291			# Non-text .. assume this means we have an attachment
3292			$rv[$i] = 1;
3293			}
3294		}
3295	}
3296
3297# Update the cache
3298for(my $i=0; $i<scalar(@rv); $i++) {
3299	local $mail = $mails->[$i];
3300	local $mid = &get_mail_message_id($mail);
3301	if ($mid && !defined($hasattach{$mid})) {
3302		$hasattach{$mid} = $rv[$i]
3303		}
3304	}
3305
3306return wantarray ? @rv : $rv[0];
3307}
3308
3309# get_mail_message_id(&mail)
3310# Returns a message ID suitable for use in a DBM
3311sub get_mail_message_id
3312{
3313my ($mail) = @_;
3314my $mid = $mail->{'header'}->{'message-id'} || $mail->{'id'};
3315if (length($mid) > 1024) {
3316	$mid = substr($mid, 0, 1024);
3317	}
3318return $mid;
3319}
3320
3321# show_delivery_status(&dstatus)
3322# Show the delivery status HTML for some email
3323sub show_delivery_status
3324{
3325local ($dstatus) = @_;
3326local $ds = &parse_delivery_status($dstatus->{'data'});
3327$dtxt = $ds->{'status'} =~ /^2\./ ? $text{'view_dstatusok'}
3328				  : $text{'view_dstatus'};
3329print &ui_table_start($dtxt, "width=100%", 2, [ "width=10% nowrap" ]);
3330foreach $dsh ('final-recipient', 'diagnostic-code',
3331	      'remote-mta', 'reporting-mta') {
3332	if ($ds->{$dsh}) {
3333		$ds->{$dsh} =~ s/^\S+;//;
3334		print &ui_table_row($text{'view_'.$dsh},
3335				    &html_escape($ds->{$dsh}));
3336		}
3337	}
3338print &ui_table_end();
3339}
3340
3341# attachments_table(&attach, folder, view-url, detach-url,
3342#                   [viewmail-url, viewmail-field], [show-checkboxes])
3343# Prints an HTML table of attachments. Returns a list of those that can be
3344# server-side detached.
3345sub attachments_table
3346{
3347local ($attach, $folder, $viewurl, $detachurl, $mailurl, $idfield, $cbs) = @_;
3348local %typemap = map { $_->{'type'}, $_->{'desc'} } &list_mime_types();
3349local $qid = &urlize($id);
3350local $rv;
3351local (@files, @actions, @detach, @sizes, @titles, @links);
3352foreach my $a (@$attach) {
3353	local $fn;
3354	local $size = &nice_size(length($a->{'data'}));
3355	local $cb;
3356	if (!$a->{'type'}) {
3357		# An actual email
3358		push(@files, &text('view_sub2', $a->{'header'}->{'from'}));
3359		$fn = "mail.txt";
3360		$size = &nice_size($a->{'size'});
3361		}
3362	elsif ($a->{'type'} eq 'message/rfc822') {
3363		# Attached email
3364		local $amail = &extract_mail($a->{'data'});
3365		if ($amail && $amail->{'header'}->{'from'}) {
3366			push(@files, &text('view_sub2',
3367					$amail->{'header'}->{'from'}));
3368			}
3369		else {
3370			push(@files, &text('view_sub'));
3371			}
3372		$fn = "mail.txt";
3373		}
3374	elsif ($a->{'filename'}) {
3375		# Known filename
3376		$fn = &decode_mimewords($a->{'filename'});
3377		local $shortfn = $fn;
3378		if (length($shortfn) > 80) {
3379			$shortfn = substr($shortfn, 0, 80)."...";
3380			}
3381		push(@files, $shortfn);
3382		push(@detach, [ $a->{'idx'}, $fn ]);
3383		}
3384	else {
3385		# No filename
3386		push(@files, $text{'view_anofile'});
3387		$fn = "file.".&type_to_extension($a->{'type'});
3388		push(@detach, [ $a->{'idx'}, $fn ]);
3389		}
3390	push(@sizes, $size);
3391	push(@titles, $files[$#files]."<br>".$size);
3392	if ($a->{'error'}) {
3393		$titles[$#titles] .= "<br><font size=-1>($a->{'error'})</font>";
3394		}
3395	$fn =~ s/ /_/g;
3396	$fn =~ s/\#/_/g;
3397	$fn = &urlize($fn);
3398	local @a;
3399	local $detachfile = $detachurl;
3400	$detachfile =~ s/\?/\/$fn\?/;
3401	if (!$a->{'type'}) {
3402		# Complete email for viewing
3403		local $qmid = &urlize($a->{$idfield});
3404		push(@links, "$mailurl&$idfield=$qmid&folder=$folder->{'index'}");
3405		}
3406	elsif ($a->{'type'} eq 'message/rfc822') {
3407		# Attached sub-email
3408		push(@links, $viewurl."&sub=$a->{'idx'}");
3409		}
3410	else {
3411		# Regular attachment
3412		push(@links, $detachfile."&attach=$a->{'idx'}");
3413		}
3414	push(@a, "<a href='$links[$#links]'>$text{'view_aview'}</a>");
3415	push(@a, "<a href='$links[$#links]' target=_blank>$text{'view_aopen'}</a>");
3416	if ($a->{'type'}) {
3417		push(@a, "<a href='$detachfile&attach=$a->{'idx'}&save=1'>$text{'view_asave'}</a>");
3418		}
3419	if ($a->{'type'} eq 'message/rfc822') {
3420		push(@a, "<a href='$detachfile&attach=$a->{'idx'}&type=text/plain$subs'>$text{'view_aplain'}</a>");
3421		}
3422	push(@actions, \@a);
3423	}
3424local @tds = ( "width=50%", "width=25%", "width=10%", "width=15% nowrap" );
3425if ($cbs) {
3426	unshift(@tds, "width=5");
3427	}
3428print &ui_columns_start([
3429	$cbs ? ( "" ) : ( ),
3430	$text{'view_afile'},
3431	$text{'view_atype'},
3432	$text{'view_asize'},
3433	$text{'view_aactions'},
3434	], 100, 0, \@tds);
3435for(my $i=0; $i<@files; $i++) {
3436	local $type = $attach[$i]->{'type'} || "message/rfc822";
3437	local $typedesc = $typemap{lc($type)} || $type;
3438	local @cols = (
3439		"<a href='$links[$i]'>".&html_escape($files[$i])."</a>",
3440		$typedesc,
3441		$sizes[$i],
3442		&ui_links_row($actions[$i]),
3443		);
3444	if ($cbs) {
3445		print &ui_checked_columns_row(\@cols, \@tds,
3446					      $cbs, $attach->[$i]->{'idx'}, 1);
3447		}
3448	else {
3449		print &ui_columns_row(\@cols, \@tds);
3450		}
3451	}
3452print &ui_columns_end();
3453return @detach;
3454}
3455
3456# message_icons(&mail, showto, &folder)
3457# Returns a list of icon images for some mail
3458sub message_icons
3459{
3460local ($mail, $showto, $folder) = @_;
3461local @rv;
3462if (&mail_has_attachments($mail, $folder)) {
3463	push(@rv, "<img src=images/attach.gif alt='A'>");
3464	}
3465local $p = int($mail->{'header'}->{'x-priority'});
3466if ($p == 1) {
3467	push(@rv, "<img src=images/p1.gif alt='P1'>");
3468	}
3469elsif ($p == 2) {
3470	push(@rv, "<img src=images/p2.gif alt='P2'>");
3471	}
3472
3473# Show icons if special or replied to
3474local $read = &get_mail_read($folder, $mail);
3475if ($read&2) {
3476	push(@rv, "<img src=images/special.gif alt='*'>");
3477	}
3478if ($read&4) {
3479	push(@rv, "<img src=images/replied.gif alt='R'>");
3480	}
3481
3482if ($showto && defined(&open_dsn_hash)) {
3483	# Show icons if DSNs received
3484	&open_dsn_hash();
3485	local $mid = &get_mail_message_id($mail);
3486	if ($dsnreplies{$mid}) {
3487		push(@rv, "<img src=images/dsn.gif alt='R'>");
3488		}
3489	if ($delreplies{$mid}) {
3490		local ($bounce) = grep { /^\!/ }
3491			split(/\s+/, $delreplies{$mid});
3492		local $img = $bounce ? "red.gif" : "box.gif";
3493		push(@rv, "<img src=images/$img alt='D'>");
3494		}
3495	}
3496return @rv;
3497}
3498
3499# show_mail_printable(&mail, body, textbody, htmlbody)
3500# Output HTML for printing a message
3501sub show_mail_printable
3502{
3503local ($mail, $body, $textbody, $htmlbody) = @_;
3504
3505# Display the headers
3506print &ui_table_start($text{'view_headers'}, "width=100%", 2);
3507print &ui_table_row($text{'mail_from'},
3508	&convert_header_for_display($mail->{'header'}->{'from'}));
3509print &ui_table_row($text{'mail_to'},
3510	&convert_header_for_display($mail->{'header'}->{'to'}));
3511if ($mail->{'header'}->{'cc'}) {
3512	print &ui_table_row($text{'mail_cc'},
3513		&convert_header_for_display($mail->{'header'}->{'cc'}));
3514	}
3515print &ui_table_row($text{'mail_date'},
3516	&convert_header_for_display($mail->{'header'}->{'date'}));
3517print &ui_table_row($text{'mail_subject'},
3518	&convert_header_for_display(
3519		$mail->{'header'}->{'subject'}));
3520print &ui_table_end(),"<br>\n";
3521
3522# Just display the mail body for printing
3523print &ui_table_start(undef, "width=100%", 2);
3524if ($body eq $textbody) {
3525	my $plain;
3526	foreach my $l (&wrap_lines($body->{'data'},
3527				   $config{'wrap_width'} ||
3528				    $userconfig{'wrap_width'})) {
3529		$plain .= &eucconv_and_escape($l)."\n";
3530		}
3531	print &ui_table_row(undef, "<pre>$plain</pre>", 2);
3532	}
3533elsif ($body eq $htmlbody) {
3534	print &ui_table_row(undef,
3535		&safe_html($body->{'data'}), 2);
3536	}
3537print &ui_table_end();
3538}
3539
3540# show_attachments_fields(count, server-side)
3541# Outputs HTML for new attachment fields
3542sub show_attachments_fields
3543{
3544local ($count, $server_attach) = @_;
3545
3546# Work out if any attachments are supported
3547my $any_attach = $server_attach || !$main::no_browser_uploads;
3548
3549if ($any_attach && &supports_javascript()) {
3550	# Javascript to increase attachments fields
3551	print <<EOF;
3552<script>
3553function add_attachment()
3554{
3555var block = document.getElementById("attachblock");
3556if (block) {
3557	var count = 0;
3558	var first_input = document.forms[0]["attach0"];
3559	while(document.forms[0]["attach"+count]) { count++; }
3560	var new_input = document.createElement('input');
3561	new_input.setAttribute('name', "attach"+count);
3562	new_input.setAttribute('type', 'file');
3563	if (first_input) {
3564		new_input.setAttribute('size',
3565			first_input.getAttribute('size'));
3566		new_input.setAttribute('class',
3567			first_input.getAttribute('class'));
3568		}
3569	block.appendChild(new_input);
3570	var new_br = document.createElement('br');
3571	block.appendChild(new_br);
3572	}
3573return false;
3574}
3575function add_ss_attachment()
3576{
3577var block = document.getElementById("ssattachblock");
3578if (block) {
3579	var count = 0;
3580	var first_input = document.forms[0]["file0"];
3581	while(document.forms[0]["file"+count]) { count++; }
3582	var new_input = document.createElement('input');
3583	new_input.setAttribute('name', "file"+count);
3584	if (first_input) {
3585		new_input.setAttribute('size',
3586			first_input.getAttribute('size'));
3587		new_input.setAttribute('class',
3588			first_input.getAttribute('class'));
3589		}
3590	block.appendChild(new_input);
3591	var new_br = document.createElement('br');
3592	block.appendChild(new_br);
3593	}
3594return false;
3595}
3596</script>
3597EOF
3598	}
3599
3600if ($any_attach) {
3601	# Show form for attachments (both uploaded and server-side)
3602	print &ui_table_start($server_attach ? $text{'reply_attach2'}
3603					     : $text{'reply_attach3'},
3604			      "width=100%", 2);
3605	}
3606
3607# Uploaded attachments
3608if (!$main::no_browser_uploads) {
3609	my $atable = "<div>\n";
3610	for(my $i=0; $i<$count; $i++) {
3611		$atable .= &ui_upload("attach$i", 80, 0,
3612				      "style='width:100%'", 1)."<br>";
3613		}
3614	$atable .= "</div> <div id=attachblock></div>\n";
3615	print &ui_hidden("attachcount", int($i)),"\n";
3616	print &ui_table_row(undef, $atable, 2);
3617	}
3618if ($server_attach) {
3619	my $atable = "<div>\n";
3620	for(my $i=0; $i<$count; $i++) {
3621		$atable .= &ui_textbox("file$i", undef, 60, 0, undef,
3622				       "style='width:95%'").
3623			   &file_chooser_button("file$i"),"<br>\n";
3624		}
3625	$atable .= "</div> <div id=sattachblock></div>\n";
3626	print &ui_table_row(undef, $atable, 2);
3627	print &ui_hidden("ssattachcount", int($i)),"\n";
3628	}
3629
3630# Links to add more fields
3631my @addlinks;
3632if (!$main::no_browser_uploads && &supports_javascript()) {
3633	push(@addlinks, "<a href='' onClick='return add_attachment()'>".
3634		        "$text{'reply_addattach'}</a>" );
3635	}
3636if ($server_attach && &supports_javascript()) {
3637	push(@addlinks, "<a href='' onClick='return add_ss_attachment()'>".
3638			"$text{'reply_addssattach'}</a>" );
3639	}
3640if ($any_attach) {
3641	print &ui_table_row(undef, &ui_links_row(\@addlinks), 2);
3642	print &ui_table_end();
3643	}
3644}
3645
3646# inputs_to_hiddens([&in])
3647# Converts a hash as created by ReadParse into a list of names and values
3648sub inputs_to_hiddens
3649{
3650my $in = $_[0] || \%in;
3651my @hids;
3652foreach $i (keys %$in) {
3653	push(@hids, map { [ $i, $_ ] } split(/\0/, $in->{$i}));
3654	}
3655return @hids;
3656}
3657
3658# ui_address_field(name, value, from-mode?, multi-line?)
3659# Returns HTML for a field for selecting an email address
3660sub ui_address_field
3661{
3662return &theme_ui_address_field(@_) if (defined(&theme_ui_address_field));
3663local ($name, $value, $from, $multi) = @_;
3664local @faddrs;
3665if (defined(&list_addresses)) {
3666	@faddrs = grep { $_->[3] } &list_addresses();
3667	}
3668local $f = $multi ? &ui_textarea($name, $value, 3, 40, undef, 0,
3669				 "style='width:95%'")
3670		  : &ui_textbox($name, $value, 40, 0, undef,
3671				"style='width:95%'");
3672if ((!$from || @faddrs) && defined(&address_button)) {
3673	$f .= " ".&address_button($name, 0, $from);
3674	}
3675return $f;
3676}
3677
3678# Returns 1 if spell checking is supported on this system
3679sub can_spell_check_text
3680{
3681return &has_command("ispell");
3682}
3683
3684# spell_check_text(text)
3685# Checks for spelling errors in some text, and returns a list of those found
3686# as HTML strings
3687sub spell_check_text
3688{
3689local ($plainbody) = @_;
3690local @errs;
3691pipe(INr, INw);
3692pipe(OUTr, OUTw);
3693select(INw); $| = 1; select(OUTr); $| = 1; select(STDOUT);
3694if (!fork()) {
3695	close(INw);
3696	close(OUTr);
3697	untie(*STDIN);
3698	untie(*STDOUT);
3699	untie(*STDERR);
3700	open(STDOUT, ">&OUTw");
3701	open(STDERR, ">/dev/null");
3702	open(STDIN, "<&INr");
3703	exec("ispell -a");
3704	exit;
3705	}
3706close(INr);
3707close(OUTw);
3708local $indent = "&nbsp;" x 4;
3709local $SIG{'PIPE'} = 'IGNORE';
3710local @errs;
3711foreach $line (split(/\n+/, $plainbody)) {
3712	next if ($line !~ /\S/);
3713	print INw $line,"\n";
3714	local @lerrs;
3715	while(1) {
3716		($spell = <OUTr>) =~ s/\r|\n//g;
3717		last if (!$spell);
3718		if ($spell =~ /^#\s+(\S+)/) {
3719			# Totally unknown word
3720			push(@lerrs, $indent.&text('send_eword',
3721					"<i>".&html_escape($1)."</i>"));
3722			}
3723		elsif ($spell =~ /^&\s+(\S+)\s+(\d+)\s+(\d+):\s+(.*)/) {
3724			# Maybe possible word, with options
3725			push(@lerrs, $indent.&text('send_eword2',
3726					"<i>".&html_escape($1)."</i>",
3727					"<i>".&html_escape($4)."</i>"));
3728			}
3729		elsif ($spell =~ /^\?\s+(\S+)/) {
3730			# Maybe possible word
3731			push(@lerrs, $indent.&text('send_eword',
3732					"<i>".&html_escape($1)."</i>"));
3733			}
3734		}
3735	if (@lerrs) {
3736		push(@errs, &text('send_eline',
3737				"<tt>".&html_escape($line)."</tt>")."<br>".
3738				join("<br>", @lerrs));
3739		}
3740	}
3741close(INw);
3742close(OUTr);
3743return @errs;
3744}
3745
3746# get_mail_charset(&mail, &body)
3747# Returns the character set to use for the HTML page for some email
3748sub get_mail_charset
3749{
3750my ($mail, $body) = @_;
3751my $ctype;
3752if ($body) {
3753	$ctype = $body->{'header'}->{'content-type'};
3754	}
3755$ctype ||= $mail->{'header'}->{'content-type'};
3756if ($ctype =~ /charset="([a-z0-9\-]+)"/i ||
3757    $ctype =~ /charset='([a-z0-9\-]+)'/i ||
3758    $ctype =~ /charset=([a-z0-9\-]+)/i) {
3759	$charset = $1;
3760	}
3761## Special handling of HTML header charset ($force_charset):
3762## For japanese text(ISO-2022-JP/EUC=JP/SJIS), the HTML output and
3763## text contents ($bodycontents) are already converted to EUC,
3764## so overriding HTML charset to that in the mail header ($charset)
3765## is generally wrong. (cf. mailbox/boxes-lib.pl:eucconv())
3766if ( &get_charset() =~ /^EUC/i ) {	# EUC-JP,EUC-KR
3767	return undef;
3768	}
3769else {
3770	return $charset;
3771	}
3772}
3773
3774# switch_to_folder_user(&folder)
3775# If a folder has a user, switch the UID and GID used for writes to it
3776sub switch_to_folder_user
3777{
3778my ($folder) = @_;
3779if ($folder->{'user'} && $switch_to_folder_count == 0) {
3780	&set_mail_open_user($folder->{'user'});
3781	}
3782$switch_to_folder_count++;
3783}
3784
3785# switch_from_folder_user(&folder)
3786# Undoes the change made by switch_to_folder_user
3787sub switch_from_folder_user
3788{
3789my ($folder) = @_;
3790if ($switch_to_folder_count) {
3791	$switch_to_folder_count--;
3792	if ($switch_to_folder_count == 0) {
3793		&clear_mail_open_user();
3794		}
3795	}
3796else {
3797	print STDERR "switch_from_folder_user called more often ",
3798		     "than switch_to_folder_user!\n";
3799	}
3800}
3801
3802# remove_spam_subject(&mail)
3803# Removes the [spam] prefix from the subject, if there is one
3804sub remove_spam_subject
3805{
3806my ($mail) = @_;
3807my $rv = 0;
3808foreach my $h (@{$mail->{'headers'}}) {
3809	if (lc($h->[0]) eq 'subject' && $h->[1] =~ /^\[spam\]\s*(.*)$/i) {
3810		$h->[1] = $1;
3811		$rv = 1;
3812		}
3813	}
3814return $rv;
3815}
3816
38171;
3818