# -*-Perl-*-
################################################################
###
###			     MsgStore.pm
###
###	      Copyright (C) 1997  Internet Message Group
###
###		     This Perl5 library conforms
###		GNU GENERAL PUBLIC LICENSE Version 2.
###
###
### Author:  Internet Message Group <img@mew.org>
### Created: Apr 23, 1997
### Revised: @im_revised@
###

my $PM_VERSION = "IM::MsgStore.pm @im_version@";

package IM::MsgStore;
require 5.003;
require Exporter;

use Fcntl;
use IM::Config qw(getsbrfile msg_mode msgdbfile expand_path no_sync);
use IM::Util;
use IM::Folder qw(message_number message_name create_folder touch_folder);
use IM::Header qw(gen_date);
use integer;
use strict;
use vars qw(@ISA @EXPORT);

@ISA = qw(Exporter);
@EXPORT = qw(store_message exec_getsbrfile open_fcc excl_create fsync);

=head1 NAME

MsgStore - store message in MH-style folder

=head1 SYNOPSIS

=head1 DESCRIPTION

=cut

use vars qw($MsgNum $PrevFolder $First $Last $PrevDst $sys_fsync);
BEGIN {
    $MsgNum = 0;
    $PrevFolder = '';
    $First = 0;
    $Last = 0;
    $PrevDst = '';
}

##### OPEN A FILE TO SAME NEW MESSAGE IN MAIL FOLDER #####
#
# new_message(handle, folder_name)
#	folder_name: a folder name to be saved in
#	return value:
#		success: file name to be saved
#		fail: NULL
#
sub new_message (\*$) {
    (local *MESSAGE, my $folder) = @_;
    if ($folder ne $PrevFolder) {
        $MsgNum = 0;
        $PrevFolder = $folder;
    }
    if ($MsgNum == 0) {
	$MsgNum = message_number($folder, 'new');
	if ($MsgNum == 0) {
	    im_warn("can't get new message number in $folder\n");
	    return ('', '');
	}
	$First = $Last = $MsgNum;
    } else {
	$MsgNum++;
    }
    my $try = 3;
    while ($try--) {
	my $file = message_name($folder, $MsgNum);
	im_notice("creating file: $file\n");
	unless ($file) {
	    # message path allocation failed
	    return ('', '');
	}
	if (excl_create(\*MESSAGE, $file) == 0) {
	    # created successfully
	    $Last = $MsgNum;
	    return ("$folder/$MsgNum", $file);
	}
	$MsgNum++;
    }
    im_warn("excl_create failed.\n");
    # message creation failed
    return ('', '');
}

sub store_message ($$) {
    my ($Msg, $dst) = @_;
    local *ART;
    require IM::Scan && import IM::Scan qw(store_header parse_header
					   parse_body disp_msg);

    im_notice("saving the message into $dst\n");
    if ($PrevDst ne $dst) {
	if (create_folder($dst) < 0) {
	    return -1;
	}
	touch_folder($dst);
	$PrevDst = $dst;
    }
    my ($msgfile, $filepath) = &new_message(\*ART, $dst);
    my $size = 0;
    if ($filepath ne '') {
	my $line;
	my $hcount = 0;
	my $inheader = 1;
	if (&unixp() && !&no_sync()) {
	    select (ART); $| = 1; select (STDOUT);
	}
	im_notice("creating $filepath\n");
	foreach $line (@$Msg) {
	    $size += length($line);
	    if ($line eq "\n") {
		$inheader = 0;
	    }
	    $hcount++ if ($inheader);
	    unless (print ART $line) {
		im_err("writing to $filepath failed ($!).\n");
		close(ART);
		unlink($filepath) if (-z $filepath);
		return -1;
	    }
	}
	if (&unixp() && !&no_sync()) {
	    if (fsync(fileno(ART)) < 0) {
		im_err("writing to $filepath failed ($!).\n");
		close(ART);
		unlink($filepath) if (-z $filepath);
		return -1;
	    }
	}
	unless (close(ART)) {
	    im_err("writing to $filepath failed ($!).\n");
	    unlink($filepath) if (-z $filepath);
	    return -1;
	}

	my @Hdr = @$Msg[0..$hcount];
	my %Head;
	store_header(\%Head, join('', @Hdr));

	unless ($main::opt_noscan) {
	    splice(@$Msg, 0, $hcount);
	    $Head{'body:'} = &parse_body($Msg, 1);

#	    $Head{'bytes:'} = $size;
	    $Head{'kbytes:'} = int(($size + 1023) / 1024);
	    ($Head{'number:'} = $msgfile) =~ s/^.*\///;
	    $Head{'folder:'} = $dst;
	    &parse_header(\%Head);
#	    if ($main::opt_thread) {
#		&make_thread(%Head);
#	    } else {
		&disp_msg(\%Head);
		$main::scan_count++;
#	    }
	}

	my $mid = $Head{'message-id'};
#	my $dt = $Head{'date'};
	(my $ver = $Head{'mime-version'}) =~ s/\s//g;
	my $master = '';
	if ($ver eq '1.0') {
	    my $ct = $Head{'content-type'} . ';';
	    $ct =~ s/\s//g;
	    if ($ct =~ m|^Message/partial;(.*;)?id=([^;]+);|i) {
		$master = $2;
		$master =~ s/^"(.*)"$/$1/;
	    }
	}
	if (&msgdbfile() ne '' && $mid ne '') {
	    require IM::History && import IM::History;

	    unless (history_open(1) < 0) {
		history_store($mid, $msgfile);
		history_store("partial:$master", $mid) if ($master ne '');
		history_close();
	    }
	}
	return 0;
    } else {
	im_err("message can not be saved to $dst.\n");
	return -1;
    }
}

sub exec_getsbrfile ($) {
    my $dst = shift;
    my $get_hook = getsbrfile();
    if ($get_hook) {
	if ($main::INSECURE) {
	    im_warn("Sorry, GetSbr is ignored for SUID root script\n");
	    return;
	}
	if ($get_hook =~ /^(\S+)$/) {
	    $get_hook = $1;        # to pass through taint check
	    if (-f $get_hook) {
		require $get_hook;
	    } else {
		im_err("get subroutine file $get_hook not found.\n");
	    }
	}
	eval { &get_sub($dst, $First, $Last); };
	if ($@) {
	    im_warn("Form seems to be wrong.\nPerl error message is: $@");
	}
    }
    return;
}

##### OPEN FILE FOR FCC #####
#
# open_fcc(folder_name, save_style)
#	folder_name: a folder name to be saved in
#	save_style:
#		0 = messages in a file
#		1 = separated messages in a directory
#	return values: (handle, fcc_dir, path, rm_file_on_error)
#	  handle:
#		NULL  : failed
#		Handle: success
#	  fcc_dir: directory name
#	  path: file name to be saved
#	  rm_file_on_error: a path to be deleted on error
#
sub open_fcc ($$) {
    my ($folder, $dir_style) = @_;
    my ($fcc_dir, $rm_file_on_error, $fcc_folder, $FILE, $msgfile);
    $fcc_folder = &expand_path($folder);

    if (-d $fcc_folder) {
	$fcc_dir = 1;
    } elsif (-f $fcc_folder) {
	$fcc_dir = 0;
    } else {
	# set default style unless exists
	$fcc_dir = $dir_style;
    }
    im_debug("FCC style: ".($fcc_dir?"Dir":"File")."\n") if (&debug('fcc'));

    unless ($fcc_dir) {
	msg_mode(1);
	im_debug("FCC file: $fcc_folder\n") if (&debug('fcc'));
	unless (open(FCC, ">>$fcc_folder")) {
	    im_warn("can't open FCC file: $fcc_folder\n");
	    return undef;
	}

	my $date = &gen_date(2);
	unless (print(FCC "From $main::Sender $date\n")) {
	    close(FCC);
	    im_warn("can't write FCC file: $fcc_folder\n");
	    return undef;
	}
	$msgfile = $folder;
	$rm_file_on_error = '';
    } else {
	unless (-d $fcc_folder) {
	    if (create_folder($fcc_folder) < 0) {
		im_warn("can't create folder: $fcc_folder\n");
		return undef;
	    }
	}
	($msgfile, $rm_file_on_error) = &new_message(\*FCC, $folder);
	return undef if ($msgfile eq '');
	touch_folder($msgfile);
	im_debug("FCC storing in $rm_file_on_error\n")
	  if (&debug('fcc'));
    }
    if (&unixp() && !&no_sync()) {
	select (FCC); $| = 1; select (STDOUT);
    }
    return (\*FCC, $fcc_dir, $msgfile, $rm_file_on_error);
}

# excl_create(handle, file)
#	file: path of file to be created exclusively
#	handle: file handle
#	return value:
#	  0: success
#	 -1: fail
#
sub excl_create (*$) {
    (local *MESSAGE, my $file) = @_;
    msg_mode(1);
    return -1 unless (sysopen(MESSAGE, $file, @im_file_attr@));
    return 0;
}

sub fsync ($) {
    my $fno = shift;

    unless (defined($sys_fsync)) {
	my $inc = 'syscall.ph';		# only for BSDs?
	my $prefix;
	if (-f '/usr/include/sys.s') {	# for IRIX...
	    # create sys.ph from sys.s
	    require 'sys.ph';
	    $sys_fsync = &SYS_fsync if (defined(&SYS_fsync));
	}
	unless ($sys_fsync) {
	    foreach $prefix (@INC) {
		if (-f "$prefix/$inc") {
		    require "$prefix/$inc";
		    $sys_fsync = &SYS_fsync if (defined(&SYS_fsync));
		    last;
		}
	    }
	}
	unless ($sys_fsync) {
#	    im_warn ("syscall.ph not found. using syscall.h instead.\n");
	    if (open(SYSCALL_H, '</usr/include/sys/syscall.h')) {
		while (<SYSCALL_H>) {
		    if (/^\s*#\s*define\s+SYS_fsync\s+(\d+)/) {
			$sys_fsync = $1;
			last;
		    }
		}
		close(SYSCALL_H);
	    }
	}
	unless ($sys_fsync) {
	    im_die("Can't find a way to fsync(). Set NoSync=yes in your Config file and be careful on file system overflow if your mail folders are on NFS.\n");
	}
    }
    return syscall($sys_fsync, $fno);
}

1;