If a hangup occurs within 1000ms of a flash, consider it a bounce, and just hangup...
[asterisk/asterisk.git] / contrib / scripts / vmail.cgi
1 #!/usr/bin/perl
2 #
3 # Web based Voicemail for Asterisk
4 #
5 # Copyright (C) 2002, Linux Support Services, Inc.
6 #
7 # Distributed under the terms of the GNU General Public License
8 #
9 # Written by Mark Spencer <markster@linux-support.net>
10 #
11 # (icky, I know....  if you know better perl please help!)
12 #
13 #
14 use CGI qw/:standard/;
15 use CGI::Carp qw(fatalsToBrowser);
16
17 @validfolders = ( "INBOX", "Old", "Work", "Family", "Friends", "Cust1", "Cust2", "Cust3", "Cust4", "Cust5" );
18
19 %formats = (
20         "wav" => {
21                 name => "Uncompressed WAV",
22                 mime => "audio/x-wav",
23                 pref => 1
24         },
25         "WAV" => {
26                 name => "GSM Compressed WAV",
27                 mime => "audio/x-wav",
28                 pref => 2
29         },
30         "gsm" => {
31                 name => "Raw GSM Audio",
32                 mime => "audio/x-gsm",
33                 pref => 3
34         }
35 );
36
37 $astpath = "/_asterisk";
38
39 $stdcontainerstart = "<table align=center width=600><tr><td>\n";
40 $footer = "<hr><font size=-1><a href=\"http://www.asterisk.org\">The Asterisk Open Source PBX</a> Copyright 2002, <a href=\"http://www.digium.com\">Digium, Inc.</a></a>";
41 $stdcontainerend = "</td></tr><tr><td align=right>$footer</td></tr></table>\n";
42
43 sub login_screen() {
44         print header;
45         my ($message) = @_;
46         print <<_EOH;
47
48 <TITLE>Asterisk Web-Voicemail</TITLE>
49 <BODY BGCOLOR="white">
50 $stdcontainerstart
51 <FORM METHOD="post">
52 <input type=hidden name="action" value="login">
53 <table align=center>
54 <tr><td valign=top align=center rowspan=6><img align=center src="$astpath/animlogo.gif"></td></tr>
55 <tr><td align=center colspan=2><font size=+2>Commedian Mail Login</font></td></tr>
56 <tr><td align=center colspan=2><font size=+1>$message</font></td></tr>
57 <tr><td>Mailbox:</td><td><input type=text name="mailbox"></td></tr>
58 <tr><td>Password:</td><td><input type=password name="password"></td></tr>
59 <tr><td align=right colspan=2><input value="Login" type=submit></td></tr>
60 </table>
61 </FORM>
62 $stdcontainerend
63 </BODY>\n
64 _EOH
65
66 }
67
68 sub check_login()
69 {
70         my $mbox = param('mailbox');
71         my $pass = param('password');
72         my $category = "general";
73         my @fields;
74         open(VMAIL, "</etc/asterisk/voicemail.conf") || die("Bleh, no voicemail.conf");
75         while(<VMAIL>) {
76                 chomp;
77                 if (/\[(.*)\]/) {
78                         $category = $1;
79                 } elsif ($category ne "general") {
80                         if (/([^\s]+)\s*\=\>?\s*(.*)/) {
81                                 @fields = split(/\,\s*/, $2);
82                                 if (($mbox eq $1) && ($pass eq $fields[0])) {
83                                         return $fields[1] ? $fields[1] : "Extension $mbox";
84                                 }
85                         }
86                 }
87         }
88 }
89
90 sub validmailbox()
91 {
92         my ($mbox) = @_;
93         my $category = "general";
94         my @fields;
95         open(VMAIL, "</etc/asterisk/voicemail.conf") || die("Bleh, no voicemail.conf");
96         while(<VMAIL>) {
97                 chomp;
98                 if (/\[(.*)\]/) {
99                         $category = $1;
100                 } elsif ($category ne "general") {
101                         if (/([^\s]+)\s*\=\>?\s*(.*)/) {
102                                 @fields = split(/\,\s*/, $2);
103                                 if ($mbox eq $1) {
104                                         return $fields[2] ? $fields[2] : "unknown";
105                                 }
106                         }
107                 }
108         }
109 }
110
111 sub mailbox_list()
112 {
113         my ($name, $current) = @_;
114         my $tmp;
115         my $text;
116         $tmp = "<SELECT name=\"$name\">\n";
117         open(VMAIL, "</etc/asterisk/voicemail.conf") || die("Bleh, no voicemail.conf");
118         while(<VMAIL>) {
119                 chomp;
120                 s/\;.*$//;
121                 if (/\[(.*)\]/) {
122                         $category = $1;
123                 } elsif ($category ne "general") {
124                         if (/([^\s]+)\s*\=\>?\s*(.*)/) {
125                                 @fields = split(/\,\s*/, $2);
126                                 $text = "$1";
127                                 if ($fields[2]) {
128                                         $text .= " ($fields[1])";
129                                 }
130                                 if ($1 eq $current) {
131                                         $tmp .= "<OPTION SELECTED>$text</OPTION>\n";
132                                 } else {
133                                         $tmp .= "<OPTION>$text</OPTION>\n";
134                                 }
135                                 
136                                 if (($mbox eq $1) && ($pass eq $fields[0])) {
137                                         return $fields[1];
138                                 }
139                         }
140                 }
141         }
142         $tmp .= "</SELECT>\n";
143         
144 }
145
146 sub msgcount() 
147 {
148         my ($mailbox, $folder) = @_;
149         my $path = "/var/spool/asterisk/vm/$mailbox/$folder";
150         if (opendir(DIR, $path)) {
151                 my @msgs = grep(/^msg....\.txt$/, readdir(DIR));
152                 closedir(DIR);
153                 return sprintf "%d", $#msgs + 1;
154         }
155         return "0";
156 }
157
158 sub msgcountstr()
159 {
160         my ($mailbox, $folder) = @_;
161         my $count = &msgcount($mailbox, $folder);
162         if ($count > 1) {
163                 "$count messages";
164         } elsif ($count > 0) {
165                 "$count message";
166         } else {
167                 "no messages";
168         }
169 }
170 sub messages()
171 {
172         my ($mailbox, $folder) = @_;
173         my $path = "/var/spool/asterisk/vm/$mailbox/$folder";
174         if (opendir(DIR, $path)) {
175                 my @msgs = sort grep(/^msg....\.txt$/, readdir(DIR));
176                 closedir(DIR);
177                 return map { s/^msg(....)\.txt$/$1/; $_ } @msgs;
178         }
179         return ();
180 }
181
182 sub getcookie()
183 {
184         my ($var) = @_;
185         cookie($var);
186 }
187
188 sub makecookie()
189 {
190         my ($format) = @_;
191         cookie(-name => "format", -value =>["$format"]);
192 }
193
194 sub getfields()
195 {
196         my ($mailbox, $folder, $msg) = @_;
197         my $fields;
198         if (open(MSG, "</var/spool/asterisk/vm/$mailbox/$folder/msg${msg}.txt")) {
199                 while(<MSG>) {
200                         s/\#.*$//g;
201                         if (/^(\w+)\s*\=\s*(.*)$/) {
202                                 $fields->{$1} = $2;
203                         }
204                 }
205                 close(MSG);
206                 $fields->{'msgid'} = $msg;
207         } else { print "<BR>Unable to open '$msg' in '$mailbox', '$folder'\n<B>"; }
208         $fields;
209 }
210
211 sub message_prefs()
212 {
213         my ($nextaction, $msgid) = @_;
214         my $folder = param('folder');
215         my $mbox = param('mailbox');
216         my $passwd = param('password');
217         my $format = param('format');
218         if (!$format) {
219                 $format = &getcookie('format');
220         }
221         print header;
222         print <<_EOH;
223
224 <TITLE>Asterisk Web-Voicemail: Preferences</TITLE>
225 <BODY BGCOLOR="white">
226 $stdcontainerstart
227 <FORM METHOD="post">
228 <table width=100% align=center>
229 <tr><td align=right colspan=3><font size=+2>Web Voicemail Preferences</font></td></tr>
230 <tr><td align=left><font size=+1>Preferred&nbsp;Audio&nbsp;Format:</font></td><td colspan=2></td></tr>
231 _EOH
232
233 foreach $fmt (sort { $formats{$a}->{'pref'} <=> $formats{$b}->{'pref'} } keys %formats) {
234         my $clicked = "checked" if $fmt eq $format;
235         print "<tr><td></td><td align=left><input type=radio name=\"format\" $clicked value=\"$fmt\"></td><td width=100%>&nbsp;$formats{$fmt}->{name}</td></tr>\n";
236 }
237
238 print <<_EOH;
239 <tr><td align=right colspan=3><input type=submit value="save settings..."></td></tr>
240 </table>
241 <input type=hidden name="action" value="$nextaction">
242 <input type=hidden name="folder" value="$folder">
243 <input type=hidden name="mailbox" value="$mbox">
244 <input type=hidden name="password" value="$passwd">
245 <input type=hidden name="msgid" value="$msgid">
246 $stdcontainerend
247 </BODY>\n
248 _EOH
249
250 }
251
252 sub message_play()
253 {
254         my ($message, $msgid) = @_;
255         my $folder = param('folder');
256         my $mbox = param('mailbox');
257         my $passwd = param('password');
258         my $format = param('format');
259         my $fields;
260         my $folders = &folder_list('newfolder', $mbox, $folder);
261         my $mailboxes = &mailbox_list('forwardto', $mbox);
262         if (!$format) {
263                 $format = &getcookie('format');
264         }
265         if (!$format) {
266                 &message_prefs("play", $msgid);
267         } else {
268                 print header(-cookie => &makecookie($format));
269                 $fields = &getfields($mbox, $folder, $msgid);
270                 if (!$fields) {
271                         print "<BR>Bah!\n";
272                         return;
273                 }
274                 my $duration = $fields->{'duration'};
275                 if ($duration) {
276                         $duration = sprintf "%d:%02d", $duration/60, $duration % 60; 
277                 } else {
278                         $duration = "<i>Unknown</i>";
279                 }
280                 print <<_EOH;
281         
282 <TITLE>Asterisk Web-Voicemail: $folder Message $msgid</TITLE>
283 <BODY BGCOLOR="white">
284 $stdcontainerstart
285 <FORM METHOD="post">
286 <table width=100% align=center>
287 <tr><td align=right colspan=3><font size=+1>$folder Message $msgid</font></td></tr>
288 _EOH
289
290                 print <<_EOH;
291 <tr><td align=center colspan=3>
292 <table>
293         <tr><td colspan=2 align=center><font size=+1>$folder <b>$msgid</b></font></td></tr>
294         <tr><td><b>Message:</b></td><td>$msgid</td></tr>\n
295         <tr><td><b>Mailbox:</b></td><td>$mbox</td></tr>\n
296         <tr><td><b>Folder:</b></td><td>$folder</td></tr>\n
297         <tr><td><b>From:</b></td><td>$fields->{callerid}</td></tr>\n
298         <tr><td><b>Duration:</b></td><td>$duration</td></tr>\n
299         <tr><td><b>Original Date:</b></td><td>$fields->{origdate}</td></tr>\n
300         <tr><td><b>Original Mailbox:</b></td><td>$fields->{origmailbox}</td></tr>\n
301         <tr><td><b>Caller Channel:</b></td><td>$fields->{callerchan}</td></tr>\n
302         <tr><td align=center colspan=2>
303         <input name="action" type=submit value="index">&nbsp;
304         <input name="action" type=submit value="delete ">&nbsp;
305         <input name="action" type=submit value="forward to -> ">&nbsp;
306         $mailboxes&nbsp;
307         <input name="action" type=submit value="save to ->">
308         $folders&nbsp;
309         <input name="action" type=submit value="play ">
310         <input name="action" type=submit value="download">
311 </td></tr>
312 <tr><td colspan=2 align=center>
313 <embed width=400 height=40 src="vmail.cgi?action=audio&folder=$folder&mailbox=$mbox&password=$passwd&msgid=$msgid&format=$format&dontcasheme=$$.$format" autostart=yes loop=false></embed>
314 </td></tr></table>
315 </td></tr>
316 </table>
317 <input type=hidden name="folder" value="$folder">
318 <input type=hidden name="mailbox" value="$mbox">
319 <input type=hidden name="password" value="$passwd">
320 <input type=hidden name="msgid" value="$msgid">
321 $stdcontainerend
322 </BODY>\n
323 _EOH
324         }
325 }
326
327 sub message_audio()
328 {
329         my ($forcedownload) = @_;
330         my $folder = param('folder');
331         my $msgid = param('msgid');
332         my $mailbox = param('mailbox');
333         my $format = param('format');
334         if (!$format) {
335                 $format = &getcookie('format');
336         }
337         my $path = "/var/spool/asterisk/vm/$mailbox/$folder/msg${msgid}.$format";
338
339         $msgid =~ /^\d\d\d\d$/ || die("Msgid Liar ($msgid)!");
340         grep(/^${format}$/, keys %formats) || die("Format Liar ($format)!");
341
342         # Mailbox and folder are already verified
343         if (open(AUDIO, "<$path")) {
344                 $size = -s $path;
345                 $|=1;
346                 if ($forcedownload) {
347                         print header(-type=>$formats{$format}->{'mime'}, -Content_length => $size, -attachment => "msg${msgid}.$format");
348                 } else {                
349                         print header(-type=>$formats{$format}->{'mime'}, -Content_length => $size);
350                 }
351                 
352                 while(($amt = sysread(AUDIO, $data, 4096)) > 0) {
353                         syswrite(STDOUT, $data, $amt);
354                 }
355                 close(AUDIO);
356         } else {
357                 die("Hrm, can't seem to open $path\n");
358         }
359 }
360
361 sub message_index() 
362 {
363         my ($folder, $message) = @_;
364         my $mbox = param('mailbox');
365         my $passwd = param('password');
366         my $message2;
367         my $msgcount;   
368         my $hasmsg;
369         my $newmessages, $oldmessages;
370         my $format = param('format');
371         if (!$format) {
372                 $format = &getcookie('format');
373         }
374         if ($folder) {
375                 $msgcount = &msgcountstr($mbox, $folder);
376                 $message2 = "&nbsp;&nbsp;&nbsp;Folder '$folder' has " . &msgcountstr($mbox, $folder);
377         } else {
378                 $newmessages = &msgcount($mbox, "INBOX");
379                 $oldmessages = &msgcount($mbox, "Old");
380                 if (($newmessages > 0) || ($oldmessages < 1)) {
381                         $folder = "INBOX";
382                 } else {
383                         $folder = "Old";
384                 }
385                 $message2 = "You have";
386                 if ($newmessages > 0) {
387                         $message2 .= " <b>$newmessages</b> NEW";
388                         if ($oldmessages > 0) {
389                                 $message2 .= "and <b>$oldmessages</b> OLD";
390                                 if ($oldmessages != 1) {
391                                         $message2 .= " messages.";
392                                 } else {
393                                         $message2 .= "message.";
394                                 }
395                         } else {
396                                 if ($newmessages != 1) {
397                                         $message2 .= " messages.";
398                                 } else {
399                                         $message2 .= " message.";
400                                 }
401                         }
402                 } else {
403                         if ($oldmessages > 0) {
404                                 $message2 .= " <b>$oldmessages</b> OLD";
405                                 if ($oldmessages != 1) {
406                                         $message2 .= " messages.";
407                                 } else {
408                                         $message2 .= " message.";
409                                 }
410                         } else {
411                                 $message2 .= " <b>no</b> messages.";
412                         }
413                 }
414         }
415         
416         my $folders = &folder_list('newfolder', $mbox, $folder);
417         my $cfolders = &folder_list('changefolder', $mbox, $folder);
418         my $mailboxes = &mailbox_list('forwardto', $mbox);
419         print header(-cookie => &makecookie($format));
420         print <<_EOH;
421
422 <TITLE>Asterisk Web-Voicemail: $mbox $folder</TITLE>
423 <BODY BGCOLOR="white">
424 $stdcontainerstart
425 <FORM METHOD="post">
426 <table width=100% align=center>
427 <tr><td align=center colspan=2><font size=+2><I>$message</I></font></td></tr>
428 <tr><td align=right colspan=2><font size=+1><b>$folder</b> Messages</font> <input type=submit name="action" value="change to ->">$cfolders</td></tr>
429 <tr><td align=left colspan=2><font size=+1>$message2</font></td></tr>
430 </table>
431 <table width=100% align=center cellpadding=0 cellspacing=0>
432 _EOH
433
434 print "<tr><td>&nbsp;Msg</td><td>&nbsp;From</td><td>&nbsp;Duration</td><td>&nbsp;Date</td><td>&nbsp;</td></tr>\n";
435 print "<tr><td><hr></td><td><hr></td><td><hr></td><td><hr></td><td></td></tr>\n";
436 foreach $msg (&messages($mbox, $folder)) {
437
438         $fields = &getfields($mbox, $folder, $msg);
439         $duration = $fields->{'duration'};
440         if ($duration) {
441                 $duration = sprintf "%d:%02d", $duration / 60, $duration % 60;
442         } else {
443                 $duration = "<i>Unknown</i>";
444         }
445         $hasmsg++;
446         print "<tr><td><input type=checkbox name=\"msgselect\" value=\"$msg\">&nbsp;<b>$msg</b></td><td>$fields->{'callerid'}</td><td>$duration</td><td>$fields->{'origdate'}</td><td><input name='play$msg' alt=\"Play message $msg\" border=0 type=image align=left src=\"$astpath/play.gif\"></td></tr>\n";
447
448 }
449 if (!$hasmsg) {
450         print "<tr><td colspan=4 align=center><P><b><i>No messages</i></b><P></td></tr>";
451 }
452
453 print <<_EOH;
454 </table>
455 <table width=100% align=center>
456 <tr><td align=right colspan=2>
457         <input type="submit" name="action" value="refresh">&nbsp;
458 _EOH
459
460 if ($hasmsg) {
461 print <<_EOH;
462         <input type="submit" name="action" value="delete">&nbsp;
463         <input type="submit" name="action" value="save to ->">
464         $folders&nbsp;
465         <input type="submit" name="action" value="forward to ->">
466         $mailboxes
467 _EOH
468 }
469
470 print <<_EOH;
471 </td></tr>
472 <tr><td align=right colspan=2>
473         <input type="submit" name="action" value="preferences">
474         <input type="submit" name="action" value="logout">
475 </td></tr>
476 </table>
477 <input type=hidden name="folder" value="$folder">
478 <input type=hidden name="mailbox" value="$mbox">
479 <input type=hidden name="password" value="$passwd">
480 </FORM>
481 $stdcontainerend
482 </BODY>\n
483 _EOH
484 }
485
486 sub validfolder()
487 {
488         my ($folder) = @_;
489         return grep(/^$folder$/, @validfolders);
490 }
491
492 sub folder_list()
493 {
494         my ($name, $mbox, $selected) = @_;
495         my $f;
496         my $count;
497         my $tmp = "<SELECT name=\"$name\">\n";
498         foreach $f (@validfolders) {
499                 $count =  &msgcount($mbox, $f);
500                 if ($f eq $selected) {
501                         $tmp .= "<OPTION SELECTED>$f ($count)</OPTION>\n";
502                 } else {
503                         $tmp .= "<OPTION>$f ($count)</OPTION>\n";
504                 }
505         }
506         $tmp .= "</SELECT>";
507 }
508
509 sub message_rename()
510 {
511         my ($mbox, $oldfolder, $old, $newfolder, $new) = @_;
512         my $oldfile, $newfile;
513         return if ($old eq $new) && ($oldfolder eq $newfolder);
514         
515         if ($mbox =~ /^(\w+)$/) {
516                 $mbox = $1;
517         } else {
518                 die ("Invalid mailbox<BR>\n");
519         }
520         
521         if ($oldfolder =~ /^(\w+)$/) {
522                 $oldfolder = $1;
523         } else {
524                 die("Invalid old folder<BR>\n");
525         }
526         
527         if ($newfolder =~ /^(\w+)$/) {
528                 $newfolder = $1;
529         } else {
530                 die("Invalid new folder ($newfolder)<BR>\n");
531         }
532         
533         if ($old =~ /^(\d\d\d\d)$/) {
534                 $old = $1;
535         } else {
536                 die("Invalid old Message<BR>\n");
537         }
538         
539         if ($new =~ /^(\d\d\d\d)$/) {
540                 $new = $1;
541         } else {
542                 die("Invalid old Message<BR>\n");
543         }
544         
545         my $path = "/var/spool/asterisk/vm/$mbox/$newfolder";
546         mkdir $path, 0755;
547         my $path = "/var/spool/asterisk/vm/$mbox/$oldfolder";
548         opendir(DIR, $path) || die("Unable to open directory\n");
549         my @files = grep /^msg${old}\.\w+$/, readdir(DIR);
550         closedir(DIR);
551         foreach $oldfile (@files) {
552                 my $tmp = $oldfile;
553                 if ($tmp =~ /^(msg${old}.\w+)$/) {
554                         $tmp = $1;
555                         $oldfile = $path . "/$tmp";
556                         $tmp =~ s/msg${old}/msg${new}/;
557                         $newfile = "/var/spool/asterisk/vm/$mbox/$newfolder/$tmp";
558 #                       print "Renaming $oldfile to $newfile<BR>\n";
559                         rename($oldfile, $newfile);
560                 }
561         }
562 }
563
564 sub file_copy()
565 {
566         my ($orig, $new) = @_;
567         my $res;
568         my $data;
569         open(IN, "<$orig") || die("Unable to open '$orig'\n");
570         open(OUT, ">$new") || DIE("Unable to open '$new'\n");
571         while(($res = sysread(IN, $data, 4096)) > 0) {
572                 syswrite(OUT, $data, $res);
573         }
574         close(OUT);
575         close(IN);
576 }
577
578 sub message_copy()
579 {
580         my ($mbox, $oldfolder, $old, $newmbox, $new) = @_;
581         my $oldfile, $newfile;
582         return if ($mbox eq $newmbox);
583         
584         if ($mbox =~ /^(\w+)$/) {
585                 $mbox = $1;
586         } else {
587                 die ("Invalid mailbox<BR>\n");
588         }
589
590         if ($newmbox =~ /^(\w+)$/) {
591                 $newmbox = $1;
592         } else {
593                 die ("Invalid new mailbox<BR>\n");
594         }
595         
596         if ($oldfolder =~ /^(\w+)$/) {
597                 $oldfolder = $1;
598         } else {
599                 die("Invalid old folder<BR>\n");
600         }
601         
602         if ($old =~ /^(\d\d\d\d)$/) {
603                 $old = $1;
604         } else {
605                 die("Invalid old Message<BR>\n");
606         }
607         
608         if ($new =~ /^(\d\d\d\d)$/) {
609                 $new = $1;
610         } else {
611                 die("Invalid old Message<BR>\n");
612         }
613         
614         my $path = "/var/spool/asterisk/vm/$newmbox";
615         mkdir $path, 0755;
616         my $path = "/var/spool/asterisk/vm/$newmbox/INBOX";
617         mkdir $path, 0755;
618         my $path = "/var/spool/asterisk/vm/$mbox/$oldfolder";
619         opendir(DIR, $path) || die("Unable to open directory\n");
620         my @files = grep /^msg${old}\.\w+$/, readdir(DIR);
621         closedir(DIR);
622         foreach $oldfile (@files) {
623                 my $tmp = $oldfile;
624                 if ($tmp =~ /^(msg${old}.\w+)$/) {
625                         $tmp = $1;
626                         $oldfile = $path . "/$tmp";
627                         $tmp =~ s/msg${old}/msg${new}/;
628                         $newfile = "/var/spool/asterisk/vm/$newmbox/INBOX/$tmp";
629 #                       print "Copying $oldfile to $newfile<BR>\n";
630                         &file_copy($oldfile, $newfile);
631                 }
632         }
633 }
634
635 sub message_delete()
636 {
637         my ($mbox, $folder, $msg) = @_;
638         if ($mbox =~ /^(\w+)$/) {
639                 $mbox = $1;
640         } else {
641                 die ("Invalid mailbox<BR>\n");
642         }
643         if ($folder =~ /^(\w+)$/) {
644                 $folder = $1;
645         } else {
646                 die("Invalid folder<BR>\n");
647         }
648         if ($msg =~ /^(\d\d\d\d)$/) {
649                 $msg = $1;
650         } else {
651                 die("Invalid Message<BR>\n");
652         }
653         my $path = "/var/spool/asterisk/vm/$mbox/$folder";
654         opendir(DIR, $path) || die("Unable to open directory\n");
655         my @files = grep /^msg${msg}\.\w+$/, readdir(DIR);
656         closedir(DIR);
657         foreach $oldfile (@files) {
658                 if ($oldfile =~ /^(msg${msg}.\w+)$/) {
659                         $oldfile = $path . "/$1";
660 #                       print "Deleting $oldfile<BR>\n";
661                         unlink($oldfile);
662                 }
663         }
664 }
665
666 sub message_forward()
667 {
668         my ($toindex, @msgs) = @_;
669         my $folder = param('folder');
670         my $mbox = param('mailbox');
671         my $newmbox = param('forwardto');
672         my $msg;
673         my $msgcount;
674         $newmbox =~ s/(\w+)(\s+.*)?$/$1/;
675         if (!&validmailbox($newmbox)) {
676                 die("Bah! Not a valid mailbox '$newmbox'\n");
677                 return "";
678         }
679         $msgcount = &msgcount($newmbox, "INBOX");
680         my $txt;
681         if ($newmbox ne $mbox) {
682 #               print header;
683                 foreach $msg (@msgs) {
684 #                       print "Forwarding $msg from $mbox to $newmbox<BR>\n";
685                         &message_copy($mbox, $folder, $msg, $newmbox, sprintf "%04d", $msgcount);
686                         $msgcount++;
687                 }
688                 $txt = "Forwarded messages " . join(', ', @msgs) . "to $newmbox";
689         } else {
690                 $txt = "Can't forward messages to yourself!\n";
691         } 
692         if ($toindex) {
693                 &message_index($folder, $txt);
694         } else {
695                 &message_play($txt, $msgs[0]);
696         }
697 }
698
699 sub message_delete_or_move()
700 {
701         my ($toindex, $del, @msgs) = @_;
702         my $txt;
703         my $path;
704         my $y, $x;
705         my $folder = param('folder');
706         my $newfolder = param('newfolder') unless $del;
707         $newfolder =~ s/^(\w+)\s+.*$/$1/;
708         my $mbox = param('mailbox');
709         my $passwd = param('password');
710         my $msgcount = &msgcount($mbox, $folder);
711         my $omsgcount = &msgcount($mbox, $newfolder) if $newfolder;
712 #       print header;
713         if ($newfolder ne $folder) {
714                 $y = 0;
715                 for ($x=0;$x<$msgcount;$x++) {
716                         my $msg = sprintf "%04d", $x;
717                         my $newmsg = sprintf "%04d", $y;
718                         if (grep(/^$msg$/, @msgs)) {
719                                 if ($newfolder) {
720                                         &message_rename($mbox, $folder, $msg, $newfolder, sprintf "%04d", $omsgcount);
721                                         $omsgcount++;
722                                 } else {
723                                         &message_delete($mbox, $folder, $msg);
724                                 }
725                         } else {
726                                 &message_rename($mbox, $folder, $msg, $folder, $newmsg);
727                                 $y++;
728                         }
729                 }
730                 if ($del) {
731                         $txt = "Deleted messages "  . join (', ', @msgs);
732                 } else {
733                         $txt = "Moved messages "  . join (', ', @msgs) . " to $newfolder";
734                 }
735         } else {
736                 $txt = "Can't move a message to the same folder they're in already";
737         }
738         # Not as many messages now
739         $msgcount--;
740         if ($toindex || ($msgs[0] >= $msgcount)) {
741                 &message_index($folder, $txt);  
742         } else {
743                 &message_play($txt, $msgs[0]);
744         }
745 }
746
747 if (param()) {
748         my $folder = param('folder');
749         my $changefolder = param('changefolder');
750         $changefolder =~ s/(\w+)\s+.*$/$1/;
751         
752         my $newfolder = param('newfolder');
753         $newfolder =~ s/^(\w+)\s+.*$/$1/;
754         if ($newfolder && !&validfolder($newfolder)) {
755                 print header;
756                 die("Bah! new folder '$newfolder' isn't a folder.");
757         }
758         $action = param('action');
759         $msgid = param('msgid');
760         if (!$action) {
761                 my ($tmp) = grep /^play\d\d\d\d\.x$/, param;
762                 if ($tmp =~ /^play(\d\d\d\d)/) {
763                         $msgid = $1;
764                         $action = "play";
765                 } else {
766                         print header;
767                         print "No message?<BR>\n";
768                         return;
769                 }
770         }
771         @msgs = param('msgselect');
772         @msgs = ($msgid) unless @msgs;
773         {
774                 $mailbox = check_login();
775                 if ($mailbox) {
776                         if ($action eq 'login') {
777                                 &message_index($folder, "Welcome, $mailbox");
778                         } elsif (($action eq 'refresh') || ($action eq 'index')) {
779                                 &message_index($folder, "Welcome, $mailbox");
780                         } elsif ($action eq 'change to ->') {
781                                 if (&validfolder($changefolder)) {
782                                         $folder = $changefolder;
783                                         &message_index($folder, "Welcome, $mailbox");
784                                 } else {
785                                         die("Bah!  Not a valid change to folder '$changefolder'\n");
786                                 }
787                         } elsif ($action eq 'play') {
788                                 &message_play("$mailbox $folder $msgid", $msgid);
789                         } elsif ($action eq 'preferences') {
790                                 &message_prefs("refresh", $msgid);
791                         } elsif ($action eq 'download') {
792                                 &message_audio(1);
793                         } elsif ($action eq 'play ') {
794                                 &message_audio(0);
795                         } elsif ($action eq 'audio') {
796                                 &message_audio(0);
797                         } elsif ($action eq 'delete') {
798                                 &message_delete_or_move(1, 1, @msgs);
799                         } elsif ($action eq 'delete ') {
800                                 &message_delete_or_move(0, 1, @msgs);
801                         } elsif ($action eq 'forward to ->') {
802                                 &message_forward(1, @msgs);
803                         } elsif ($action eq 'forward to -> ') {
804                                 &message_forward(0, @msgs);
805                         } elsif ($action eq 'save to ->') {
806                                 &message_delete_or_move(1, 0, @msgs);
807                         } elsif ($action eq 'save to -> ') {
808                                 &message_delete_or_move(0, 0, @msgs);
809                         } elsif ($action eq 'logout') {
810                                 &login_screen("Logged out!\n");
811                         }
812                 } else {
813                         sleep(1);
814                         &login_screen("Login Incorrect!\n");
815                 }
816         }
817 } else {
818         &login_screen("\&nbsp;");
819 }