PageRenderTime 200ms CodeModel.GetById 44ms RepoModel.GetById 2ms app.codeStats 1ms

/mailboxes/folders-lib.pl

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