#!/usr/bin/perl

##
## mewinc: mewls helper for local spool
##         [from imget]
##
## Author: Shun-ichi TAHARA <jado@flowernet.gr.jp>
## Time-stamp: <00/10/25 15:35:17 jado@sophia>
##

### Configuration variables:

### Local spool path:
$mailspool = '/var/spool/mail';
#$mailspool = '/usr/spool/mail';
#$mailspool = '/var/mail';
#$mailspool = '/usr/mail';

### Mail folders path:
## If you want to use mewinc alone, set this.
## You need not to be set while you use mewinc only from mewls, even if you set
##   mew-mail-path to be different from the default.
$mailfolder = undef;
#$mailfolder = "$ENV{HOME}/Mail";
#$mailfolder = (getpwuid($<))[7]."/Mail";

### Use Content-Length: header:
## Solaris 2.x (and so on) needs setting this to 1.
$obeycl = 0;

### Use flock() included in Perl:
## flock() function in Perl uses flock, fcntl or lockf syscall inside it.
## If your OS has flock/fcntl/lockf feature, and locking methods are same
##   between Perl and mail.local(and so on), set this to 1.
## Generally, you can use this safely if your OS has flock syscall, however,
##   fcntl may be used in perl and lockf in mail.local, if not (for example,
##   Solaris 2.x). In this case, you could not lock your mail spool with
##   flock() in Perl, so you must consider using lock file explained below.
$useflock = 1;

### Use lock file:
## If your OS doesn't have flock/fcntl/lockf feature, or file locking features
##   are different between Perl and mail.local(and so on), set this to 1.
## As documented above, Solaris 2.x (and so on) may need setting this to 1.
$uselockfile = 0;

### System call number of fsync():
## This may found on "SYS_fsync" macro in /usr/include/sys/syscall.h.
## If not found and your mail folders are over NFS, take care of file system
##   overflow!
$fsync_no = undef;
#$fsync_no = "118";	# Linux
#$fsync_no = "95";	# FreeBSD

### List From: header by default:
## If you want list From: header by default, set this to 1.
$listfrom = 0;

### List Subject: header by default:
## If you want list Subject: header by default, set this to 1.
$listsubj = 0;

### End of configuration variables.

require 5.003;

use Cwd;
use Fcntl;
use integer;

$folder = 'inbox';
$keep = 0;
$mbopt = 0;
$mailbox = '';
$mfopt = 0;

sub fsync ($) {
    my ($fno) = @_;

    if ($fsync_no and syscall($fsync_no, $fno) < 0) {
	return 0;
    }
    return 1;
}

sub LOCK_SH { 1 }
sub LOCK_EX { 2 }
sub LOCK_NB { 4 }
sub LOCK_UN { 8 }

$locked_by_file = 0;
$locked_by_flock = 0;

sub lockmbox ($) {
    my ($base) = @_;
    my ($retry);

    $retry = 0;
    $locked_by_file = 0;
    $locked_by_flock = 0;

    return 1 unless $useflock || $uselockfile;
    if ($useflock) {
	if (open(LOCK_FH, "+<$base") and flock(LOCK_FH, LOCK_EX | LOCK_NB)) {
	    $locked_by_flock = 1;
	}
    }
    if ($uselockfile) {
	open(LOCKFILE, ">$base.$$") or goto NEXT;
	binmode(LOCKFILE);
	print LOCKFILE "$$\n";
	close(LOCKFILE);
	while (!link("$base.$$", "$base.lock")) {
	    if ($retry >= 10) {
		unlink("$base.$$");
		goto NEXT;
	    }
	    $retry++;
	    sleep(5);
	}
	unlink("$base.$$");
	$locked_by_file = 1;
      NEXT:
    }
    return 0 unless $locked_by_flock || $locked_by_file;
    return 1;
}

sub unlockmbox ($) {
    my ($base) = @_;

    if ($locked_by_flock) {
	$locked_by_flock = 0;
	flock(LOCK_FH, LOCK_UN);
    }
    if ($locked_by_file) {
	$locked_by_file = 0;
	if (-f "$base.lock") {
	    unlink("$base.lock");
	}
    }
}

sub empty_mbox ($) {
    my ($mbox) = @_;
    local (*MBOX);

    unless (truncate($mbox, 0)) {
	unless (open(MBOX, ">$mbox")) {
	    print STDERR "Can't clear mailbox.\n";
	    return;
	}
	close(MBOX);
    }
}

sub message_number {
    my ($number, @files);
    local (*DIR);

    opendir(DIR, '.') or die "Can't open current directory, stopped";
    @files = sort {$a <=> $b} grep /^\d+$/, readdir(DIR);
    closedir(DIR);

    if (scalar(@files) == 0) {
	$number = 1;
    } else {
	$number = $files[$#files] + 1;
    }

    while (-e "$number" || -e ".$number.dir") {
	$number++;
    }
    return $number;
}

sub excl_create ($$) {
    my ($MESSAGE, $file) = @_;
    my ($attr);

    $attr = Fcntl::O_RDWR | Fcntl::O_CREAT | Fcntl::O_EXCL;
    umask(066);
    sysopen($MESSAGE, $file, $attr) or return 0;
    binmode($MESSAGE);
    return 1;
}

$msgnum = 0;

sub new_message ($) {
    my ($MESSAGE) = @_;
    my ($try);

    if ($msgnum == 0) {
	$msgnum = message_number;
    } else {
	$msgnum++;
    }
    $try = 3;
    while ($try--) {
	if (excl_create($MESSAGE, "$msgnum")) {
	    # created successfully
	    return "$msgnum";
	}
	$msgnum++;
    }
    # message creation failed
    return undef;
}

sub store_message ($) {
    my ($Msg) = @_;
    local (*ART);
    my ($file, $subj, $from, $nl);

    $file = new_message(\*ART);
    if ($file) {
	select (ART); $| = 1; select (STDOUT);
	foreach (@$Msg) {
	    print ART $_ or goto ERR1;
	    $from = $1 if (/^(From:.*)/);
	    $subj = $1 if (/^(Subject:.*)/);
	}
	fsync(fileno(ART)) or goto ERR1;
	close(ART) or goto ERR2;

	$nl = "\n";
	print "$file";
	if ($listfrom) {
	    print "\t$from\n";
	    $nl = undef;
	}
	if ($listsubj) {
	    print "\t$subj\n";
	    $nl = undef;
	}
	print $nl;

	return 1;

      ERR1:
	close(ART);
      ERR2:
	print STDERR "Writing to the file \"$file\" failed ($!).\n";
	unlink($file) if (-z $file);
	return 0;
    } else {
	print STDERR "Message can't be saved.\n";
	return 0;
    }
}

sub process_mbox ($) {
    my ($src) = @_;
    my ($format, $msgs, $length, $inheader, @Message);
    local (*MBOX);
    my ($first_line);

    if ($src) {
	open(MBOX, "<$src") or return -1;
    } else {
	*MBOX = *STDIN;
    }
    chomp($first_line = <MBOX>);
    if ($first_line =~ /^From /) {
	$format = 'UNIX';
    } elsif ($first_line =~ /^\001\001\001\001$/) {
	$format = 'MMDF';
    } elsif ($first_line =~ /^BABYL OPTIONS:/) {
	$format = 'RMAIL';
    } else {
	print STDERR "Invalid mbox format: $src\n";
	return -1;
    }
    $msgs = 0;
    while ($first_line ne '') {

	if ($msgs > 0 && $format eq 'MMDF') {
	    $first_line = <MBOX>;
	    last if $first_line !~ /^\001\001\001\001$/;
	}

	if ($format eq 'RMAIL') {
	    while (<MBOX>) {
		last if /^\*\*\* EOOH \*\*\*$/;
	    }
	}

	if ($format eq 'UNIX') {
	    # convert UNIX From_ into Return-Path
	    my ($rp);

	    $rp = $first_line;
	    $rp =~ s/^From +//;
	    $rp =~ s/ +[A-Z][a-z][a-z] [A-Z][a-z][a-z] [\d ]\d \d\d:\d\d.*//;
	    $rp = "<$rp>" if $rp !~ /^<.*>$/;
	    @Message = ("Return-Path: $rp\n");
	} else {
	    @Message = ();
	}

	$first_line = '';
	$inheader = 1;
	$length = -1;
	while (<MBOX>) {
	    if ($format eq 'MMDF' && /^\001\001\001\001$/) {
		$first_line = 'MMDF';
		last;
	    } elsif ($format eq 'UNIX' && $length <= 0
		     && /^From / && $Message[$#Message] eq "\n") {
		chomp($first_line = $_);
		last;
	    } elsif ($format eq 'RMAIL' && /^\x1f/ ) {
		chomp($first_line = <MBOX>);
		last;
	    } elsif ($inheader) {
		# XXX continuous line processing needed
		push @Message, $_;
		# for Solaris 2.x or ...
		# XXX option
		if ($obeycl && /^Content-Length:(.*)/i) {
		    chomp($length = $1);
		}
		$inheader = 0 if (/^\n$/);
	    } else {
		push @Message, $_;
		$length -= length($_) if $length > 0;
	    }
	}

	if ($Message[$#Message] eq "\n") {
	    pop @Message;
	}

	$msgs++ if ($#Message >= 0);

	unless (store_message(\@Message)) {
	    close(MBOX);
	    return -1;
	}
    }
    close(MBOX);
    print STDERR "$msgs message(s).\n";
    return $msgs;
}

sub getmsg ($$) {
    my ($src, $keep) = @_;
    my ($msgs);

    # set default
    unless ($src) {
	my ($user);

	$user = getlogin;
	if ($user eq '' || $user eq 'root') {
	    $user = (getpwuid($<))[0];
	}
	$src = "$mailspool/$user";
    }

    if ($src eq '-') {
	# STDIN
	if (($msgs = process_mbox('')) < 0) {
	    die "Can't get message from STDIN, stopped";
	}
	return $msgs;
    } elsif (-s $src) {
	# FILE and not ZERO
	unless (lockmbox($src)) {
	    unlockmbox($src);
	    die "Can't lock mailbox \"$src\", stopped";
	}
	if (($msgs = process_mbox($src)) < 0) {
	    unlockmbox($src);
	    die "Can't get message from mailbox \"$src\", stopped";
	}
	empty_mbox($src) unless ($keep);
	unlockmbox($src);
	return $msgs;
    } else {
	print STDERR "No messages in mailbox.\n";
	return 0;
    }
}

sub usage {
    print "Usage: mewinc [options] [+folder]\n";
    print "  options: -mailbox|-f mboxfile|-\n";
    print "           -mailfolder|-d folderpath\n";
    print "           -keep|-k\n";
    print "           -listfrom|-lf / -nofrom|-nf\n";
    print "           -listsubject|-ls / -nosubject|-ns\n";
    exit(0);
}

foreach (@ARGV) {
    if ($mbopt) {
	$mbopt = 0;
	$mailbox = $_;
    } elsif ($mfopt) {
	$mfopt = 0;
	$mailfolder = $_;
    } elsif (/^-(ignorecl|c-)$/) {
	$obeycl = 0;
    } elsif (/^-(obeycl|c\+)$/) {
	$obeycl = 1;
    } elsif (/^-(noflock|s-)$/) {
	$useflock = 0;
    } elsif (/^-(useflock|s\+)$/) {
	$useflock = 1;
    } elsif (/^-(nolockfile|f-)$/) {
	$uselockfile = 0;
    } elsif (/^-(uselockfile|f\+)$/) {
	$uselockfile = 1;
    } elsif (/^-(keep|k)$/) {
	$keep = 1;
    } elsif (/^-(mailbox|f)$/) {
	$mbopt = 1;
    } elsif (/^-(mailfolder|d)$/) {
	$mfopt = 1;
    } elsif (/^-(nofrom|nf)$/) {
	$listfrom = 0;
    } elsif (/^-(listfrom|lf)$/) {
	$listfrom = 1;
    } elsif (/^-(nosubject|ns)$/) {
	$listsubj = 0;
    } elsif (/^-(listsubject|ls)$/) {
	$listsubj = 1;
    } elsif (/^-h/) {
	usage;
    } elsif (/^-/) {
	die "Unknown switch \"$_\", stopped";
    } elsif (/^\+(.+)$/) {
	$folder = $1;
    } else {
	die "Invalid parameter \"$_\", stopped";
    }
}

die "Filename expected after \"-mailbox\" or \"-f\", stopped" if $mbopt;
die "Directory expected after \"-mailfolder\" or \"-d\", stopped" if $mfopt;

if ($mailfolder) {
    $_ = "$mailfolder/$folder";
    chdir "$_" or die "Can't chdir to \"$_\", stopped\n";
} else {
    $_ = ".*/$folder\$";
    die "Must be executed on the folder \"$folder\", stopped" if cwd !~ /$_/;
}

getmsg($mailbox, $keep);

exit(0);

### Copyright Notice:

## Copyright (C) 2000 Shun-ichi TAHARA <jado@flowernet.gr.jp>
## Copyright (C) 1997, 1998, 1999 IM developing team
## All rights reserved.
##
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following conditions
## are met:
##
## 1. Redistributions of source code must retain the above copyright
##    notice, this list of conditions and the following disclaimer.
## 2. Redistributions in binary form must reproduce the above copyright
##    notice, this list of conditions and the following disclaimer in the
##    documentation and/or other materials provided with the distribution.
## 3. Neither the name of the team nor the names of its contributors
##    may be used to endorse or promote products derived from this software
##    without specific prior written permission.
##
## THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
## PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
## LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
## CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
## SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
## BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
## WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
## OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
## IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

### mewinc ends here.