1# mailbox-lib.pl
2use strict;
3use warnings;
4our (%text, %config, %gconfig, %userconfig);
5our $remote_user;
6our @remote_user_info;
7our $user_module_config_directory;
8our $module_root_directory;
9our $module_name;
10
11BEGIN { push(@INC, ".."); };
12use WebminCore;
13use Socket;
14&init_config();
15&switch_to_remote_user();
16&create_user_config_dirs();
17do "$module_root_directory/boxes-lib.pl";
18do "$module_root_directory/folders-lib.pl";
19
20#open(DEBUG, ">>/tmp/mailbox.debug");
21
22our $qmail_maildir;
23if ($config{'mail_qmail'}) {
24	$qmail_maildir = &mail_file_style($remote_user, $config{'mail_qmail'},
25					  $config{'mail_style'});
26	}
27else {
28	$qmail_maildir = "$remote_user_info[7]/$config{'mail_dir_qmail'}";
29}
30our $address_book = "$user_module_config_directory/address_book";
31our $address_group_book = "$user_module_config_directory/address_group_book";
32our $folders_dir = "$remote_user_info[7]/$userconfig{'mailbox_dir'}";
33our %folder_types = map { $_, 1 } (split(/,/, $config{'folder_types'}),
34			       split(/,/, $config{'folder_virts'}));
35our $search_folder_id = 1;
36our $special_folder_id = 2;
37our $auto_cmd = "$user_module_config_directory/auto.pl";
38our $last_folder_file = "$user_module_config_directory/lastfolder";
39
40# mailbox_file()
41sub mailbox_file
42{
43if ($config{'mail_system'} == 0) {
44	return &user_mail_file(@remote_user_info);
45	}
46else {
47	return "$qmail_maildir/";
48	}
49}
50
51# supports_gpg()
52# Returns 1 if GPG is installed and the module is available
53my $supports_gpg_cache;
54sub supports_gpg
55{
56if (!defined($supports_gpg_cache)) {
57	$supports_gpg_cache = &has_command("gpg") &&
58			      &foreign_check("gnupg") &&
59			      &foreign_available("gnupg") ? 1 : 0;
60	}
61return $supports_gpg_cache;
62}
63
64# decrypt_attachments(&mail)
65# If the attachments on a mail are encrypted, converts them into unencrypted
66# form. Returns a code and message, valid codes being: 0 = not encrypted,
67# 1 = encrypted but cannot decrypt, 2 = failed to decrypt, 3 = decrypted OK
68sub decrypt_attachments
69{
70# Check requirements for decryption
71my $first = $_[0]->{'attach'}->[0];
72my ($body) = grep { $_->{'type'} eq 'text/plain' || $_->{'type'} eq 'text' }
73		     @{$_[0]->{'attach'}};
74my $hasgpg = &has_command("gpg") && &foreign_check("gnupg") &&
75		&foreign_available("gnupg");
76if ($_[0]->{'header'}->{'content-type'} =~ /^multipart\/encrypted/ &&
77    $first->{'type'} =~ /^application\/pgp-encrypted/ &&
78    $first->{'data'} =~ /Version:\s+1/i) {
79	# RFC 2015 PGP encryption of entire message
80	return (1) if (!&supports_gpg());
81	&foreign_require("gnupg", "gnupg-lib.pl");
82	my $plain;
83	my $enc = $_[0]->{'attach'}->[1];
84	my $rv = &foreign_call("gnupg", "decrypt_data", $enc->{'data'}, \$plain);
85	return (2, $rv) if ($rv);
86	$plain =~ s/\r//g;
87	my $amail = &extract_mail($plain);
88	&parse_mail($amail);
89	$_[0]->{'attach'} = $amail->{'attach'};
90	return (3);
91	}
92
93# Check individual attachments for text-only encryption
94my $a;
95my $cc = 0;
96my $ok = 3;
97foreach my $a (@{$_[0]->{'attach'}}) {
98	if ($a->{'type'} =~ /^(text|application\/pgp-encrypted)/i &&
99	    $a->{'data'} =~ /BEGIN PGP MESSAGE/ &&
100	    $a->{'data'} =~ /([\000-\377]*)(-----BEGIN PGP MESSAGE-+\r?\n([\000-\377]+)-+END PGP MESSAGE-+\r?\n)([\000-\377]*)/i) {
101		my ($before, $enc, $after) = ($1, $2, $4);
102		return (1) if (!&supports_gpg());
103		&foreign_require("gnupg", "gnupg-lib.pl");
104		$cc++;
105		my $pass = &gnupg::get_passphrase();
106		my $plain;
107		my $rv = &gnupg::decrypt_data($enc, \$plain, $pass);
108		return (2, $rv) if ($rv);
109		$ok = 4 if ($before =~ /\S/ || $after =~ /\S/);
110		if ($a->{'type'} !~ /^text/) {
111			$a->{'type'} = "text/plain";
112			}
113		$a->{'data'} = $before.$plain.$after;
114		}
115	}
116return $cc ? ( $ok ) : ( 0 );
117}
118
119# check_signature_attachments(&attach, &textbody-attach)
120# Checks for a signature attachment, and verifies it. Returns the signature
121# status code and message.
122sub check_signature_attachments
123{
124my ($attach, $textbody) = @_;
125my ($sigcode, $sigmessage, $sindex);
126if (&has_command("gpg") && &foreign_check("gnupg") && &foreign_available("gnupg")) {
127	# Check for GnuPG signatures
128	my $sig;
129	my $sindex;
130	foreach my $a (@$attach) {
131		$sig = $a if ($a->{'type'} =~ /^application\/pgp-signature/);
132		}
133	if ($sig) {
134		# Verify the signature against the rest of the attachment
135		&foreign_require("gnupg", "gnupg-lib.pl");
136		my $rest = $sig->{'parent'}->{'attach'}->[0];
137		$rest->{'raw'} =~ s/\r//g;
138		$rest->{'raw'} =~ s/\n/\r\n/g;
139		($sigcode, $sigmessage) =
140			&gnupg::verify_data($rest->{'raw'}, $sig->{'data'});
141		@$attach = grep { $_ ne $sig } @$attach;
142		$sindex = $sig->{'idx'};
143		}
144	elsif ($textbody && $textbody->{'data'} =~ /(-+BEGIN PGP SIGNED MESSAGE-+\r?\n(Hash:\s+(\S+)\r?\n\r?\n)?([\000-\377]+\r?\n)-+BEGIN PGP SIGNATURE-+\r?\n([\000-\377]+)-+END PGP SIGNATURE-+\r?\n)/i) {
145		# Signature is in body text!
146		my $sig = $1;
147		my $text = $4;
148		&foreign_require("gnupg", "gnupg-lib.pl");
149		($sigcode, $sigmessage) = &gnupg::verify_data($sig);
150		if ($sigcode == 0 || $sigcode == 1) {
151			$textbody->{'data'} = $text;
152			}
153		}
154	}
155return ($sigcode, $sigmessage, $sindex);
156}
157
158# list_addresses()
159# Returns a list of address book entries, each an array reference containing
160# the email address, real name, index (if editable) and From: flag
161sub list_addresses
162{
163my @rv;
164my $i = 0;
165open(my $ADDRESS, "<", $address_book);
166while(<$ADDRESS>) {
167	s/\r|\n//g;
168	my @sp = split(/\t/, $_);
169	if (@sp >= 1) {
170		push(@rv, [ $sp[0], $sp[1], $i, $sp[2] ]);
171		}
172	$i++;
173	}
174close($ADDRESS);
175if ($config{'global_address'}) {
176	my $gab = &group_subs($config{'global_address'});
177	open(my $ADDRESS, "<", $gab);
178	while(<$ADDRESS>) {
179		s/\r|\n//g;
180		my @sp = split(/\t+/, $_);
181		if (@sp >= 2) {
182			push(@rv, [ $sp[0], $sp[1] ]);
183			}
184		}
185	close($ADDRESS);
186	}
187if ($userconfig{'sort_addrs'} == 2) {
188	return sort { lc($a->[0]) cmp lc($b->[0]) } @rv;
189	}
190elsif ($userconfig{'sort_addrs'} == 1) {
191	return sort { lc($a->[1]) cmp lc($b->[1]) } @rv;
192	}
193else {
194	return @rv;
195	}
196}
197
198# create_address(email, real name, forfrom)
199# Adds an entry to the address book
200sub create_address
201{
202no strict "subs";
203&open_tempfile(ADDRESS, ">>$address_book");
204&print_tempfile(ADDRESS, "$_[0]\t$_[1]\t$_[2]\n");
205&close_tempfile(ADDRESS);
206use strict "subs";
207}
208
209# modify_address(index, email, real name, forfrom)
210# Updates some entry in the address book
211sub modify_address
212{
213&replace_file_line($address_book, $_[0], "$_[1]\t$_[2]\t$_[3]\n");
214}
215
216# delete_address(index)
217# Deletes some entry from the address book
218sub delete_address
219{
220&replace_file_line($address_book, $_[0]);
221}
222
223# address_button(field, [form], [frommode], [realfield], [nogroups])
224# Returns HTML for an address-book popup button
225sub address_button
226{
227if (defined(&theme_address_button)) {
228	return &theme_address_button(@_);
229	}
230my $form = @_ > 1 ? $_[1] : 0;
231my $mode = @_ > 2 ? $_[2] : 0;
232my $nogroups = @_ > 4 ? $_[4] : 0;
233my ($rfield1, $rfield2);
234if ($_[3]) {
235	return "<input type=button onClick='ifield = document.forms[$form].$_[0]; rfield = document.forms[$form].$_[3]; chooser = window.open(\"../$module_name/address_chooser.cgi?addr=\"+escape(ifield.value)+\"&mode=$mode&nogroups=$nogroups\", \"chooser\", \"toolbar=no,menubar=no,scrollbars=yes,width=500,height=500\"); chooser.ifield = ifield; window.ifield = ifield; chooser.rfield = rfield; window.rfield = rfield' value=\"...\">\n";
236	}
237else {
238	return "<input type=button onClick='ifield = document.forms[$form].$_[0]; chooser = window.open(\"../$module_name/address_chooser.cgi?addr=\"+escape(ifield.value)+\"&mode=$mode\", \"chooser\", \"toolbar=no,menubar=no,scrollbars=yes,width=500,height=500\"); chooser.ifield = ifield; window.ifield = ifield' value=\"...\">\n";
239	}
240}
241
242# list_folders()
243# Returns a list of all folders for this user
244# folder types: 0 = mbox, 1 = maildir, 2 = pop3, 3 = mh, 4 = imap, 5 = combined,
245#		6 = virtual
246# folder modes: 0 = ~/mail, 1 = external folder, 2 = sent mail,
247#               3 = inbox/drafts/trash
248my @list_folders_cache;
249sub list_folders
250{
251if (@list_folders_cache) {
252	return @list_folders_cache;
253	}
254my (@rv, $f, $o, %done);
255
256# Read the module's config directory, to find folders files
257opendir(DIR, $user_module_config_directory);
258my @folderfiles = readdir(DIR);
259closedir(DIR);
260
261if ($config{'mail_system'} == 2) {
262	# POP3 inbox
263	push(@rv, { 'name' => $text{'folder_inbox'},
264		    'type' => 2,
265		    'server' => $config{'pop3_server'} || "localhost",
266		    'mode' => 3,
267		    'remote' => 1,
268		    'nowrite' => 1,
269		    'inbox' => 1,
270		    'index' => 0 });
271	&read_file("$user_module_config_directory/inbox.pop3", $rv[$#rv]);
272	}
273elsif ($config{'mail_system'} == 4) {
274	# IMAP inbox
275	my $imapserver = $config{'pop3_server'} || "localhost";
276	push(@rv, { 'name' => $text{'folder_inbox'},
277		    'id' => 'INBOX',
278		    'type' => 4,
279		    'server' => $imapserver,
280		    'ssl' => $config{'pop3_ssl'},
281		    'mode' => 3,
282		    'remote' => 1,
283		    'flags' => 1,
284		    'inbox' => 1,
285		    'index' => 0 });
286	&read_file("$user_module_config_directory/inbox.imap", $rv[$#rv]);
287
288	# Use HTTP username and password, if available and if logging in to
289	# a local IMAP server.
290	if ($remote_user && $main::remote_pass &&
291	    (&to_ipaddress($rv[0]->{'server'}) eq '127.0.0.1' ||
292	     &to_ipaddress($rv[0]->{'server'}) eq
293	      &to_ipaddress(&get_system_hostname()))) {
294		$rv[0]->{'user'} = $remote_user;
295		$rv[0]->{'pass'} = $main::remote_pass;
296		$rv[0]->{'autouser'} = 1;
297		}
298
299	# Get other IMAP folders (if we can)
300	my ($ok, $ih) = &imap_login($rv[0]);
301	if ($ok == 1) {
302		my @irv = &imap_command($ih, "list \"\" \"*\"");
303		if ($irv[0]) {
304			foreach my $l (@{$irv[1]}) {
305				if ($l =~ /LIST\s+\(.*\)\s+("(.*)"|\S+)\s+("(.*)"|\S+)/) {
306					# Found a folder line
307					my $fn = $4 || $3;
308					next if ($fn eq "INBOX");
309					push(@rv,
310					  { 'name' => &decode_utf7($fn),
311					    'id' => $fn,
312					    'type' => 4,
313					    'server' => $imapserver,
314					    'user' => $rv[0]->{'user'},
315					    'pass' => $rv[0]->{'pass'},
316					    'mode' => 0,
317					    'remote' => 1,
318					    'flags' => 1,
319					    'imapauto' => 1,
320					    'mailbox' => $fn,
321					    'nologout' => $config{'nologout'},
322					    'index' => scalar(@rv) });
323					&read_file("$user_module_config_directory/$fn.imap", $rv[$#rv]);
324					}
325				}
326			$rv[0]->{'nologout'} = $config{'nologout'};
327			}
328		}
329
330	# Find or create the IMAP sent mail folder
331	my $sf;
332	my $sent;
333	if ($userconfig{'sent_name'}) {
334		($sent) = grep { lc($_->{'name'}) eq lc($sf) } @rv;
335		}
336	else {
337		($sent) = grep { lc($_->{'name'}) eq 'sent' } @rv;
338		if (!$sent) {
339			($sent) = grep { $_->{'name'} =~ /sent/i } @rv;
340			}
341		}
342	if (!$sent && $ok == 1) {
343		my @irv = &imap_command($ih, "create \"$sf\"");
344		if ($irv[0]) {
345			$sent = { 'id' => $sf,
346			          'type' => 4,
347				  'server' => $imapserver,
348				  'user' => $rv[0]->{'user'},
349				  'pass' => $rv[0]->{'pass'},
350				  'mode' => 2,
351				  'remote' => 1,
352				  'flags' => 1,
353				  'imapauto' => 1,
354				  'mailbox' => $sf,
355			          'index' => scalar(@rv) };
356			push(@rv, $sent);
357			&read_file("$user_module_config_directory/$sf.imap",
358				   $sent);
359			}
360		}
361	if ($sent) {
362		$sent->{'name'} = $text{'folder_sent'};
363		$sent->{'perpage'} = $userconfig{'perpage_sent_mail'};
364		$sent->{'fromaddr'} = $userconfig{'fromaddr_sent_mail'};
365		$sent->{'sent'} = 1;
366		$sent->{'mode'} = 2;
367		}
368
369	# Find or create the IMAP drafts folder
370	my $df = $userconfig{'drafts_name'} || 'drafts';
371	my ($drafts) = grep { lc($_->{'name'}) eq lc($df) } @rv;
372	if (!$drafts && $ok == 1) {
373		my @irv = &imap_command($ih, "create \"$df\"");
374		if ($irv[0]) {
375			$drafts = { 'id' => $df,
376			            'type' => 4,
377				    'server' => $imapserver,
378				    'user' => $rv[0]->{'user'},
379				    'pass' => $rv[0]->{'pass'},
380				    'mode' => 3,
381				    'remote' => 1,
382				    'flags' => 1,
383				    'imapauto' => 1,
384				    'mailbox' => $df,
385			            'index' => scalar(@rv) };
386			push(@rv, $drafts);
387			&read_file("$user_module_config_directory/$df.imap",
388				   $drafts);
389			}
390		}
391	if ($drafts) {
392		$drafts->{'name'} = $text{'folder_drafts'};
393		$drafts->{'drafts'} = 1;
394		$drafts->{'mode'} = 3;
395		}
396
397	# Find or create the IMAP trash folder
398	if ($userconfig{'delete_mode'} == 1) {
399		my $tf = $userconfig{'trash_name'} || 'trash';
400		my ($trash) = grep { lc($_->{'name'}) eq lc($tf) } @rv;
401		if (!$trash && $ok == 1) {
402			my @irv = &imap_command($ih, "create \"$tf\"");
403			if ($irv[0]) {
404				$trash = { 'id' => $tf,
405					   'type' => 4,
406					   'server' => $imapserver,
407					   'user' => $rv[0]->{'user'},
408					   'pass' => $rv[0]->{'pass'},
409					   'mode' => 3,
410					   'remote' => 1,
411					   'flags' => 1,
412					   'imapauto' => 1,
413					   'mailbox' => $tf,
414					   'index' => scalar(@rv) };
415				push(@rv, $trash);
416				&read_file(
417				    "$user_module_config_directory/$tf.imap",
418				    $trash);
419				}
420			}
421		if ($trash) {
422			$trash->{'name'} = $text{'folder_trash'};
423			$trash->{'trash'} = 1;
424			$trash->{'mode'} = 3;
425			}
426		}
427
428	# For each IMAP folder, guess the underlying file
429	foreach my $f (@rv) {
430		if ($f->{'inbox'}) {
431			# Use the configured inbox location
432			my $path = $config{'mail_system'} == 0 ?
433                                &user_mail_file(@remote_user_info) :
434                                $qmail_maildir;
435			$f->{'file'} = $path if (-e $path);
436			}
437		else {
438			# Look in configured folders directory
439			my $path = "$folders_dir/$f->{'id'}";
440			if (-e $path) {
441				$f->{'file'} = $path;
442				}
443			else {
444				# Try . at start of folder names
445				my $n = $f->{'id'};
446				$n =~ s/^\.//;
447				if ($n =~ /\//) {
448					# Turn foo/bar to foo/.bar
449					$n =~ s/\//\/\./;
450					}
451				else {
452					# Turn foo to .foo
453					$n = ".".$n;
454					}
455				$path = "$folders_dir/$n";
456				$f->{'file'} = $path if (-e $path);
457				}
458			}
459		}
460
461	goto IMAPONLY;
462	}
463else {
464	# Local mail file inbox
465	push(@rv, { 'name' => $text{'folder_inbox'},
466		    'type' => $config{'mail_system'},
467		    'mode' => 3,
468		    'inbox' => 1,
469		    'file' => $config{'mail_system'} == 0 ?
470				&user_mail_file(@remote_user_info) :
471				$qmail_maildir,
472		    'index' => 0 });
473	$done{$rv[$#rv]->{'file'}}++;
474	}
475my $inbox = $rv[$#rv];
476
477# Add sent mail file
478my $sf;
479if ($folder_types{'ext'} && $userconfig{'sent_mail'}) {
480	$sf = $userconfig{'sent_mail'};
481	$done{$userconfig{'sent_mail'}}++;
482	}
483else {
484	my $sfn = $userconfig{'sent_name'} || 'sentmail';
485	$sf = "$folders_dir/$sfn";
486	if (!-e $sf && $userconfig{'mailbox_dir'} eq "Maildir") {
487		# For Maildir++ , use .sentmail
488		$sf = "$folders_dir/.$sfn";
489		}
490	}
491$done{$sf}++;
492my $sft = -e $sf ? &folder_type($sf) :
493	     $userconfig{'mailbox_dir'} eq "Maildir" ? 1 : 0;
494push(@rv, { 'name' => $text{'folder_sent'},
495	    'type' => $sft,
496	    'file' => $sf,
497	    'perpage' => $userconfig{'perpage_sent_mail'},
498	    'fromaddr' => $userconfig{'fromaddr_sent_mail'},
499	    'hide' => $userconfig{'hide_sent_mail'},
500	    'mode' => 2,
501	    'sent' => 1,
502	    'index' => scalar(@rv) });
503
504# Add drafts file
505my $dn = $userconfig{'drafts_name'};
506if ($dn && $userconfig{'mailbox_dir'} eq "Maildir" && $dn !~ /^\./) {
507	# Maildir++ folders always start with .
508	$dn = ".".$dn;
509	}
510my $df = $dn ? "$folders_dir/$dn" :
511	    -r "$folders_dir/Drafts" ? "$folders_dir/Drafts" :
512	    -r "$folders_dir/.Drafts" ? "$folders_dir/.Drafts" :
513	    -r "$folders_dir/.drafts" ? "$folders_dir/.drafts" :
514	    $userconfig{'mailbox_dir'} eq "Maildir" ? "$folders_dir/.drafts" :
515				        	      "$folders_dir/drafts";
516$done{$df}++;
517my $dft = -e $df ? &folder_type($df) :
518	     $userconfig{'mailbox_dir'} eq "Maildir" ? 1 : 0;
519push(@rv, { 'name' => $text{'folder_drafts'},
520	    'type' => $dft,
521	    'file' => $df,
522	    'mode' => 3,
523	    'drafts' => 1,
524	    'index' => scalar(@rv) });
525
526# Add trash folder
527my $tn = $userconfig{'trash_name'};
528if ($tn && $userconfig{'mailbox_dir'} eq "Maildir" && $tn !~ /^\./) {
529	# Maildir++ folders always start with .
530	$tn = ".".$tn;
531	}
532my $tf = $tn ? "$folders_dir/$tn" :
533	    -r "$folders_dir/Trash" ? "$folders_dir/Trash" :
534	    -r "$folders_dir/.Trash" ? "$folders_dir/.Trash" :
535	    -r "$folders_dir/.trash" ? "$folders_dir/.trash" :
536	    $userconfig{'mailbox_dir'} eq "Maildir" ?
537		"$folders_dir/.trash" : "$folders_dir/trash";
538$done{$tf}++;
539my $tft = -e $tf ? &folder_type($tf) :
540	     $userconfig{'mailbox_dir'} eq "Maildir" ? 1 : 0;
541push(@rv, { 'name' => $text{'folder_trash'},
542	    'type' => $tft,
543	    'file' => $tf,
544	    'mode' => 3,
545	    'trash' => 1,
546	    'index' => scalar(@rv) });
547
548# Add local folders, usually under ~/mail
549if ($folder_types{'local'}) {
550	foreach my $p (&recursive_files($folders_dir,
551				     $userconfig{'mailbox_recur'})) {
552		my $f = $p;
553		$f =~ s/^\Q$folders_dir\E\///;
554		my $name = $f;
555		if ($folders_dir eq "$remote_user_info[7]/Maildir") {
556			# A sub-folder under Maildir .. remove the . at the
557			# start of the sub-folder name
558			$name =~ s/^\.// || $name =~ s/\/\./\// || next;
559
560			# When in Maildir++ mode, any non-subdirectory
561			# is ignored
562			next if (!-d $p);
563			}
564		push(@rv, { 'name' => decode_utf7($name),
565			    'file' => $p,
566			    'type' => &folder_type($p),
567			    'perpage' => $userconfig{"perpage_$f"},
568			    'fromaddr' => $userconfig{"fromaddr_$f"},
569			    'show_to' => $userconfig{"show_to_$f"},
570			    'sent' => $userconfig{"sent_$f"},
571			    'hide' => $userconfig{"hide_$f"},
572			    'mode' => 0,
573			    'index' => scalar(@rv) } ) if (!$done{$p});
574		$done{$p}++;
575		}
576	}
577
578# Add sub-folders in ~/Maildir/ , as used by Courier
579if ($inbox->{'type'} == 1 && $userconfig{'mailbox_dir'} ne "Maildir") {
580	foreach my $p (&recursive_files($inbox->{'file'}, 0)) {
581		my $f = $p;
582		$f =~ s/^\Q$inbox->{'file'}\E\///;
583		my $name = $f;
584		$name =~ s/^\.// || $name =~ s/\/\./\//;
585		push(@rv, { 'name' => $name,
586			    'file' => $p,
587			    'type' => &folder_type($p),
588			    'perpage' => $userconfig{"perpage_$f"},
589			    'fromaddr' => $userconfig{"fromaddr_$f"},
590			    'show_to' => $userconfig{"show_to_$f"},
591			    'sent' => $userconfig{"sent_$f"},
592			    'hide' => $userconfig{"hide_$f"},
593			    'mode' => 0,
594			    'index' => scalar(@rv) } ) if (!$done{$p});
595		$done{$p}++;
596		}
597	}
598
599# Add user-defined external mail file folders
600if ($folder_types{'ext'}) {
601	foreach my $o (split(/\t+/, $userconfig{'mailboxes'})) {
602		$o =~ /\/([^\/]+)$/ || next;
603		push(@rv, { 'name' => $userconfig{"folder_$o"} || $1,
604			    'file' => $o,
605			    'perpage' => $userconfig{"perpage_$o"},
606			    'fromaddr' => $userconfig{"fromaddr_$o"},
607			    'show_to' => $userconfig{"show_to_$o"},
608			    'sent' => $userconfig{"sent_$o"},
609			    'hide' => $userconfig{"hide_$o"},
610			    'type' => &folder_type($o),
611			    'mode' => 1,
612			    'index' => scalar(@rv) } ) if (!$done{$o});
613		$done{$o}++;
614		}
615	}
616
617# Add user-defined POP3	and IMAP folders
618foreach my $f (@folderfiles) {
619	if ($f =~ /^(\d+)\.pop3$/ && $folder_types{'pop3'}) {
620		my %pop3 = ( 'id' => $1 );
621		&read_file("$user_module_config_directory/$f", \%pop3);
622		$pop3{'type'} = 2;
623		$pop3{'mode'} = 0;
624		$pop3{'remote'} = 1;
625		$pop3{'nowrite'} = 1;
626		$pop3{'index'} = scalar(@rv);
627		push(@rv, \%pop3);
628		}
629	elsif ($f =~ /^(\d+)\.imap$/ && $folder_types{'imap'}) {
630		my %imap = ( 'id' => $1 );
631		&read_file("$user_module_config_directory/$f", \%imap);
632		$imap{'type'} = 4;
633		$imap{'mode'} = 0;
634		$imap{'remote'} = 1;
635		$imap{'flags'} = 1;
636		$imap{'index'} = scalar(@rv);
637		push(@rv, \%imap);
638		}
639	}
640
641# When in IMAP inbox mode, we goto this label to skip all my folders
642IMAPONLY:
643
644# Add user-defined composite folders
645my %fcache;
646foreach my $f (@folderfiles) {
647	if ($f =~ /^(\d+)\.comp$/) {
648		my %comp = ( 'id' => $1 );
649		&read_file("$user_module_config_directory/$f", \%comp);
650		$comp{'folderfile'} = "$user_module_config_directory/$f";
651		$comp{'type'} = 5;
652		$comp{'mode'} = 0;
653		$comp{'index'} = scalar(@rv);
654		my $sfn;
655		foreach my $sfn (split(/\t+/, $comp{'subfoldernames'})) {
656			my $sf = &find_named_folder($sfn, \@rv, \%fcache);
657			push(@{$comp{'subfolders'}}, $sf) if ($sf);
658			}
659		push(@rv, \%comp);
660		}
661	}
662
663# Add spam folder as specified in spamassassin module, in case it is
664# outside of the folders we scan
665if (&foreign_check("spam")) {
666	my %suserconfig = &foreign_config("spam", 1);
667	my $file = $suserconfig{'spam_file'};
668	$file ||= "";
669	$file =~ s/\.$//;
670	$file =~ s/\/$//;
671	$file = "$remote_user_info[7]/$file" if ($file && $file !~ /^\//);
672	$file =~ s/\~/$remote_user_info[7]/;
673	if ($file) {
674		if ($config{'mail_system'} == 4) {
675			# In IMAP mode, the first folder named spam is marked
676			my ($sf) = grep { lc($_->{'name'}) eq 'spam' } @rv;
677			if ($sf) {
678				$sf->{'spam'} = 1;
679				}
680			}
681		elsif (!$done{$file}) {
682			# Need to add
683			push(@rv, { 'name' => "Spam",
684				    'file' => $file,
685				    'type' => &folder_type($file),
686				    'perpage' => $userconfig{"perpage_$file"},
687				    'fromaddr' => $userconfig{"fromaddr_$file"},
688				    'sent' => $userconfig{"sent_$file"},
689				    'hide' => 0,
690				    'mode' => 0,
691				    'spam' => 1,
692				    'index' => scalar(@rv) } );
693			$done{$file}++;
694			}
695		else {
696			# Mark as spam folder
697			my ($sf) = grep { $_->{'file'} eq $file } @rv;
698			if ($sf) {
699				$sf->{'spam'} = 1;
700				}
701			}
702		}
703	}
704
705# Add virtual folders. This has to be last, so that other folders can be found
706# based on virtual/composite indexes.
707foreach my $f (@folderfiles) {
708	if ($f =~ /^(\d+)\.virt$/) {
709		my %virt = ( 'id' => $1 );
710		&read_file("$user_module_config_directory/$f", \%virt);
711		$virt{'folderfile'} = "$user_module_config_directory/$f";
712		$virt{'type'} = 6;
713		$virt{'mode'} = 0;
714		$virt{'index'} = scalar(@rv);
715		$virt{'noadd'} = 1;
716		$virt{'members'} = [ ];
717		push(@rv, \%virt);
718		}
719	}
720
721# Expand virtual folder sub-folders
722foreach my $virt (grep { $_->{'type'} == 6 } @rv) {
723	foreach my $k (keys %$virt) {
724		next if ($k !~ /^\d+$/);
725		next if ($virt->{$k} !~ /\t/);  # Old format
726		my ($sfn, $id) = split(/\t+/, $virt->{$k}, 2);
727		my $sf = &find_named_folder($sfn, \@rv, \%fcache);
728		$virt->{'members'}->[$k] = [ $sf, $id ] if ($sf);
729		delete($virt->{$k});
730		}
731	}
732
733# Work out last-modified time of all folders, and set sortable flag
734&set_folder_lastmodified(\@rv);
735
736# Set searchable flag
737foreach my $f (@rv) {
738	$f->{'searchable'} = 1 if ($f->{'type'} != 6 ||
739				   $f->{'id'} != $search_folder_id);
740	}
741
742# Set show to/from flags
743foreach my $f (@rv) {
744	if (!defined($f->{'show_to'})) {
745		$f->{'show_to'} = $f->{'sent'} || $f->{'drafts'} ||
746				  $userconfig{'show_to'};
747		}
748	if (!defined($f->{'show_from'})) {
749		$f->{'show_from'} = !($f->{'sent'} || $f->{'drafts'}) ||
750				    $userconfig{'show_to'};
751		}
752	}
753
754# For Maildir folders, check if we can get the read flag from the folder files
755foreach my $f (@rv) {
756	if ($f->{'type'} == 1) {
757		$f->{'flags'} = 2;
758		}
759	}
760
761@list_folders_cache = @rv;
762return @rv;
763}
764
765# get_spam_inbox_folder()
766# Returns the folder to which spam should be moved
767sub get_spam_inbox_folder
768{
769my ($inbox) = grep { $_->{'inbox'} } &list_folders();
770return $inbox;
771}
772
773# save_folder(&folder, [&old])
774# Creates or updates a folder
775sub save_folder
776{
777my ($folder, $old) = @_;
778mkdir($folders_dir, 0700) if (!-d $folders_dir);
779if ($folder->{'type'} == 2) {
780	# A POP3 folder
781	$folder->{'id'} ||= time();
782	my %pop3;
783	foreach my $k (keys %$folder) {
784		if ($k ne "type" && $k ne "mode" && $k ne "remote" &&
785		    $k ne "nowrite" && $k ne "index") {
786			$pop3{$k} = $folder->{$k};
787			}
788		}
789	&write_file("$user_module_config_directory/$folder->{'id'}.pop3",
790		    \%pop3);
791	chmod(0700, "$user_module_config_directory/$folder->{'id'}.pop3");
792	}
793elsif ($folder->{'type'} == 4) {
794	# An IMAP folder
795	my @exclude;
796	if ($folder->{'imapauto'}) {
797		# This type of folder needs to be really created or updated
798		# on the server
799		if (!$folder->{'id'}) {
800			# Need to create
801			my ($ok, $ih) = &imap_login($folder);
802			my @irv = &imap_command($ih,
803					"create \"$folder->{'name'}\"");
804			$irv[0] || &error($irv[2]);
805			$folder->{'id'} = $folder->{'mailbox'} =
806				$folder->{'name'};
807			}
808		elsif ($folder->{'mailbox'} ne $folder->{'name'}) {
809			# Need to rename
810			my ($ok, $ih) = &imap_login($folder);
811			my @irv = &imap_command($ih,
812				"rename \"$folder->{'mailbox'}\" \"$folder->{'name'}\"");
813			$irv[0] || &error($irv[2]);
814			$folder->{'id'} = $folder->{'name'};
815			$folder->{'id'} = $folder->{'mailbox'} =
816				$folder->{'name'};
817			}
818		@exclude = ( "type", "mode", "remote", "nowrite", "index",
819			     "id", "mailbox", "server", "user", "pass" );
820		}
821	else {
822		# Just save details of IMAP folder in a file
823		$folder->{'id'} ||= time();
824		@exclude = ( "type", "mode", "remote", "nowrite", "index" );
825		}
826	my %imap;
827	foreach my $k (keys %$folder) {
828		if (&indexof($k, @exclude) == -1) {
829			$imap{$k} = $folder->{$k};
830			}
831		}
832	&write_file("$user_module_config_directory/$folder->{'id'}.imap",
833		    \%imap);
834	chmod(0700, "$user_module_config_directory/$folder->{'id'}.imap");
835	}
836elsif ($folder->{'type'} == 5) {
837	# A composite
838	$folder->{'id'} ||= time();
839	my %comp;
840	foreach my $k (keys %$folder) {
841		if ($k ne "type" && $k ne "mode" && $k ne "index" &&
842		    $k ne "subfolders") {
843			$comp{$k} = $folder->{$k};
844			}
845		}
846	my ($sf, @sfns);
847	foreach my $sf (@{$folder->{'subfolders'}}) {
848		my $sfn = &folder_name($sf);
849		push(@sfns, $sfn);
850		}
851	$comp{'subfoldernames'} = join("\t", @sfns);
852	&write_file("$user_module_config_directory/$folder->{'id'}.comp",
853		    \%comp);
854	chmod(0700, "$user_module_config_directory/$folder->{'id'}.comp");
855	}
856elsif ($folder->{'type'} == 6) {
857	# A virtual folder
858	$folder->{'id'} ||= time();
859	my %virt;
860	foreach my $k (keys %$folder) {
861		if ($k ne "type" && $k ne "mode" && $k ne "index" &&
862		    $k ne "members") {
863			$virt{$k} = $folder->{$k};
864			}
865		}
866	my $i;
867	my $mems = $folder->{'members'};
868	for($i=0; $i<@$mems; $i++) {
869		$virt{$i} = &folder_name($mems->[$i]->[0])."\t".
870			    $mems->[$i]->[1];
871		}
872	&write_file("$user_module_config_directory/$folder->{'id'}.virt",
873		    \%virt);
874	chmod(0700, "$user_module_config_directory/$folder->{'id'}.virt");
875	}
876elsif ($folder->{'mode'} == 0) {
877	# Updating a folder in ~/mail .. need to manage file, and config options
878	my $path = "$folders_dir/$folder->{'name'}";
879	if ($folders_dir eq "$remote_user_info[7]/Maildir") {
880		# Maildir sub-folder .. put a . in the name
881		$path =~ s/([^\/]+)$/.$1/;
882		}
883	if ($folder->{'name'} =~ /\//) {
884		my $pp = $path;
885		$pp =~ s/\/[^\/]+$//;
886		system("mkdir -p ".quotemeta($pp));
887		}
888	if (!$old) {
889		# Create the mailbox/maildir/MH dir
890		if ($folder->{'type'} == 0) {
891			open(my $FOLDER, ">>", "$path");
892			close($FOLDER);
893			chmod(0700, $path);
894			}
895		elsif ($folder->{'type'} == 1) {
896			mkdir($path, 0700);
897			mkdir("$path/cur", 0700);
898			mkdir("$path/new", 0700);
899			mkdir("$path/tmp", 0700);
900			}
901		elsif ($folder->{'type'} == 3) {
902			mkdir($path, 0700);
903			}
904		}
905	elsif ($old->{'name'} ne $folder->{'name'}) {
906		# Just rename
907		rename($old->{'file'}, $path);
908		}
909	if ($old) {
910		delete($userconfig{'perpage_'.$old->{'name'}});
911		delete($userconfig{'sent_'.$old->{'name'}});
912		delete($userconfig{'hide_'.$old->{'name'}});
913		delete($userconfig{'fromaddr_'.$old->{'name'}});
914		}
915	$userconfig{'perpage_'.$folder->{'name'}} = $folder->{'perpage'}
916		if ($folder->{'perpage'});
917	$userconfig{'sent_'.$folder->{'name'}} = $folder->{'sent'}
918		if ($folder->{'sent'});
919	$userconfig{'hide_'.$folder->{'name'}} = $folder->{'hide'}
920		if ($folder->{'hide'});
921	$userconfig{'fromaddr_'.$folder->{'name'}} = $folder->{'fromaddr'}
922		if ($folder->{'fromaddr'});
923	$userconfig{'show_to_'.$folder->{'name'}} = $folder->{'show_to'};
924	&save_user_module_config();
925	$folder->{'file'} = $path;
926	}
927elsif ($folder->{'mode'} == 1) {
928	# Updating or adding an external file folder
929	my @mailboxes = split(/\t+/, $userconfig{'mailboxes'});
930	if (!$old) {
931		push(@mailboxes, $folder->{'file'});
932		}
933	else {
934		delete($userconfig{'folder_'.$folder->{'file'}});
935		delete($userconfig{'perpage_'.$folder->{'file'}});
936		delete($userconfig{'sent_'.$folder->{'file'}});
937		delete($userconfig{'hide_'.$folder->{'file'}});
938		delete($userconfig{'fromaddr_'.$folder->{'file'}});
939		my $idx = &indexof($folder->{'file'}, @mailboxes);
940		$mailboxes[$idx] = $folder->{'file'};
941		}
942	$userconfig{'folder_'.$folder->{'file'}} = $folder->{'name'};
943	$userconfig{'perpage_'.$folder->{'file'}} = $folder->{'perpage'}
944		if ($folder->{'perpage'});
945	$userconfig{'sent_'.$folder->{'file'}} = $folder->{'sent'};
946	$userconfig{'hide_'.$folder->{'file'}} = $folder->{'hide'}
947		if ($folder->{'hide'});
948	$userconfig{'fromaddr_'.$folder->{'file'}} = $folder->{'fromaddr'}
949		if ($folder->{'fromaddr'});
950	$userconfig{'show_to_'.$folder->{'file'}} = $folder->{'show_to'};
951	$userconfig{'mailboxes'} = join("\t", @mailboxes);
952	&save_user_module_config();
953	}
954elsif ($folder->{'mode'} == 2) {
955	# The sent mail folder
956	delete($userconfig{'perpage_sent_mail'});
957	delete($userconfig{'hide_sent_mail'});
958	delete($userconfig{'fromaddr_sent_mail'});
959	my $sf = "$folders_dir/sentmail";
960	if ($folder->{'file'} eq $sf) {
961		delete($userconfig{'sent_mail'});
962		}
963	else {
964		$userconfig{'sent_mail'} = $folder->{'file'};
965		}
966	$userconfig{'perpage_sent_mail'} = $folder->{'perpage'}
967		if ($folder->{'perpage'});
968	$userconfig{'hide_sent_mail'} = $folder->{'hide'}
969		if ($folder->{'hide'});
970	$userconfig{'fromaddr_sent_mail'} = $folder->{'fromaddr'}
971		if ($folder->{'fromaddr'});
972	&save_user_module_config();
973	}
974# Add to or update cache
975if (@list_folders_cache) {
976	if ($old) {
977		my $idx = &indexof($old, @list_folders_cache);
978		if ($idx >= 0) {
979			$list_folders_cache[$idx] = $folder;
980			}
981		}
982	else {
983		push(@list_folders_cache, $folder);
984		}
985	}
986}
987
988# delete_folder(&folder)
989# Removes some folder
990sub delete_folder
991{
992my ($folder) = @_;
993if ($folder->{'type'} == 2) {
994	# A POP3 folder
995	unlink("$user_module_config_directory/$folder->{'id'}.pop3");
996	system("rm -rf $user_module_config_directory/$folder->{'id'}.cache");
997	}
998elsif ($folder->{'type'} == 4) {
999	# An IMAP folder
1000	unlink("$user_module_config_directory/$folder->{'id'}.imap");
1001	system("rm -rf $user_module_config_directory/$folder->{'id'}.cache");
1002
1003	if ($folder->{'imapauto'}) {
1004		# Remove actual folder from IMAP server too
1005		my ($ok, $ih) = &imap_login($folder);
1006		my @irv = &imap_command($ih, "delete \"$folder->{'name'}\"");
1007		$irv[0] || &error($irv[2] || "Unknown IMAP error");
1008		}
1009	}
1010elsif ($folder->{'type'} == 5) {
1011	# A composite folder
1012	unlink("$user_module_config_directory/$folder->{'id'}.comp");
1013	}
1014elsif ($folder->{'type'} == 6) {
1015	# A virtual folder
1016	unlink("$user_module_config_directory/$folder->{'id'}.virt");
1017	}
1018elsif ($folder->{'mode'} == 0) {
1019	# Deleting a folder within ~/mail
1020	if ($folder->{'type'} == 0) {
1021		unlink($folder->{'file'});
1022		}
1023	else {
1024		system("rm -rf ".quotemeta($folder->{'file'}));
1025		}
1026	delete($userconfig{'perpage_'.$folder->{'name'}});
1027	delete($userconfig{'sent_'.$folder->{'name'}});
1028	delete($userconfig{'hide_'.$folder->{'name'}});
1029	delete($userconfig{'fromaddr_'.$folder->{'name'}});
1030	&save_user_module_config();
1031	}
1032elsif ($folder->{'mode'} == 1) {
1033	# Remove from list of external folders
1034	my @mailboxes = split(/\t+/, $userconfig{'mailboxes'});
1035	@mailboxes = grep { $_ ne $folder->{'file'} } @mailboxes;
1036	delete($userconfig{'folder_'.$folder->{'file'}});
1037	delete($userconfig{'perpage_'.$folder->{'file'}});
1038	delete($userconfig{'sent_'.$folder->{'file'}});
1039	delete($userconfig{'hide_'.$folder->{'file'}});
1040	delete($userconfig{'fromaddr_'.$folder->{'file'}});
1041	$userconfig{'mailboxes'} = join("\t", @mailboxes);
1042	&save_user_module_config();
1043	}
1044
1045# Remove from cache
1046if (@list_folders_cache) {
1047	@list_folders_cache = grep { $_ ne $folder } @list_folders_cache;
1048	}
1049
1050# Delete mbox or Maildir index
1051if ($folder->{'type'} == 0) {
1052	my $ifile = &user_index_file($folder->{'file'});
1053	unlink(glob("$ifile.*"), $ifile);
1054	}
1055elsif ($folder->{'type'} == 1) {
1056	my $cachefile = &get_maildir_cachefile($folder->{'file'});
1057	unlink($cachefile);
1058	}
1059
1060# Delete sort index
1061my $ifile = &folder_new_sort_index_file($folder);
1062unlink(glob("$ifile.*"), $ifile);
1063
1064# Delete sort direction file
1065my $file = &folder_name($folder);
1066$file =~ s/\//_/g;
1067unlink("$user_module_config_directory/sort.$file");
1068}
1069
1070# need_delete_warn(&folder)
1071sub need_delete_warn
1072{
1073return 0 if ($_[0]->{'type'} == 6 && !$_[0]->{'delete'});
1074return 1 if ($userconfig{'delete_warn'} eq 'y');
1075return 0 if ($userconfig{'delete_warn'} eq 'n');
1076my $mf;
1077return $_[0]->{'type'} == 0 &&
1078       ($mf = &folder_file($_[0])) &&
1079       &disk_usage_kb($mf)*1024 > $userconfig{'delete_warn'};
1080}
1081
1082# get_signature()
1083# Returns the users signature, if any
1084sub get_signature
1085{
1086my $sf = &get_signature_file();
1087$sf || return undef;
1088return &read_file_contents($sf);
1089}
1090
1091# get_signature_file()
1092# Returns the full path to the file that should contain the user's signature,
1093# or undef if none is defined
1094sub get_signature_file
1095{
1096return undef if ($userconfig{'sig_file'} eq '*');
1097my $sf = $userconfig{'sig_file'};
1098$sf = "$remote_user_info[7]/$sf" if ($sf !~ /^\//);
1099return &group_subs($sf);
1100}
1101
1102# movecopy_select(number, &folders, &folder-to-exclude, copy-only)
1103# Returns HTML for selecting a folder to move or copy to
1104sub movecopy_select
1105{
1106my $rv;
1107if (!$_[3]) {
1108	$rv .= &ui_submit($text{'mail_move'}, "move".$_[0]);
1109	}
1110print &ui_submit($text{'mail_copy'}, "copy".$_[0]);
1111my @mfolders = grep { $_ ne $_[2] && !$_->{'nowrite'} } @{$_[1]};
1112$rv .= &folder_select(\@mfolders, undef, "mfolder$_[0]");
1113return $rv;
1114}
1115
1116# show_folder_options(&folder, mode)
1117# Print HTML for editing the options for some folder
1118sub show_folder_options
1119{
1120my ($folder, $mode) = @_;
1121
1122# Messages per page
1123print &ui_table_row($text{'edit_perpage'},
1124	&ui_opt_textbox("perpage", $folder->{'perpage'}, 5, $text{'default'}));
1125
1126# Show as sent mail
1127if ($mode != 2) {
1128	print &ui_table_row($text{'edit_sentview'},
1129		&ui_yesno_radio("show_to", $folder->{'show_to'}));
1130	}
1131
1132# From address for sent mail
1133print &ui_table_row($text{'edit_fromaddr'},
1134	&ui_opt_textbox("fromaddr", $folder->{'fromaddr'}, 30,
1135			$text{'default'})." ".
1136	&address_button("fromaddr", 0, 1));
1137
1138# Hide from folder list?
1139print &ui_table_row($text{'edit_hide'},
1140	&ui_yesno_radio("hide", $folder->{'hide'}));
1141}
1142
1143# parse_folder_options(&folder, mode, &in)
1144sub parse_folder_options
1145{
1146my ($folder, $mode, $in) = @_;
1147if (!$in->{'perpage_def'}) {
1148	$in->{'perpage'} =~ /^\d+$/ || &error($text{'save_eperpage'});
1149	$folder->{'perpage'} = $in->{'perpage'};
1150	}
1151else {
1152	delete($folder->{'perpage'});
1153	}
1154if ($mode != 2) {
1155	$folder->{'show_to'} = $in->{'show_to'};
1156	$folder->{'show_from'} = !$in->{'show_to'};
1157	}
1158if (!$in->{'fromaddr_def'}) {
1159	$in->{'fromaddr'} =~ /\S/ || &error($text{'save_efromaddr'});
1160	$folder->{'fromaddr'} = $in->{'fromaddr'};
1161	}
1162$folder->{'hide'} = $in->{'hide'};
1163}
1164
1165# list_address_groups()
1166# Returns a list of address book entries, each an array reference containing
1167# the group name, members and index
1168sub list_address_groups
1169{
1170my @rv;
1171my $i = 0;
1172if (open(my $ADDRESS, "<", $address_group_book)) {
1173	while(<$ADDRESS>) {
1174		s/\r|\n//g;
1175		my @sp = split(/\t+/, $_);
1176		if (@sp == 2) {
1177			push(@rv, [ $sp[0], $sp[1], $i ]);
1178			}
1179		$i++;
1180		}
1181	close($ADDRESS);
1182	}
1183if ($config{'global_address_group'}) {
1184	my $gab = &group_subs($config{'global_address_group'});
1185	if (open(my $ADDRESS, "<", $gab)) {
1186		while(<$ADDRESS>) {
1187			s/\r|\n//g;
1188			my @sp = split(/\t+/, $_);
1189			if (@sp == 2) {
1190				push(@rv, [ $sp[0], $sp[1] ]);
1191				}
1192			}
1193		close($ADDRESS);
1194		}
1195	}
1196if ($userconfig{'sort_addrs'} == 1) {
1197	return sort { lc($a->[0]) cmp lc($b->[0]) } @rv;
1198	}
1199elsif ($userconfig{'sort_addrs'} == 2) {
1200	return sort { lc($a->[1]) cmp lc($b->[1]) } @rv;
1201	}
1202else {
1203	return @rv;
1204	}
1205}
1206
1207# create_address_group(name, members)
1208# Adds an entry to the address group book
1209sub create_address_group
1210{
1211no strict "subs";
1212&open_tempfile(ADDRESS, ">>$address_group_book");
1213&print_tempfile(ADDRESS, "$_[0]\t$_[1]\n");
1214&close_tempfile(ADDRESS);
1215use strict "subs";
1216}
1217
1218# modify_address_group(index, name, members)
1219# Updates some entry in the address group book
1220sub modify_address_group
1221{
1222&replace_file_line($address_group_book, $_[0], "$_[1]\t$_[2]\n");
1223}
1224
1225# delete_address_group(index)
1226# Deletes some entry from the address group book
1227sub delete_address_group
1228{
1229&replace_file_line($address_group_book, $_[0]);
1230}
1231
1232# list_folders_sorted()
1233# Like list_folders(), but applies the chosen sort
1234sub list_folders_sorted
1235{
1236my @folders = &list_folders();
1237my @rv;
1238if ($userconfig{'folder_sort'} == 0) {
1239	# Builtin, then ~/mail, then external
1240	my @builtin = grep { $_->{'mode'} >= 2 } @folders;
1241	my @local = grep { $_->{'mode'} == 0 } @folders;
1242	my @external = grep { $_->{'mode'} == 1 } @folders;
1243	@rv = (@builtin,
1244		(sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @local),
1245		(sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @external));
1246	}
1247elsif ($userconfig{'folder_sort'} == 1) {
1248	# Builtin, then rest sorted by name
1249	my @builtin = grep { $_->{'mode'} >= 2 } @folders;
1250	my @extra = grep { $_->{'mode'} < 2 } @folders;
1251	@rv = (@builtin,
1252		sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @extra);
1253	}
1254elsif ($userconfig{'folder_sort'} == 2) {
1255	# All by name
1256	@rv = sort { lc($a->{'name'}) cmp lc($b->{'name'}) } @folders;
1257	}
1258if ($userconfig{'default_folder'} && $userconfig{'folder_sort'} <= 1) {
1259	# Move default folder to top of the list
1260	my $df = &find_named_folder($userconfig{'default_folder'}, \@rv);
1261	if ($df) {
1262		@rv = ( $df, grep { $_ ne $df } @rv );
1263		}
1264	}
1265return @rv;
1266}
1267
1268# group_subs(filename)
1269# Replaces $group in a filename with the first valid primary or secondary
1270# that matches a file
1271sub group_subs
1272{
1273my @ginfo = getgrgid($remote_user_info[3]);
1274my $rv = $_[0];
1275$rv =~ s/\$group/$ginfo[0]/g;
1276if ($rv =~ /\$sgroup/) {
1277	# Try all secondary groups, and stop at the first one
1278	setgrent();
1279	while(@ginfo = getgrent()) {
1280		my @m = split(/\s+/, $ginfo[3]);
1281		if (&indexof($remote_user, @m) >= 0) {
1282			my $rv2 = $rv;
1283			$rv2 =~ s/\$sgroup/$ginfo[0]/g;
1284			if (-r $rv2) {
1285				$rv = $rv2;
1286				last;
1287				}
1288			}
1289		}
1290	endgrent() if ($gconfig{'os_type'} ne 'hpux');
1291	}
1292return $rv;
1293}
1294
1295# set_module_index(folder-num)
1296sub set_module_index
1297{
1298$module_index_link = "/$module_name/index.cgi?folder=$_[0]&start=$in{'start'}";
1299$module_index_name = $text{'mail_indexlink'};
1300}
1301
1302# check_modification(&folder)
1303# Display an error message if a folder has been modified since the time
1304# in $in{'mod'}
1305sub check_modification
1306{
1307my $newmod = &modification_time($_[0]);
1308if ($in{'mod'} && $in{'mod'} != $newmod && $userconfig{'check_mod'}) {
1309	# Changed!
1310	&error(&text('emodified', "index.cgi?folder=$_[0]->{'index'}"));
1311	}
1312}
1313
1314# list_from_addresses()
1315# Returns a list of allowed From: addresses for the current user
1316sub list_from_addresses
1317{
1318my $http_host = $ENV{'HTTP_HOST'};
1319$http_host =~ s/:\d+$//;
1320if (&check_ipaddress($http_host)) {
1321	# Try to reverse-lookup IP
1322	my $rev = gethostbyaddr(inet_aton($http_host), AF_INET);
1323	$http_host = $rev if ($rev);
1324	}
1325$http_host =~ s/^(www|ftp|mail)\.//;
1326my (@froms, @doms);
1327my $server_name = $config{'server_name'} || "";
1328if ($server_name eq 'ldap') {
1329	# Special mode - the From: addresses just come from LDAP
1330	my $entry = &get_user_ldap();
1331	push(@froms, $entry->get_value("mail"));
1332	push(@froms, $entry->get_value("mailAlternateAddress"));
1333	}
1334elsif ($remote_user =~ /\@/) {
1335	# From: address comes from username, which has an @ in it
1336	@froms = ( $remote_user );
1337	}
1338else {
1339	# Work out From: addresses from hostname
1340	my $hostname = $server_name eq '*' ? $http_host :
1341		  $server_name eq '' ? &get_system_hostname() :
1342						 $server_name;
1343	@doms = split(/\s+/, $hostname);
1344	my $ru = $remote_user;
1345	$ru =~ s/\.\Q$http_host\E$//;
1346	if ($http_host =~ /^([^\.]+)/) {
1347		$ru =~ s/\.\Q$1\E//;
1348		}
1349	@froms = map { $ru.'@'.$_ } @doms;
1350	}
1351my @mfroms;
1352if ($config{'from_map'}) {
1353	# Lookup username in from address mapping file, to get email.
1354	open(my $MAP, "<", $config{'from_map'});
1355	while(<$MAP>) {
1356		s/\r|\n//g;
1357		s/#.*$//;
1358		if ($remote_user !~ /\@/) {
1359			if (/^\s*(\S+)\s+(\S+\@\S+)/ &&
1360			    ($1 eq $remote_user || &indexof($1, @froms) >= 0) &&
1361			    $config{'from_format'} == 0) {
1362				# Username on LHS matches
1363				push(@mfroms, $2);
1364				}
1365			elsif (/^\s*(\S+\@\S+)\s+(\S+)/ &&
1366			       ($2 eq $remote_user || &indexof($2, @froms) >= 0) &&
1367			       $config{'from_format'} == 1) {
1368				# Username on RHS matches
1369				push(@mfroms, $1);
1370				}
1371			# For regular default vitual-server user
1372			#  - abuse@domain.com		domain@domain.com
1373			#  - hostmaster@domain.com	domain@domain.com
1374			#  - postmaster@domain.com	domain@domain.com
1375			#  - webmaster@domain.com	domain@domain.com
1376			elsif (/^\s*([\w\-]+@[\w\-\.]+)\s+([\w\-]+)[@-][\w\-\.]+/ &&
1377			       ($2 eq $remote_user) &&
1378			       $config{'from_format'} == 1) {
1379				# Username on RHS matches
1380				push(@mfroms, $1);
1381				}
1382			}
1383		else {
1384			# For additional vitual-server user
1385			#  - user1@domain.com	user1-domain.com
1386			#  - user1-alias1@domain.com	user1@domain.com
1387			#  - user1-alias2@domain.com	user1-domain.com
1388			my $remote_user__  = $remote_user;
1389			$remote_user__ =~ s/@/-/;
1390			if (/^\s*([\w\-]+@[\w\-\.]+)\s+([\w\-]+[@-][\w\-\.]+)/ &&
1391			       ($2 eq $remote_user || $2 eq $remote_user__) &&
1392			       $config{'from_format'} == 1) {
1393				push(@mfroms, $1);
1394				}
1395			}
1396		}
1397	close($MAP);
1398
1399	# Prefer email where mailbox matches username
1400	@mfroms = sort { my ($abox, $adom) = split(/\@/, $a);
1401			 my ($bbox, $bdom) = split(/\@/, $b);
1402			 $remote_user =~ /\Q$abox\E/ &&
1403			  $remote_user !~ /\Q$bbox\E/ ? -1 :
1404			 $remote_user !~ /\Q$abox\E/ &&
1405			  $remote_user =~ /\Q$bbox\E/ ? 1 : 0 } @mfroms;
1406	}
1407if (@mfroms > 0) {
1408	# Got some results from mapping file .. use them
1409	if ($remote_user =~ /\@/) {
1410		# But still keep email-style login as the default
1411		@froms = ( $froms[0], @mfroms );
1412		}
1413	else {
1414		@froms = @mfroms;
1415		}
1416	}
1417
1418# Store only unique from addresses
1419my %fromsu = ();
1420@froms = grep { !$fromsu{$_} ++ } @froms;
1421
1422# Add user's real name
1423my $ureal = $remote_user_info[6];
1424my %real_names = map { $_->[0], $_->[1] } &list_addresses();
1425$ureal =~ s/,.*$//;
1426foreach my $f (@froms) {
1427	if ($real_names{$f}) {
1428		$f = "$real_names{$f} <$f>";
1429		}
1430	elsif ($ureal && $userconfig{'real_name'}) {
1431		$f = "\"$ureal\" <$f>";
1432		}
1433	}
1434return (\@froms, \@doms);
1435}
1436
1437# update_delivery_notification(&mail, &folder)
1438# If the given mail is a DSN, update the original email so we know it has
1439# been read
1440my (%dsnreplies, %delreplies);
1441sub update_delivery_notification
1442{
1443my ($mail, $folder) = @_;
1444return 0 if ($mail->{'header'}->{'content-type'} !~ /multipart\/report/i);
1445my $mid = $mail->{'header'}->{'message-id'};
1446&open_dsn_hash();
1447if ($dsnreplies{$mid} || $delreplies{$mid}) {
1448	# We have already done this DSN
1449	return 0;
1450	}
1451if (!defined($mail->{'body'}) && !$mail->{'parsed'} &&
1452    defined($mail->{'idx'})) {
1453	# This message has no body, perhaps because one wasn't fetched ..
1454	my @mail = &mailbox_list_mails($mail->{'idx'}, $mail->{'idx'},
1455					  $folder);
1456	$mail = $mail[$mail->{'idx'}];
1457	}
1458$dsnreplies{$mid} = $delreplies{$mid} = 1;
1459
1460# Find the delivery or disposition status attachment
1461&parse_mail($mail);
1462my ($dsnattach) = grep { $_->{'header'}->{'content-type'} =~ /message\/disposition-notification/i } @{$mail->{'attach'}};
1463my ($delattach) = grep { $_->{'header'}->{'content-type'} =~ /message\/delivery-status/i } @{$mail->{'attach'}};
1464
1465my $omid;
1466if ($dsnattach) {
1467	# Update the read status for the original message
1468	if ($dsnattach->{'data'} =~ /Original-Message-ID:\s*(.*)/) {
1469		$omid = $1;
1470		}
1471	else {
1472		return 0;
1473		}
1474	my ($faddr) = &split_addresses($mail->{'header'}->{'from'});
1475	&add_address_to_hash(\%dsnreplies, $omid, $faddr->[0]);
1476	return 1;
1477	}
1478elsif ($delattach) {
1479	# Update the delivery status for the original message, which will be
1480	# in a separate attachment
1481	my ($origattach) = grep { $_->{'header'}->{'content-type'} =~ /text\/rfc822-headers|message\/rfc822/i } @{$mail->{'attach'}};
1482	return 0 if (!$origattach);
1483	my $origmail = &extract_mail($origattach->{'data'});
1484	my $omid = $origmail->{'header'}->{'message-id'};
1485	return 0 if (!$omid);
1486	my ($faddr) = &split_addresses($origmail->{'header'}->{'from'});
1487	my $ds = &parse_delivery_status($delattach->{'data'});
1488	if ($ds->{'status'} =~ /^2\./) {
1489		&add_address_to_hash(\%delreplies, $omid, $faddr->[0]);
1490		}
1491	elsif ($ds->{'status'} =~ /^5\./) {
1492		&add_address_to_hash(\%delreplies, $omid, "!".$faddr->[0]);
1493		}
1494	}
1495else {
1496	return 0;
1497	}
1498}
1499
1500# add_address_to_hash(&hash, messageid, address)
1501sub add_address_to_hash
1502{
1503my @cv = split(/\s+/, $_[0]->{$_[1]});
1504my $idx = &indexof($_[2], @cv);
1505if ($idx < 0) {
1506	$_[0]->{$_[1]} .= " " if (@cv);
1507	$_[0]->{$_[1]} .= time()." ".$_[2];
1508	}
1509}
1510
1511# open_dsn_hash()
1512# Ensure the %dsnreplies and %delreplies hashes are tied
1513my $opened_dsnreplies;
1514my $opened_delreplies;
1515sub open_dsn_hash
1516{
1517if (!$opened_dsnreplies) {
1518	&open_dbm_db(\%dsnreplies,
1519		     "$user_module_config_directory/dsnreplies", 0600);
1520	$opened_dsnreplies = 1;
1521	}
1522if (!$opened_delreplies) {
1523	&open_dbm_db(\%delreplies,
1524		     "$user_module_config_directory/delreplies", 0600);
1525	$opened_delreplies = 1;
1526	}
1527}
1528
1529# open_read_hash()
1530# Ensure the %read hash is tied
1531my $opened_read;
1532my %read; # XXX This is sniffy. Used across bounderies.
1533sub open_read_hash
1534{
1535if (!$opened_read) {
1536	&open_dbm_db(\%read, "$user_module_config_directory/read", 0600);
1537	$opened_read = 1;
1538	}
1539}
1540
1541# get_special_folder()
1542# Returns the virtual folder containing messages marked as 'special', or undef
1543# if not defined yet.
1544my $special_folder_cache;
1545sub get_special_folder
1546{
1547if (defined($special_folder_cache)) {
1548	return $special_folder_cache || undef;
1549	}
1550else {
1551	# Find for real
1552	my @folders = &list_folders();
1553	my ($s) = grep { $_->{'type'} == 6 &&
1554			    $_->{'id'} == $special_folder_id } @folders;
1555	$special_folder_cache = $s ? $s : "";
1556	return $s;
1557	}
1558}
1559
1560# get_mail_read(&folder, &mail)
1561# Returns the read-mode flag for some email (0=unread, 1=read, 2=special)
1562# Checks the special folder first, then the read DBM
1563my %get_mail_read_cache;
1564sub get_mail_read
1565{
1566my ($folder, $mail) = @_;
1567if (defined($get_mail_read_cache{$mail->{'id'}})) {
1568	# Already checked in this run
1569	return $get_mail_read_cache{$mail->{'id'}};
1570	}
1571my $sfolder = &get_special_folder();
1572my ($realfolder, $realid) = &get_underlying_folder($folder, $mail);
1573my $special = 0;
1574if ($sfolder) {
1575	# Is it in the special folder? If so, definately special
1576	my ($spec) = grep { $_->[0] eq $realfolder &&
1577			       $_->[1] eq $realid } @{$sfolder->{'members'}};
1578	if ($spec) {
1579		$special = 2;
1580		}
1581	}
1582my $rv;
1583if ($realfolder->{'flags'}) {
1584	# For folders which can store the flags in the message itself (such
1585	# as IMAP), use that
1586	$rv = ($mail->{'read'} ? 1 : 0) +
1587	      ($mail->{'special'} ? 2 : 0) +
1588	      ($mail->{'replied'} ? 4 : 0);
1589	}
1590if (!$realfolder->{'flags'} || ($realfolder->{'flags'} == 2 && !$rv)) {
1591	# Check read hash if this folder doesn't support flagging, or if
1592	# it couldn't give us an answer.
1593	&open_read_hash();
1594	$rv = int($read{$mail->{'header'}->{'message-id'}});
1595	}
1596$rv = ($rv|$special);
1597$get_mail_read_cache{$mail->{'id'}} = $rv;
1598return $rv;
1599}
1600
1601# set_mail_read(&folder, &mail, read)
1602# Sets the read flag for some email, possibly updating the special folder.
1603# Read flags are 0=unread, 1=read, 2=special. Add 4 for replied.
1604sub set_mail_read
1605{
1606my ($folder, $mail, $read) = @_;
1607my ($realfolder, $realid);
1608if ($mail->{'id'}) {
1609	my $sfolder = &get_special_folder();
1610	($realfolder, $realid) = &get_underlying_folder($folder, $mail);
1611	print DEBUG "id=$mail->{'id'} realid=$realid\n";
1612	my $spec;
1613	if ($sfolder || ($read&2) != 0) {
1614		if ($sfolder) {
1615			# Is it already there?
1616			($spec) = grep { $_->[0] eq $realfolder &&
1617					 $_->[1] eq $realid }
1618				       @{$sfolder->{'members'}};
1619			print DEBUG "spec=$spec\n";
1620			}
1621		if (($read&2) != 0 && !$spec) {
1622			# Add to special folder
1623			if (!$sfolder) {
1624				# Create first
1625				$sfolder = { 'id' => $special_folder_id,
1626					     'type' => 6,
1627					     'name' => $text{'mail_special'},
1628					     'delete' => 1,
1629					     'members' => [ [
1630						$realfolder, $realid ] ],
1631					   };
1632				&save_folder($sfolder);
1633				$special_folder_cache = $sfolder;
1634				}
1635			else {
1636				# Just add
1637				push(@{$sfolder->{'members'}},
1638				     [ $realfolder,$realid ]);
1639				&save_folder($sfolder, $sfolder);
1640				}
1641			}
1642		elsif (($read&2) == 0 && $spec) {
1643			# Remove from special folder
1644			$sfolder->{'members'} =
1645			    [ grep { $_ ne $spec } @{$sfolder->{'members'}} ];
1646			&save_folder($sfolder, $sfolder);
1647			}
1648		}
1649	if ($realfolder->{'flags'}) {
1650		# Set the flag in the email itself, such as on an IMAP server
1651		my $mail->{'id'} = $realid; # So that IMAP can find it by UID
1652		&mailbox_set_read_flag($realfolder, $mail,
1653				       ($read&1),	    # Read
1654				       ($read&2),	    # Special
1655				       ($read&4));	    # Replied
1656		if ($realid ne $mail->{'id'} && ($read&2) && !$spec) {
1657			# ID changed .. fix in special folder
1658			($spec) = grep { $_->[0] eq $realfolder &&
1659					 $_->[1] eq $realid }
1660				       @{$sfolder->{'members'}};
1661			if ($spec) {
1662				$spec->[1] = $mail->{'id'};
1663				&save_folder($sfolder, $sfolder);
1664				}
1665			}
1666		}
1667	}
1668if (!$realfolder || !$realfolder->{'flags'} || $realfolder->{'flags'} == 2) {
1669	# Update read hash
1670	&open_read_hash();
1671	if ($read == 0) {
1672		delete($read{$mail->{'header'}->{'message-id'}});
1673		}
1674	else {
1675		$read{$mail->{'header'}->{'message-id'}} = $read;
1676		}
1677	}
1678if ($mail->{'id'}) {
1679	$get_mail_read_cache{$mail->{'id'}} = $read;
1680	}
1681}
1682
1683# get_underlying_folder(&folder, &mail)
1684# For mail in some virtual folder, returns the real folder and ID
1685sub get_underlying_folder
1686{
1687my ($realfolder, $mail) = @_;
1688my $realid = $mail->{'id'};
1689while($realfolder->{'type'} == 5 || $realfolder->{'type'} == 6) {
1690	my ($sfn, $sid) = split(/\t+/, $realid, 2);
1691	$realfolder = &find_subfolder($realfolder, $sfn);
1692	$realid = $sid;
1693	}
1694return ($realfolder, $realid);
1695}
1696
1697# spam_report_cmd()
1698# Returns a command for reporting spam, or undef if none
1699sub spam_report_cmd
1700{
1701my %sconfig = &foreign_config("spam");
1702if ($config{'spam_report'} eq 'sa_learn') {
1703	return &has_command($sconfig{'sa_learn'}) ? "$sconfig{'sa_learn'} --spam --mbox" : undef;
1704	}
1705elsif ($config{'spam_report'} eq 'spamassassin') {
1706	return &has_command($sconfig{'spamassassin'}) ? "$sconfig{'spamassassin'} --r" : undef;
1707	}
1708else {
1709	return &has_command($sconfig{'sa_learn'}) ?
1710		"$sconfig{'sa_learn'} --spam --mbox" :
1711	       &has_command($sconfig{'spamassassin'}) ?
1712		"$sconfig{'spamassassin'} --r" : undef;
1713	}
1714}
1715
1716# ham_report_cmd()
1717# Returns a command for reporting ham, or undef if none
1718sub ham_report_cmd
1719{
1720my %sconfig = &foreign_config("spam");
1721return &has_command($sconfig{'sa_learn'}) ? "$sconfig{'sa_learn'} --ham --mbox" : undef;
1722}
1723
1724# can_report_spam(&folder)
1725sub can_report_spam
1726{
1727return (&foreign_available("spam") || $config{'spam_always'}) &&
1728       &foreign_installed("spam") &&
1729       !$_[0]->{'sent'} && !$_[0]->{'drafts'} &&
1730       &spam_report_cmd();
1731}
1732
1733# can_report_ham(&folder)
1734sub can_report_ham
1735{
1736return (&foreign_available("spam") || $config{'spam_always'}) &&
1737       &foreign_installed("spam") &&
1738       !$_[0]->{'sent'} && !$_[0]->{'drafts'} &&
1739       &ham_report_cmd();
1740}
1741
1742# filter_by_status(&messages, status)
1743# Returns only messages with a particular status
1744sub filter_by_status
1745{
1746my (@rv, $mail);
1747&open_read_hash();
1748foreach my $mail (@{$_[0]}) {
1749	my $mid = $mail->{'header'}->{'message-id'};
1750	if ($read{$mid} == $_[1]) {
1751		push(@rv, $mail);
1752		}
1753	}
1754return @rv;
1755}
1756
1757# show_mailbox_buttons(number, &folders, current-folder, &mail)
1758# Prints HTML for buttons to appear above or below a mail list
1759sub show_mailbox_buttons
1760{
1761my ($num, $folders, $folder, $mail) = @_;
1762my $spacer = "&nbsp;\n";
1763
1764# Compose button
1765if ($userconfig{'open_mode'}) {
1766	# Compose button needs to pop up a window
1767	print &ui_submit($text{'mail_compose'}, "new", undef,
1768	      "onClick='window.open(\"reply_mail.cgi?new=1\", \"compose\", \"toolbar=no,menubar=no,scrollbars=yes,width=1024,height=768\"); return false'>");
1769	}
1770else {
1771	# Compose button can just submit and redirect
1772	print &ui_submit($text{'mail_compose'}, "new");
1773	}
1774print $spacer;
1775
1776# Forward selected
1777if (@$mail) {
1778	if ($userconfig{'open_mode'}) {
1779		print &ui_submit($text{'mail_forward'}, "forward", undef,
1780			"onClick='args = \"folder=$folder->{'index'}\"; for(i=0; i<form.d.length; i++) { if (form.d[i].checked) { args += \"&mailforward=\"+escape(form.d[i].value); } } window.open(\"reply_mail.cgi?\"+args, \"compose\", \"toolbar=no,menubar=no,scrollbars=yes,width=1024,height=768\"); return false'>");
1781		}
1782	else {
1783		# Forward button can just be a normal submit
1784		print &ui_submit($text{'mail_forward'}, "forward");
1785		}
1786	print $spacer;
1787	}
1788
1789# Mark as buttons
1790if (@$mail) {
1791	foreach my $i (0 .. 2) {
1792		print &ui_submit($text{'view_markas'.$i}, 'markas'.$i);
1793		}
1794	print $spacer;
1795	}
1796
1797# Copy/move to folder
1798if (@$mail && @$folders > 1) {
1799	print &movecopy_select($_[0], $folders, $folder);
1800	print $spacer;
1801	}
1802
1803# Delete
1804if (@$mail) {
1805	print &ui_submit($text{'mail_delete'}, "delete");
1806	print $spacer;
1807	}
1808
1809# Blacklist / report spam
1810if (@$mail && ($folder->{'spam'} || $userconfig{'spam_buttons'} =~ /list/ &&
1811				   &can_report_spam($folder))) {
1812	print &ui_submit($text{'mail_black'}, "black");
1813	if ($userconfig{'spam_del'}) {
1814		print &ui_submit($text{'view_razordel'}, "razor");
1815		}
1816	else {
1817		print &ui_submit($text{'view_razor'}, "razor");
1818		}
1819	print $spacer;
1820	}
1821
1822# Whitelist / report ham
1823if (@$mail && ($folder->{'spam'} || $userconfig{'ham_buttons'} =~ /list/ &&
1824				   &can_report_ham($folder))) {
1825	if ($userconfig{'white_move'} && $folder->{'spam'}) {
1826		print &ui_submit($text{'mail_whitemove'}, "white");
1827		}
1828	else {
1829		print &ui_submit($text{'mail_white'}, "white");
1830		}
1831	if ($userconfig{'ham_move'} && $folder->{'spam'}) {
1832		print &ui_submit($text{'view_hammove'}, "ham");
1833		}
1834	else {
1835		print &ui_submit($text{'view_ham'}, "ham");
1836		}
1837	print $spacer;
1838	}
1839
1840if ($userconfig{'open_mode'}) {
1841	# Show mass open button
1842	print &ui_submit($text{'mail_open'}, "new", undef,
1843	      "onClick='for(i=0; i<form.d.length; i++) { if (form.d[i].checked) { window.open(\"view_mail.cgi?folder=$folder->{'index'}&idx=\"+escape(form.d[i].value), \"view\"+i, \"toolbar=no,menubar=no,scrollbars=yes,width=1024,height=768\"); } } return false'>");
1844	print $spacer;
1845	}
1846
1847print "<br>\n";
1848}
1849
1850# expand_to(list)
1851# Given a string containing multiple email addresses and group names,
1852# expand out the group names (if any)
1853my (%address_groups, %real_expand_names);
1854my $expanded;
1855sub expand_to
1856{
1857$_[0] =~ s/\r//g;
1858$_[0] =~ s/\n/ /g;
1859if (!%address_groups) {
1860	%address_groups = map { $_->[0], $_->[1] } &list_address_groups();
1861	}
1862if ($userconfig{'real_expand'}) {
1863	if (!%real_expand_names) {
1864		%real_expand_names = map { $_->[1], $_->[0] }
1865					 grep { $_->[1] } &list_addresses()
1866		}
1867	}
1868my @addrs = &split_addresses($_[0]);
1869my (@alladdrs, $a, $expanded);
1870foreach my $a (@addrs) {
1871	if (defined($address_groups{$a->[0]})) {
1872		push(@alladdrs, &split_addresses($address_groups{$a->[0]}));
1873		$expanded++;
1874		}
1875	elsif (defined($real_expand_names{$a->[0]})) {
1876		push(@alladdrs, &split_addresses($real_expand_names{$a->[0]}));
1877		$expanded++;
1878		}
1879	else {
1880		push(@alladdrs, $a);
1881		}
1882	}
1883return $expanded ? join(", ", map { $_->[2] } @alladdrs)
1884		 : $_[0];
1885}
1886
1887# connect_qmail_ldap([return-error])
1888# Connect to the LDAP server used for Qmail. Returns an LDAP handle on success,
1889# or an error message on failure.
1890sub connect_qmail_ldap
1891{
1892eval "use Net::LDAP";
1893if ($@) {
1894	my $err = &text('ldap_emod', "<tt>Net::LDAP</tt>");
1895	if ($_[0]) { return $err; }
1896	else { &error($err); }
1897	}
1898
1899# Connect to server
1900my $port = $config{'ldap_port'} || 389;
1901my $ldap = Net::LDAP->new($config{'ldap_host'}, port => $port);
1902if (!$ldap) {
1903	my $err = &text('ldap_econn',
1904			   "<tt>$config{'ldap_host'}</tt>","<tt>$port</tt>");
1905	if ($_[0]) { return $err; }
1906	else { &error($err); }
1907	}
1908
1909# Start TLS if configured
1910if ($config{'ldap_tls'}) {
1911	$ldap->start_tls();
1912	}
1913
1914# Login
1915my $mesg;
1916if ($config{'ldap_login'}) {
1917	$mesg = $ldap->bind(dn => $config{'ldap_login'},
1918			    password => $config{'ldap_pass'});
1919	}
1920else {
1921	$mesg = $ldap->bind(anonymous => 1);
1922	}
1923if (!$mesg || $mesg->code) {
1924	my $err = &text('ldap_elogin', "<tt>$config{'ldap_host'}</tt>",
1925				 "<tt>$config{'ldap_login'}</tt>",
1926		     $mesg ? $mesg->error : "Unknown error");
1927	if ($_[0]) { return $err; }
1928	else { &error($err); }
1929	}
1930return $ldap;
1931}
1932
1933# get_user_ldap()
1934# Looks up the LDAP information for the current mailbox user, and returns a
1935# Net::LDAP::Entry object.
1936sub get_user_ldap
1937{
1938my $ldap = &connect_qmail_ldap();
1939my $rv = $ldap->search(base => $config{'ldap_base'},
1940			  filter => "(uid=$remote_user)");
1941&error("Failed to get LDAP entry : ",$rv->error) if ($rv->code);
1942my ($u) = $rv->all_entries();
1943&error("Could not find LDAP entry") if (!$u);
1944$ldap->unbind();
1945return $u;
1946}
1947
1948# would_exceed_quota(&folder, &mail, ...)
1949# Checks if the addition of a given email messages
1950# exceed any quotas. Called when saving a draft or copying an email.
1951# Returns undef if OK, or an error message
1952sub would_exceed_quota
1953{
1954my ($folder, @mail) = @_;
1955
1956# Get quotas in force
1957my ($total, $count, $totalquota, $countquota) = &get_user_quota();
1958return undef if (!$totalquota && !$countquota);
1959
1960# Work out how much we are adding
1961my $m;
1962my $adding = 0;
1963foreach my $m (@mail) {
1964	$adding += ($m->{'size'} || &mail_size($m));
1965	}
1966
1967# Check against size limit
1968if ($totalquota && $total + $adding > $totalquota) {
1969	return &text('quota_inbox', &nice_size($totalquota));
1970	}
1971
1972# Check against count limit
1973if ($countquota && $count + scalar(@mail) > $countquota) {
1974	return &text('quota_inbox2', $countquota);
1975	}
1976
1977return undef;
1978}
1979
1980# get_user_quota()
1981# If any quotas are in force, returns the total size of all folders, the total
1982# number of messages, the maximum size, and the maximum number of messages
1983sub get_user_quota
1984{
1985return ( ) if (!$config{'ldap_quotas'} && !$config{'max_quota'});
1986
1987# Work out current size of all local folders
1988my $f;
1989my $total = 0;
1990my $count = 0;
1991foreach my $f (&list_folders()) {
1992	if ($f->{'type'} == 0 || $f->{'type'} == 1 || $f->{'type'} == 3) {
1993		$total += &folder_size($f);
1994		$count += &mailbox_folder_size($f);
1995		}
1996	}
1997
1998# Get the configured quota
1999my $configquota = $config{'max_quota'};
2000
2001# Get the LDAP limit
2002my $ldapquota;
2003my $ldapcount;
2004if ($config{'ldap_host'} && $config{'ldap_quotas'}) {
2005	my $entry = &get_user_ldap();
2006	$ldapquota = $entry->get_value("mailQuotaSize");
2007	$ldapcount = $entry->get_value("mailQuotaCount");
2008	}
2009
2010my $quota = defined($configquota) && defined($ldapquota) ?
2011		min($configquota, $ldapquota) :
2012	       defined($configquota) ? $configquota :
2013	       defined($ldapquota) ? $ldapquota : undef;
2014return ($total, $count, $quota, $ldapcount);
2015}
2016
2017sub min
2018{
2019return $_[0] < $_[1] ? $_[0] : $_[1];
2020}
2021
2022# get_sort_field(&folder)
2023# Returns the field and direction on which sorting is done for the current user
2024sub get_sort_field
2025{
2026my ($folder) = @_;
2027return ( ) if (!$folder->{'sortable'});
2028my $file = &folder_name($folder);
2029$file =~ s/\//_/g;
2030my %sort;
2031if (&read_file_cached("$user_module_config_directory/sort.$file", \%sort)) {
2032	return ($sort{'field'}, $sort{'dir'});
2033	}
2034return ( );
2035}
2036
2037# save_sort_field(&folder, field, dir)
2038sub save_sort_field
2039{
2040my $file = &folder_name($_[0]);
2041$file =~ s/\//_/g;
2042my %sort = ( 'field' => $_[1], 'dir' => $_[2] );
2043&write_file("$user_module_config_directory/sort.$file", \%sort);
2044}
2045
2046# field_sort_link(title, field, folder-idx, start)
2047# Returns HTML for a link to switch sorting mode
2048sub field_sort_link
2049{
2050my ($title, $field, $folder, $start) = @_;
2051my ($sortfield, $sortdir) = &get_sort_field($folder);
2052my $dir = $sortfield eq $field ? !$sortdir : 0;
2053my $img = $sortfield eq $field && $dir ? "sortascgrey.gif" :
2054	     $sortfield eq $field && !$dir ? "sortdescgrey.gif" :
2055	     $dir ? "sortasc.gif" : "sortdesc.gif";
2056if ($folder->{'sortable'} && $userconfig{'show_sort'}) {
2057	return "<a href='sort.cgi?field=".&urlize($field)."&dir=".&urlize($dir)."&folder=".&urlize($folder->{'index'})."&start=".&urlize($start)."'>$title <img valign=middle src=../images/$img border=0>";
2058	}
2059else {
2060	return $title;
2061	}
2062}
2063
2064# view_mail_link(&folder, id, start, from-to-text)
2065sub view_mail_link
2066{
2067my ($folder, $id, $start, $txt) = @_;
2068my $qid = &urlize($id);
2069my $qstart = &urlize($start);
2070my $url = "view_mail.cgi?start=$qstart&id=$qid&folder=$folder->{'index'}";
2071if ($userconfig{'open_mode'}) {
2072	return "<a href='' onClick='window.open(\"$url\", \"viewmail\", \"toolbar=no,menubar=no,scrollbars=yes,width=1024,height=768\"); return false'>".
2073	       &simplify_from($txt)."</a>";
2074	}
2075else {
2076	return "<a href='$url'>".&simplify_from($txt)."</a>";
2077	}
2078}
2079
2080# mail_page_header(title, headstuff, bodystuff)
2081sub mail_page_header
2082{
2083if ($userconfig{'open_mode'}) {
2084	&popup_header(@_);
2085	}
2086else {
2087	&ui_print_header(undef, $_[0], "", undef, 0, 0, 0, undef, $_[1], $_[2]);
2088	}
2089}
2090
2091# mail_page_footer(link, text, ...)
2092sub mail_page_footer
2093{
2094if ($userconfig{'open_mode'}) {
2095	&popup_footer();
2096	}
2097else {
2098	&ui_print_footer(@_);
2099	}
2100}
2101
2102# get_auto_schedule(&folder)
2103# Returns the automatic schedule structure for the given folder
2104sub get_auto_schedule
2105{
2106my ($folder) = @_;
2107my $id = $folder->{'id'} || &urlize($folder->{'file'});
2108my %rv;
2109&read_file("$user_module_config_directory/$id.sched", \%rv) ||
2110	return undef;
2111return \%rv;
2112}
2113
2114# save_auto_schedule(&folder, &sched)
2115# Updates the automatic schedule structure for the given folder
2116sub save_auto_schedule
2117{
2118my ($folder, $sched) = @_;
2119my $id = $folder->{'id'} || &urlize($folder->{'file'});
2120if ($sched) {
2121	&write_file("$user_module_config_directory/$id.sched", $sched);
2122	}
2123else {
2124	unlink("$user_module_config_directory/$id.sched");
2125	}
2126}
2127
2128# setup_auto_cron()
2129# Creates the Cron job that runs auto.pl
2130sub setup_auto_cron
2131{
2132&foreign_require("cron", "cron-lib.pl");
2133my @jobs = &cron::list_cron_jobs();
2134my ($job) = grep { $_->{'command'} eq $auto_cmd &&
2135		      $_->{'user'} eq $remote_user } @jobs;
2136if (!$job) {
2137	$job = { 'command' => $auto_cmd,
2138		 'active' => 1,
2139		 'user' => $remote_user,
2140		 'mins' => int(rand()*60),
2141		 'hours' => '*',
2142		 'days' => '*',
2143		 'months' => '*',
2144		 'weekdays' => '*' };
2145	&cron::create_cron_job($job);
2146	}
2147&cron::create_wrapper($auto_cmd, $module_name, "auto.pl");
2148}
2149
2150# addressbook_to_whitelist()
2151# If SpamAssassin is installed, update the user's whitelist with all
2152# addressbook entries
2153sub addressbook_to_whitelist
2154{
2155if ($userconfig{'white_book'} && &foreign_installed("spam")) {
2156	&foreign_require("spam", "spam-lib.pl");
2157	my $conf = &spam::get_config();
2158	my @white = &spam::find_value("whitelist_from", $conf);
2159	my %white = map { lc($_), 1 } @white;
2160	foreach my $a (&list_addresses()) {
2161		if (!$white{lc($a->[0])}) {
2162			push(@white, $a->[0]);
2163			}
2164		}
2165	&spam::save_directives($conf, "whitelist_from", \@white, 1);
2166	&flush_file_lines();
2167	}
2168}
2169
2170# addressbook_add_whitelist(address, ...)
2171# Add some email address to the whitelist
2172sub addressbook_add_whitelist
2173{
2174my (@addrs) = @_;
2175if (&foreign_installed("spam")) {
2176	&foreign_require("spam", "spam-lib.pl");
2177	my $conf = &spam::get_config();
2178	my @white = &spam::find_value("whitelist_from", $conf);
2179	my %white = map { lc($_), 1 } @white;
2180	foreach my $a (@addrs) {
2181		if (!$white{lc($a)}) {
2182			push(@white, $a);
2183			}
2184		}
2185	&spam::save_directives($conf, "whitelist_from", \@white, 1);
2186	&flush_file_lines();
2187	}
2188}
2189
2190# addressbook_remove_whitelist(address)
2191# Delete some address from the whitelist
2192sub addressbook_remove_whitelist
2193{
2194my ($addr) = @_;
2195if ($userconfig{'white_book'} && &foreign_installed("spam")) {
2196	&foreign_require("spam", "spam-lib.pl");
2197	my $conf = &spam::get_config();
2198	my @white = &spam::find_value("whitelist_from", $conf);
2199	@white = grep { lc($_) ne lc($addr) } @white;
2200	&spam::save_directives($conf, "whitelist_from", \@white, 1);
2201	&flush_file_lines();
2202	}
2203}
2204
2205# left_right_align(left, right)
2206# Returns a table for left and right aligning some HTML
2207sub left_right_align
2208{
2209my ($l, $r) = @_;
2210return "<table cellpadding=0 cellspacing=0 width=100%><tr><td align=left>$l</td><td align=right>$r</td></tr></table>";
2211}
2212
2213# Returns 1 if downloading all attachment is possible
2214sub can_download_all
2215{
2216return &has_command("zip");
2217}
2218
2219# select_status_link(name, form, &folder, &mails, start, end, status, label)
2220# Returns HTML for selecting messages
2221sub select_status_link
2222{
2223my ($name, $formno, $folder, $mail, $start, $end, $status, $label) = @_;
2224$formno = int($formno);
2225my @sel;
2226for(my $i=$start; $i<=$end; $i++) {
2227	my $m = $mail->[$i];
2228	my $read = &get_mail_read($folder, $m);
2229	if ($status == 0 && !($read&1) ||
2230	    $status == 1 && ($read&1) ||
2231	    $status == 2 && ($read&2)) {
2232		push(@sel, $m->{'id'});
2233		}
2234	}
2235return &select_rows_link($name, $formno, $label, \@sel);
2236}
2237
2238# address_link(address, id, subs)
2239# Turns an address into a link for adding it to the addressbook
2240sub address_link
2241{
2242my ($addr, $id, $subs) = @_;
2243my $qid = &urlize($id);
2244## split_addresses() pattern-matches "[<>]", so 7-bit encodings
2245## such as ISO-2022-JP must be converted to EUC before feeding.
2246my $mw = &convert_header_for_display($addr, 0, 1);
2247my @addrs = &split_addresses(&eucconv($mw));
2248my @rv;
2249my %inbook;
2250foreach my $a (@addrs) {
2251	## TODO: is $inbook{} MIME or locale-encoded?
2252	if ($inbook{lc($a->[0])}) {
2253		push(@rv, &eucconv_and_escape($a->[2]));
2254		}
2255	else {
2256		## name= will be EUC encoded now since split_addresses()
2257		## is feeded with EUC converted value.
2258		push(@rv, "<a href='add_address.cgi?addr=".&urlize($a->[0]).
2259			  "&name=".&urlize($a->[1])."&id=$qid".
2260			  "&folder=$in{'folder'}&start=$in{'start'}$subs'>".
2261			  &eucconv_and_escape($a->[2])."</a>");
2262		}
2263	}
2264return join(" , ", @rv);
2265}
2266
2267# get_preferred_from_address()
2268# Returns the from address for the current user, which may come from their
2269# address book, or from the module config. Will include the real name too,
2270# where possible.
2271sub get_preferred_from_address
2272{
2273my ($froms, $doms) = &list_from_addresses();
2274my ($defaddr) = grep { $_->[3] == 2 } &list_addresses();
2275if ($defaddr) {
2276	# From address book
2277	if ($defaddr->[1]) {
2278		# Has real name
2279		my $n = $defaddr->[1];
2280		if ($n !~ /^[\000-\177]*$/) {
2281			$n = &encode_mimewords($n, 'Charset' => &get_charset());
2282			}
2283		return "\"".$n."\" "."<".$defaddr->[0].">";
2284		}
2285	else {
2286		# Just an address
2287		return $defaddr->[0];
2288		}
2289	return $defaddr->[1] ? "\"$defaddr->[1]\" <$defaddr->[0]>"
2290			      : $defaddr->[0];
2291	}
2292else {
2293	# Account default
2294	return $froms->[0];
2295	}
2296}
2297
2298# remove_own_email(addresses)
2299# Given a string containing email addresses, remove those belonging to the user
2300sub remove_own_email
2301{
2302my ($addrs) = @_;
2303my @addrs = &split_addresses($addrs);
2304
2305# Build our own addresses
2306my %own;
2307foreach my $a (&list_addresses()) {
2308	$own{$a->[0]}++ if ($a->[3]);
2309	}
2310my ($froms) = &list_from_addresses();
2311foreach my $f (@$froms) {
2312	my ($addr) = &split_addresses($f);
2313	$own{$addr->[0]}++;
2314	}
2315
2316# See what we have to remove
2317my @others = grep { !$own{$_->[0]} } @addrs;
2318if (scalar(@others) == scalar(@addrs) || !scalar(@others)) {
2319	# No need to change the string
2320	return $addrs;
2321	}
2322else {
2323	# Return just those left
2324	return join(", ", map { $_->[2] } @others);
2325	}
2326}
2327
2328# get_last_folder_id()
2329# Returns the ID of the folder last opened, or undef
2330sub get_last_folder_id
2331{
2332my $rv = &read_file_contents($last_folder_file);
2333$rv =~ s/\r|\n//g;
2334return $rv;
2335}
2336
2337# save_last_folder_id(id|&folder)
2338# Saves the last accessed folder ID
2339sub save_last_folder_id
2340{
2341my ($id) = @_;
2342$id = &folder_name($id) if (ref($id));
2343if ($id ne $search_folder_id && $id ne &get_last_folder_id()) {
2344	no strict "subs";
2345	if (&open_tempfile(LASTFOLDER, ">$last_folder_file", 1)) {
2346		&print_tempfile(LASTFOLDER, $id,"\n");
2347		&close_tempfile(LASTFOLDER);
2348		}
2349	use strict "subs";
2350	}
2351}
2352
23531;
2354