#!/usr/bin/perl $ID = q$Id: mdfrm,v 1.9 2007-07-09 02:07:14 eagle Exp $; # # mdfrm -- View a summary of e-mail in a qmail maildir. # # Copyright 1997, 1998, 2002, 2003 by Russ Allbery # # This program is free software; you may redistribute it and/or modify it # under the same terms as Perl itself. ############################################################################## # Site configuration ############################################################################## # The location of the user's incoming maildir. MAILDIR should always be # honored; the fallback location may be site-dependent. ($MAILDIR = $ENV{MAILDIR} || $ENV{HOME} . '/Maildir') =~ s%/+$%%; ############################################################################## # Modules and declarations ############################################################################## require 5.001; use strict; use vars qw($ID $MAILDIR); ############################################################################## # Reading maildir contents ############################################################################## # Reports a file access error. sub open_fail { die "$0: cannot open $_[0]: $!\n" } # Returns a reference to a sorted array of all messages in either the cur or # new directories of maildir. Since the files are named with timestamps, this # will give us a sorted listing by delivery time, which is what I want. sub contents { my ($maildir, $onlynew, $onlyunseen, $sort) = @_; my @files; unless ($onlynew) { opendir (D, "$maildir/cur") or open_fail "$maildir/cur"; @files = map { ["$maildir/cur/", $_] } grep { ! /^\./ } readdir D; @files = grep { $$_[1] !~ /.*:2,[^,:]*[sS][^,:]*$/ } @files if $onlyunseen; } opendir (D, "$maildir/new") or open_fail "$maildir/new"; push (@files, map { ["$maildir/new/", $_] } grep { ! /^\./ } readdir D); if ($sort) { @files = map { $$_[0] . $$_[1] } sort { $$a[1] cmp $$b[1] } @files; } else { @files = map { $$_[0] . $$_[1] } @files; } \@files; } # Undoes MIME quoted-printable word encoding. sub mime_decode { my $word = shift; $word =~ tr/_/\x20/; $word =~ s/=([0-9A-F]{2})/chr (hex $1)/ige; $word; } # Returns who a given message is from and what the subject of the message is # (as a two-element list). We do this by parsing out the From and Subject # headers of the message. If our second argument is true, also grab the # contents of the Date header of the article and convert it to seconds from # epoch, returning that as well. sub headers { my ($file, $need_date) = @_; open (MESSAGE, $file) or open_fail $file; my ($from, $subject, $date); local $_; while () { last if /^$/; if (/^From:\s/i) { s/^From:\s+//i; ($from) = /^(.*)\s+<\S+>/; ($from) = /^\S+\s+\((.*)\)/ unless $from; $from = $_ unless $from; $from =~ s/=\?iso-8859-15?\?q\?([^?]*)\?=/mime_decode $1/ige; $from =~ s/^\"//; $from =~ s/\"$//; $from =~ s/\s+$//; } elsif (/^Subject:\s/i) { (undef, $subject) = split (' ', $_, 2); chomp $subject; } elsif ($need_date && /^Date:\s/i) { (undef, $date) = split (' ', $_, 2); $date = Date::Parse::str2time ($date); } last if ($from && $subject && (!$need_date || $date)); } close MESSAGE; return ($from, $subject, $date); } # Stepping through a list of messages, read in the From and Subject (and maybe # the Date) and make a list of anonymous arrays containing that information. sub parse { my ($messages, $usedate) = @_; my @info; if ($usedate) { require Date::Parse } for (@$messages) { push (@info, [ headers ($_, $usedate) ]) } if ($usedate) { @info = sort { $$a[2] <=> $$b[2] } @info } \@info; } ############################################################################## # Main routine ############################################################################## # Used for heredocs to make them more readable. sub unquote { my ($string) = @_; $string =~ s/^: {0,7}//gm; $string } # Trim extraneous garbage from the path. my $fullpath = $0; $0 =~ s%^.*/%%; # Get command-line options. my ($count, $onlynew, $onlyunseen, $summary, $usedate); while (@ARGV && $ARGV[0] =~ /^-/) { $_ = shift; if (/^-.*v/) { my $version = join (' ', (split (' ', $ID))[1..3]); $version =~ s/,v\b//; $version =~ s/(\S+)$/($1)/; $version =~ tr%/%-%; print "$version\n"; exit; } elsif (/^-.*h/) { print unquote (<<"EOM"); : Usage: mdfrm [-hvcdnu] [] : : Presents a summary of mail present in . If isn't : provided on the command line, \$MAILDIR is used; if it isn't set, the : default is $MAILDIR. : : -h Display this message. : -v Display the version number of $0. : -c Display only a count of messages. : -s Display a summary of messages (the default behavior). : -d Sort mail by message date. : -n Display only new mail (default if invoked as nfrm). : -u Display only unseen messages. EOM exit; } if (/^-.*c/) { $count = 1 } if (/^-.*d/) { $usedate = 1 } if (/^-.*n/) { $onlynew = 1 } if (/^-.*s/) { $summary = 1 } if (/^-.*u/) { $onlyunseen = 1 } if (!/^-[cdnsu]+$/) { die "$0: unknown flag $_\n"; } } $onlynew ||= ($0 =~ /nfrm/); $summary = $summary || !$count; die "$0: only one maildir argument supported\n" if @ARGV > 1; my $maildir = $ARGV[0] || $MAILDIR; # Get the list of messages and write out the listing. my $messages = contents ($maildir, $onlynew, $onlyunseen, !$usedate); if ($count) { my $desc = 'message' . (@$messages != 1 ? 's' : ''); $desc .= " in $maildir" if @ARGV; $desc = "unread $desc" if $onlyunseen; $desc = "new $desc" if $onlynew; print scalar @$messages, ' ', $desc, "\n"; } if ($summary) { my $info = parse ($messages, $usedate); for (@$info) { write } } exit; ############################################################################## # Formats ############################################################################## format = @<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $$_[0], $$_[1] . __END__ ############################################################################## # Documentation ############################################################################## =head1 NAME mdfrm - List From and Subject of mail in a maildir =head1 SYNOPSIS mdfrm [B<-hvcdnsu>] [I] mdnfrm [B<-hvcds>] [I] =head1 REQUIREMENTS Only Perl 5.001 is required for basic functionality. If you want to use the B<-d> option, the Date::Parse module (part of the TimeDate distribution on CPAN) is also required. =head1 DESCRIPTION B prints the name from the From: header and the Subject: header of all mail stored in a given maildir sorted by arrival date. If no maildir is specified on the command line, mdfrm will default to the path in the environnment variable MAILDIR or to a default path of F<$HOME/Maildir> (configured at the top of this script). If invoked as B (or B), see the description of the option B<-n> below. Any From: headers encoded with RFC 2047 encoding, using quoted-printable, and with a character set of ISO 8859-1 or 8859-15 will be decoded before display and sent to the output as literal eight-bit characters. This program is no longer under active development. It has been replaced with B, which supports a much broader range of character sets and assumes a UTF-8 locale. =head1 OPTIONS =over 4 =item B<-c> Rather than displaying a summary of the messages, just print a single line giving the count of messages. This option works in conjunction with B<-n> and B<-u> in the expected ways. If you want to see both the count and the summary, also use B<-s>. =item B<-d> Sort the displayed summary by the Date: headers of the mail rather than by arrival date. Use of this flag requires the Date::Parse module be installed (part of TimeDate). (If you do not use this flag, you do not need that module.) =item B<-h> Show a usage summary. =item B<-n> Limit the summary to new (unread) messages (messages located in the new subdirectory of the maildir and excluding messages in the cur subdirectory). This option is the default if this program is invoked as B or B (or any other name containing "nfrm"). =item B<-s> Print a summary of messages. This is the default behavior; this option is only needed in combination with B<-c> if you want to see both the count of messages and the summary. =item B<-u> Only show messages which haven't been seen (read with a mail client). This uses the status flags in the info section of a message name (the part after C<:2,>). See L for more information on status flags. This option doesn't really make sense in combination with B<-n> since new messages by definition haven't been read and a mail client should move messages into the cur subdirectory when the user looks at them. =item B<-v> Show the program version. =back =head1 DIAGNOSTICS =over 4 =item cannot open %s B was unable to open the specified file or directory. This can happen if the specified maildir was incorrect, or if mail was being read while B was running and some of the messages were moved or deleted while it was retrieving Subject or From headers. =item only one maildir argument supported More than one maildir was specified on the command line. Currently, B can only summarize one maildir at a time. To summarize multiple maildirs, run B multiple times with different arguments. =item unknown flag %s An unknown command-line flag was passed to B. =back =head1 EXAMPLES Summarize all of the mail in MAILDIR (F<$HOME/Maildir> if MAILDIR isn't set): mdfrm Display only the new messages in the maildir Mail/incoming, sorted by the Date headers rather than by file name (arrival time): mdfrm -nd Display a count of unseen messages (in both the new and cur directories): mdfrm -cu Show the count and summary of unseen messages, sorted by date. mdfrm -csd If maildirs are used exclusively on your system, it may be a good idea to install B as B. =head1 ENVIRONMENT =over 4 =item MAILDIR The path to the maildir to summarize, used if no maildir is given on the command line. =back =head1 BUGS This program does not as yet do anything remotely reasonable with RFC 2047 encoded header lines. It attempts to decode the From header under some circumstances, assuming that the user is a Western European or American. This is not a reasonable assumption, and even that decoder doesn't correctly follow the RFC 2047 specification. The user should be able to specify which character sets to decode with a command-line option, RFC 2047 should be followed correctly, and base64 encoding should be handled correctly. Continuation lines are not handled in either Subject: or From:, even if the full header content would fit on a single line. =head1 SEE ALSO frm(1), maildir(5), mdfrm-utf8(1) The maildir format is documented at L. L will have the current version of this program and of B. =head1 AUTHOR Russ Allbery =head1 COPYRIGHT AND LICENSE Copyright 1997, 1998, 2002, 2003 by Russ Allbery This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 THANKS RFC 2047 decoding logic courtesy of Mikko HEnninen and Sverre H. Huseby. Support for nfrm (B<-n>) courtesy of VebjErn LjosE. Support for Date header sorting (B<-d>) inspired by the work of Matthew Mead. Documentation and usage message based on work by Sotiris Vassilopoulos. Implementation of B<-u>, B<-c>, and B<-s> from Russell Steinthal. =cut