# -*-Perl-*-
################################################################
###
### MsgStore.pm
###
### Author: Internet Message Group
### Created: Apr 23, 1997
### Revised: Jul 4, 2004
###
my $PM_VERSION = "IM::MsgStore.pm version 20031028(IM146)";
package IM::MsgStore;
require 5.003;
require Exporter;
use Fcntl;
use IM::Config qw(getsbr_file msg_mode msgdbfile expand_path
inbox_folder no_sync fsync_no preferred_fsync_no file_attr);
use IM::Util;
use IM::Folder qw(message_number message_name create_folder touch_folder);
use IM::Message 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);
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 = message_number($folder, 'new', ($MsgNum));
if ($MsgNum == 0) {
im_warn("can't get new message number in $folder\n");
return ('', '');
}
}
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 = message_number($folder, 'new', ($MsgNum));
if ($MsgNum == 0) {
im_warn("can't get new message number in $folder\n");
return ('', '');
}
}
im_warn("excl_create failed.\n");
# message creation failed
return ('', '');
}
sub store_message($$;$) {
my($Msg, $dst, $noscan) = @_;
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 ($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 = getsbr_file();
if ($get_hook) {
if ($main::INSECURE) {
im_warn("Sorry, GetSbr is ignored for SUID root script\n");
return;
}
if ($get_hook =~ /(.+)/) {
if ($> != 0) {
$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 (im_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 (im_sysopen(\*MESSAGE, $file, file_attr()));
return 0;
}
sub fsync($) {
my $fno = shift;
if (preferred_fsync_no()) {
return syscall(preferred_fsync_no(), $fno);
}
# try to find from header files
unless (defined($sys_fsync)) {
eval { require 'syscall.ph'; };
unless ($@) {
$sys_fsync = &SYS_fsync if (defined(&SYS_fsync));
}
unless ($sys_fsync) {
if (-f '/usr/include/sys.s') { # for IRIX...
# create sys.ph from sys.s
eval { require 'sys.ph'; };
unless ($@) {
$sys_fsync = &SYS_fsync if (defined(&SYS_fsync));
}
}
}
unless ($sys_fsync) {
# im_warn ("syscall.ph not found. using syscall.h instead.\n");
if (open(SYSCALL_H, ') {
if (/^\s*#\s*define\s+SYS_fsync\s+(\d+)/) {
$sys_fsync = $1;
last;
}
}
close(SYSCALL_H);
}
}
unless ($sys_fsync) {
# try to use SYS_fsync number detected when configure
$sys_fsync = fsync_no();
}
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;
__END__
=head1 NAME
IM::MsgStore - store message in MH-style folder
=head1 SYNOPSIS
use IM::MsgStore;
Subroutines:
store_message exec_getsbrfile open_fcc excl_create fsync
=head1 DESCRIPTION
The I module stores mail/news messages in MH-style folder.
This modules is provided by IM (Internet Message).
=head1 COPYRIGHT
IM (Internet Message) is copyrighted by IM developing team.
You can redistribute it and/or modify it under the modified BSD
license. See the copyright file for more details.
=cut
### 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.