"; } # quoted_decode(text) sub quoted_decode { local $t = $_[0]; $t =~ s/=\n//g; $t =~ s/=(\S\S)/pack("c",hex($1))/ge; return $t; } # quoted_encode(text) sub quoted_encode { local $t = $_[0]; $t =~ s/([=\177-\377])/sprintf("=%2.2X",ord($1))/ge; return $t; } sub decode_mimewords { my $encstr = shift; my %params = @_; my @tokens; $@ = ''; ### error-return ### Collapse boundaries between adjacent encoded words: $encstr =~ s{(\?\=)\r?\n[ \t](\=\?)}{$1$2}gs; pos($encstr) = 0; ### print STDOUT "ENC = [", $encstr, "]\n"; ### Decode: my ($charset, $encoding, $enc, $dec); while (1) { last if (pos($encstr) >= length($encstr)); my $pos = pos($encstr); ### save it ### Case 1: are we looking at "=?..?..?="? if ($encstr =~ m{\G # from where we left off.. =\?([^?]*) # "=?" + charset + \?([bq]) # "?" + encoding + \?([^?]+) # "?" + data maybe with spcs + \?= # "?=" }xgi) { ($charset, $encoding, $enc) = ($1, lc($2), $3); $dec = (($encoding eq 'q') ? _decode_Q($enc) : _decode_B($enc)); push @tokens, [$dec, $charset]; next; } ### Case 2: are we looking at a bad "=?..." prefix? ### We need this to detect problems for case 3, which stops at "=?": pos($encstr) = $pos; # reset the pointer. if ($encstr =~ m{\G=\?}xg) { $@ .= qq|unterminated "=?..?..?=" in "$encstr" (pos $pos)\n|; push @tokens, ['=?']; next; } ### Case 3: are we looking at ordinary text? pos($encstr) = $pos; # reset the pointer. if ($encstr =~ m{\G # from where we left off... ([\x00-\xFF]*? # shortest possible string, \n*) # followed by 0 or more NLs, (?=(\Z|=\?)) # terminated by "=?" or EOS }xg) { length($1) or die "MIME::Words: internal logic err: empty token\n"; push @tokens, [$1]; next; } ### Case 4: bug! die "MIME::Words: unexpected case:\n($encstr) pos $pos\n\t". "Please alert developer.\n"; } return join('',map {$_->[0]} @tokens); } # _decode_Q STRING # Private: used by _decode_header() to decode "Q" encoding, which is # almost, but not exactly, quoted-printable. :-P sub _decode_Q { my $str = shift; $str =~ s/_/\x20/g; # RFC-1522, Q rule 2 $str =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; # RFC-1522, Q rule 1 $str; } # _decode_B STRING # Private: used by _decode_header() to decode "B" encoding. sub _decode_B { my $str = shift; &decode_base64($str); } # user_mail_file(user|file, [other details]) sub user_mail_file { if ($_[0] =~ /^\//) { return $_[0]; } elsif ($config{'mail_dir'}) { return &mail_file_style($_[0], $config{'mail_dir'}, $config{'mail_style'}); } elsif (@_ > 1) { return "$_[7]/$config{'mail_file'}"; } else { local @u = getpwnam($_[0]); return "$u[7]/$config{'mail_file'}"; } } # mail_file_style(user, basedir, style) sub mail_file_style { if ($_[2] == 0) { return "$_[1]/$_[0]"; } elsif ($_[2] == 1) { return $_[1]."/".substr($_[0], 0, 1)."/".$_[0]; } elsif ($_[2] == 2) { return $_[1]."/".substr($_[0], 0, 1)."/". substr($_[0], 0, 2)."/".$_[0]; } else { return $_[1]."/".substr($_[0], 0, 1)."/". substr($_[0], 1, 1)."/".$_[0]; } } # user_index_file(user|file) sub user_index_file { local $f = $_[0] =~ /^\/.*\/([^\/]+)$/ ? ($user_module_config_directory ? "$user_module_config_directory/$1.findex" : "$module_config_directory/$1.findex") : $user_module_config_directory ? "$user_module_config_directory/$_[0].index" : "$module_config_directory/$_[0].index"; local $hn = &get_system_hostname(); return -r $f && !-r "$f.$hn" ? $f : "$f.$hn"; } # extract_mail(data) # Converts the text of a message into mail object. sub extract_mail { local ($amail, @aheaders, $i); local @alines = split(/\n/, $_[0]); while($i < @alines && $alines[$i]) { if ($alines[$i] =~ /^(\S+):\s*(.*)/) { push(@aheaders, [ $1, $2 ]); } elsif ($alines[$i] =~ /^(\s+.*)/) { $aheaders[$#aheaders]->[1] .= $1; } $i++; } $amail->{'headers'} = \@aheaders; foreach $h (@aheaders) { $amail->{'header'}->{lc($h->[0])} = $h->[1]; } splice(@alines, 0, $i); $amail->{'body'} = join("\n", @alines)."\n"; return $amail; } # split_addresses(string) # Splits a comma-separated list of addresses into [ email, real-name, original ] # triplets sub split_addresses { local (@rv, $str = $_[0]); while(1) { if ($str =~ /^[\s,]*(([^<>\(\)\s]+)\s+\(([^\(\)]+)\))(.*)$/) { push(@rv, [ $2, $3, $1 ]); $str = $4; } elsif ($str =~ /^[\s,]*("([^"]+)"\s*<([^\s<>,]+)>)(.*)$/ || $str =~ /^[\s,]*(([^<>]+)\s+<([^\s<>,]+)>)(.*)$/ || $str =~ /^[\s,]*(([^<>\[\]]+)\s+\[mailto:([^\s\[\]]+)\])(.*)$/|| $str =~ /^[\s,]*(()<([^\s<>,]+)>)(.*)/ || $str =~ /^[\s,]*(()([^\s<>,]+))(.*)/) { push(@rv, [ $3, $2, $1 ]); $str = $4; } else { last; } } return @rv; } $match_ascii = '\x1b\([BHJ]([\t\x20-\x7e]*)'; $match_jis = '\x1b\$[@B](([\x21-\x7e]{2})*)'; sub eucconv { local($_) = @_; if ($current_lang eq 'ja_JP.euc') { s/$match_jis/&j2e($1)/geo; s/$match_ascii/$1/go; } $_; } sub j2e { local($_) = @_; tr/\x21-\x7e/\xa1-\xfe/; $_; } # list_maildir(file, [start], [end]) # Returns a subset of mail from a maildir format directory sub list_maildir { local (@rv, $i, $f, @files); foreach $d ("$_[0]/cur", "$_[0]/new") { opendir(DIR, $d); while($f = readdir(DIR)) { push(@files, "$d/$f") if ($f !~ /^\./); } closedir(DIR); } @files = sort { $a =~ /([^\/]+)$/; local $an = $1; $b =~ /([^\/]+)$/; local $bn = $1; $an cmp $bn } @files; local ($start, $end); if (!defined($_[1])) { $start = 0; $end = @files - 1; } elsif ($_[2] < 0) { $start = @files + $_[2] - 1; $end = @files + $_[1] - 1; $start = 0 if ($start < 0); } else { $start = $_[1]; $end = $_[2]; $end = @files-1 if ($end >= @files); } foreach $f (@files) { if ($i < $start || $i > $end) { # Skip files outside requested index range push(@rv, undef); $i++; next; } local $mail = &read_mail_file($f); $mail->{'idx'} = $i++; push(@rv, $mail); } return @rv; } # search_maildir(file, field, what) # Search for messages in a maildir directory, and return the result sub search_maildir { local @rv; local $field = $_[1]; local $neg = ($field =~ s/^\!//); foreach $mail (&list_maildir($_[0])) { if ($field eq 'body') { push(@rv, $mail) if (!$neg && $mail->{'body'} =~ /\Q$_[2]\E/i || $neg && $mail->{'body'} !~ /\Q$_[2]\E/i); } elsif ($field eq 'size') { push(@rv, $mail) if (!$neg && $mail->{'size'} > $_[2] || $neg && $mail->{'size'} < $_[2]); } else { push(@rv, $mail) if (!$neg && $mail->{'header'}->{$field} =~ /\Q$_[2]\E/i || $neg && $mail->{'header'}->{$field} !~ /\Q$_[2]\E/i); } } return @rv; } # delete_maildir(&mail, ...) # Delete messages from a maildir directory sub delete_maildir { local $m; foreach $m (@_) { unlink($m->{'file'}); } } # modify_maildir(&oldmail, &newmail, textonly) # Replaces a message in a maildir directory sub modify_maildir { unlink($_[0]->{'file'}); &send_mail($_[1], $_[0]->{'file'}, $_[2]); } # list_mhdir(file, [start], [end]) # Returns a subset of mail from an MH format directory sub list_mhdir { local ($start, $end, $f, $i, @rv); opendir(DIR, $_[0]); local @files = map { "$_[0]/$_" } sort { $a <=> $b } grep { /^\d+$/ } readdir(DIR); closedir(DIR); if (!defined($_[1])) { $start = 0; $end = @files - 1; } elsif ($_[2] < 0) { $start = @files + $_[2] - 1; $end = @files + $_[1] - 1; $start = 0 if ($start < 0); } else { $start = $_[1]; $end = $_[2]; $end = @files-1 if ($end >= @files); } foreach $f (@files) { if ($i < $start || $i > $end) { # Skip files outside requested index range push(@rv, undef); $i++; next; } local $mail = &read_mail_file($f); $mail->{'idx'} = $i++; push(@rv, $mail); } return @rv; } # search_mhdir(file, field, what) # Search for messages in an MH directory, and return the result sub search_mhdir { local @rv; local $field = $_[1]; local $neg = ($field =~ s/^\!//); foreach $mail (&list_mhdir($_[0])) { if ($field eq 'body') { push(@rv, $mail) if (!$neg && $mail->{'body'} =~ /\Q$_[2]\E/i || $neg && $mail->{'body'} !~ /\Q$_[2]\E/i); } elsif ($field eq 'size') { push(@rv, $mail) if (!$neg && $mail->{'size'} > $_[2] || $neg && $mail->{'size'} < $_[2]); } else { push(@rv, $mail) if (!$neg && $mail->{'header'}->{$field} =~ /\Q$_[2]\E/i || $neg && $mail->{'header'}->{$field} !~ /\Q$_[2]\E/i); } } return @rv; } # delete_mhdir(&mail, ...) # Delete messages from an MH directory sub delete_mhdir { local $m; foreach $m (@_) { unlink($m->{'file'}); } } # modify_mhdir(&oldmail, &newmail, textonly) # Replaces a message in a maildir directory sub modify_mhdir { unlink($_[0]->{'file'}); &send_mail($_[1], $_[0]->{'file'}, $_[2]); } # max_mhdir(dir) # Returns the maximum message ID in the directory sub max_mhdir { local $max = 1; opendir(DIR, $_[0]); foreach $f (readdir(DIR)) { $max = $f if ($f =~ /^\d+$/ && $f > $max); } closedir(DIR); return $max; } # read_mail_file(file) # Read a single message from a file sub read_mail_file { local (@headers, $mail); $mail->{'file'} = $_[0]; # Read the headers open(MAIL, $_[0]); while(1) { local $line =
\n"; @folders = &list_folders(); if (!defined($in{'folder'}) && $userconfig{'default_folder'}) { ($df) = grep { $_->{'file'} eq $userconfig{'default_folder'} } @folders; $in{'folder'} = $df->{'index'} if ($df); } $folder = $folders[$in{'folder'}]; # Check if this is a pop3 inbox with no login set if ($folder->{'type'} == 2 && $folder->{'mode'} == 3 && !defined($folder->{'user'})) { print "\n"; print "
\n"; &footer("/", $text{'index'}); exit; } $sel = "\n"; # View mail from the most recent $perpage = $folder->{'perpage'} || $userconfig{'perpage'}; @mail = reverse(&mailbox_list_mails(-$in{'start'}, -$in{'start'}-$perpage+1, $folder, 1, \@error)); print "
\n"; print "
| \n"; print " |
| \n"; print " |
\n"; &footer("/", $text{'index'}); # show_buttons(number) sub show_buttons { print "
| \n"; print "\n"; print " | \n"; print "\n"; print "\n"; print " | \n"; if (@folders > 1) { print "\n"; print " | \n"; } print "\n"; } print " | \n"; print " |
\n";
}
print "",&text('view_desc', $in{'idx'}+1,
$folder->{'name'}),"\n";
if ($in{'idx'} < @mail-1) {
print "",
"
\n";
}
}
else {
print "$text{'view_sub'}\n";
}
print "\n"; print "\n"; dbmclose(%read); print "
\n"; local @sr = !@sub ? ( ) : ( "view_mail.cgi?idx=$in{'idx'}", $text{'view_return'} ), $s = int((@mail - $in{'idx'} - 1) / $userconfig{'perpage'}) * $userconfig{'perpage'}; &footer(@sub ? ( "view_mail.cgi?idx=$in{'idx'}&folder=$in{'folder'}", $text{'view_return'} ) : ( ), "index.cgi?folder=$in{'folder'}", $text{'mail_return'}); # show_buttons(pos) sub show_buttons { if ($folder->{'sent'} || $folder->{'drafts'}) { print "\n"; } else { print "\n"; print "\n"; } print "\n"; if (!$folder->{'sent'} && !$folder->{'drafts'}) { $m = $read{$mail->{'header'}->{'message-id'}}; print " \n"; print "\n"; print "\n"; } print " \n"; print "\n"; print " \n"; print "\n"; } # address_link(address) sub address_link { local @addrs = &split_addresses(&decode_mimewords($_[0])); local @rv; foreach $a (@addrs) { if ($inbook{$a->[0]}) { push(@rv, &html_escape($a->[2])); } else { push(@rv, "". &eucconv(&html_escape($a->[2])).""); } } return join(" , ", @rv); } mailbox/reply_mail.cgi 0100755 0005671 0000012 00000031571 07616347117 015041 0 ustar jcameron wheel #!/usr/local/bin/perl # Display a form for replying to or composing an email require './mailbox-lib.pl'; &ReadParse(); $module_index_link = "/$module_name/index.cgi?folder=$in{'folder'}"; if ($in{'new'}) { # Composing a new email &header($text{'compose_title'}, ""); $sig = &get_signature(); $quote = "\n\n$sig" if ($sig); } else { # Replying or forwarding @folders = &list_folders(); $folder = $folders[$in{'folder'}]; if ($in{'mailforward'} ne '') { @mailforward = split(/\0/, $in{'mailforward'}); @mails = &mailbox_list_mails( $mailforward[0], $mailforward[@mailforward-1], $folder); $mail = $mails[$mailforward[0]]; } else { @mails = &mailbox_list_mails($in{'idx'}, $in{'idx'}, $folder); $mail = $mails[$in{'idx'}]; } if ($in{'delete'}) { # Just delete the email if (!$in{'confirm'} && &need_delete_warn($folder)) { # Need to ask for confirmation before deleting &header($text{'confirm_title'}, ""); print "
\n"; print "