##---------------------------------------------------------------------------##
##  File:
##	$Id: mhfile.pl,v 2.13 2010/12/31 21:20:41 ehood Exp $
##  Author:
##      Earl Hood       mhonarc@mhonarc.org
##  Description:
##      File routines for MHonArc
##---------------------------------------------------------------------------##
##    MHonArc -- Internet mail-to-HTML converter
##    Copyright (C) 1997-1999	Earl Hood, mhonarc@mhonarc.org
##
##    This program is free software; you can redistribute it and/or modify
##    it under the terms of the GNU General Public License as published by
##    the Free Software Foundation; either version 2 of the License, or
##    (at your option) any later version.
##
##    This program is distributed in the hope that it will be useful,
##    but WITHOUT ANY WARRANTY; without even the implied warranty of
##    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##    GNU General Public License for more details.
##
##    You should have received a copy of the GNU General Public License
##    along with this program; if not, write to the Free Software
##    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
##    02111-1307, USA
##---------------------------------------------------------------------------##

package mhonarc;

use Symbol;
use Fcntl;
use File::Basename;

my $_have_File_Temp;
BEGIN {
    # If File::Temp is installed, we will use it for temporary file
    # generation.
    eval { require File::Temp; };
    $_have_File_Temp = scalar($@) ? 0 : 1;

    # Increase File::Temp safety level if setuid
    if ($_have_File_Temp && $UNIX && $TaintMode) {
	File::Temp->safe_level(File::Temp::MEDIUM);
    }

    # Perl <5.004 did not auto-call srand().
    eval { require 5.004; };
    srand(time ^ ($$ + ($$ << 15)))  if scalar($@);
}

# Characters to use for home-grown temporay file generation.  We stick to
# basic alphanumerics to avoid OS-specific filename limitations.
my @TEMP_CHARS = qw(
    A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
    a b c d e f g h i j k l m n o p q r s t u v w x y z
    0 1 2 3 4 5 6 7 8 9 _
);

# Maximum tries to create a temporary file in home-grown implementation
sub TEMP_MAX_TRIES() { 10; }

##---------------------------------------------------------------------------##

sub file_open {
    my($file) = shift;
    my($handle) = gensym;
    my($gz) = $file =~ /\.gz$/i;

    if ($gz) {
	cmd_pipe_open($handle, $GzipExe, '-cd', $file);
	return $handle;
    }
    return $handle  if open($handle, $file);
    if (-e "$file.gz") {
	cmd_pipe_open($handle, $GzipExe, '-cd', "$file.gz");
	return $handle;
    }
    die qq/ERROR: Failed to open "$file": $!\n/;
}

sub cmd_pipe_open {
    my $handle	= shift;
    my @cmd	= @_;

    if (!$UNIX) {
	return $handle  if open($handle, join(' ', @cmd, '|'));
	die qq/ERROR: Failed to exec @cmd: $!\n/;
    }
    my $child_pid = open($handle, '-|');
    if ($child_pid) {   # parent
	return $handle;
    } else {		# child
      #open(STDERR, '>&STDOUT');
      exec(@cmd) || die qq/ERROR: Cannot exec "@cmd": $!\n/;
    }
}

sub file_gzip {
    my $file = shift;
    return  if ($file =~ /\.gz$/i);
    if (system($GzipExe, $file) != 0) {
	die qq/ERROR: Failed to exec "$GzipExe $file": $! $?\n/;
    }
}

## This function is currently not used anymore
sub file_create {
    my($file) = shift;
    my($gz) = shift;
    my($handle) = gensym;

    if ($gz) {
	$file .= ".gz"  unless $file =~ /\.gz$/;
	return $handle  if open($handle, "| $GzipExe > $file");
	die qq{ERROR: Failed to exec "| $GzipExe > $file": $!\n};
    }
    return $handle  if open($handle, "> $file");
    die qq{ERROR: Failed to create "$file": $!\n};
}

sub file_exists {
    (-e $_[0]) || (-e "$_[0].gz");
}

sub file_copy {
    my($src, $dst) = ($_[0], $_[1]);
    my($gz) = $src =~ /\.gz$/i;

    if ($gz || (-e "$src.gz")) {
	$src .= ".gz"  unless $gz;
	$dst .= ".gz"  unless $dst =~ /\.gz$/i;
    }
    &cp($src, $dst);
}

sub file_rename {
    my($src, $dst) = ($_[0], $_[1]);
    my($gz) = $src =~ /\.gz$/i;

    if ($gz || (-e "$src.gz")) {
	$src .= ".gz"  unless $gz;
	$dst .= ".gz"  unless $dst =~ /\.gz$/i;
    }
    if (!rename($src, $dst)) {
	die qq/ERROR: Unable to rename "$src" to "$dst": $!\n/;
    }
    $dst;
}

sub file_remove {
    my($file) = shift;

    unlink($file);
    unlink("$file.gz");
}

sub file_utime {
    my($atime) = shift;
    my($mtime) = shift;
    foreach (@_) {
	utime($atime, $mtime, $_, "$_.gz");
    }
}

sub file_temp {
    my $template = shift;	      # Filename template
    my $dir	 = shift || $CURDIR;  # Where to write the file
    my $suffix	 = shift;	      # Required suffix (optional)
    my($handle, $tmpfile);

    MKTEMP: {
	# Do not honor FASTTEMPFILES if a suffix is required, mainly
	# because things like attachment writing will not work with
	# FASTTEMPFILES.
	if ($FastTempFiles && !defined($suffix)) {
	    $handle = gensym;
	    $tmpfile = join($DIRSEP, $dir, $template.$$);
	    if (!sysopen($handle, $tmpfile,
			 (O_WRONLY|O_EXCL|O_CREAT), 0600)) {
		die qq/ERROR: Unable to create temp file "$tmpfile": $!\n/;
	    }
	    last MKTEMP;
	}

	# Use File::Temp when at all possible
	if ($_have_File_Temp) {
	    my @tf_opts = ('DIR' => $dir, 'UNLINK' => 0);
	    push(@tf_opts, 'SUFFIX' => $suffix)  if $suffix;
	    ($handle, $tmpfile) = File::Temp::tempfile($template, @tf_opts);
	    last MKTEMP;
	}

	$handle = gensym;
	my($i);
	for ($i=0; $i < TEMP_MAX_TRIES; ++$i) {
	    ($tmpfile = $template) =~
		s/X/$TEMP_CHARS[int(rand($#TEMP_CHARS))]/ge;
	    $tmpfile  = join($DIRSEP, $dir, $tmpfile);
	    $tmpfile .= $suffix  if defined($suffix);
	    last  if sysopen($handle, $tmpfile,
			     (O_WRONLY|O_EXCL|O_CREAT), 0600);
	}
	if ($i >= TEMP_MAX_TRIES) {
	    die qq/ERROR: Unable to create temp file "$tmpfile": $!\n/;
	}
    }
    ($handle, $tmpfile);
}

sub file_chmod {
    my $file  = shift;
    my $perm  = shift || $FilePermsOct;
    ## Capture any die's in case chmod not supported.
    eval {
	if (chmod(($perm &~ umask), $file) < 1) {
	    warn qq/Warning: Unable to change "$file" permissions to "/,
		 sprintf('%o'. $perm),
		 qq/": $!\n/;
	}
    };
}

##---------------------------------------------------------------------------##

sub dir_create {
    my $path  = shift;
    my $perms = shift || 0777;

    if (!$UNIX) {
	## Non-Unix OS's do not have symlinks
	return  if (-e $path);
	if (!mkdir($path, $perms)) {
	    die qq/ERROR: Unable to create "$path": $!\n/;
	}
	return;
    }

    ## Check if $path is a symlink
    if (-l $path) {
        if ($FollowSymlinks) {
            # Symlinks allowed, so we check if symlink is to a directory
            die qq/ERROR: "$path" is not a directory: $!\n/  if !(-d $path);
            return;
        }
	# symlink, try to delete
	warn qq/Warning: "$path" is a symlink, will try to replace...\n/;
	if (!unlink($path)) {
	    die qq/ERROR: "$path" is a symlink, unable to remove: $!\n/;
	}
    } elsif (-e $path) {
	die qq/ERROR: "$path" is not a directory: $!\n/  if !(-d _);
	# already exists, nothing to do
	return;
    }

    my $dirname = dirname($path);
    my @info = stat($dirname);
    if ($info[2] & Fcntl::S_IWGRP || $info[2] & Fcntl::S_IWOTH) {
	my($i, $errstr, $tmpdir);
	for ($i=0; $i < TEMP_MAX_TRIES; ++$i) {
	    $tmpdir = dir_temp('dirXXXXXXXXXX', $dirname);
	    if (!rename($tmpdir, $path)) {
		$errstr = "$!";
		rmdir($tmpdir);
		if (-l $path) {
		    # hmmmm, somone trying to so something malicious?
		    warn qq/Warning: Possible symlink attack attempted with /,
			 qq/"$path"\n/;
		    die qq/ERROR: "$path" is a symlink, unable to remove: $!\n/
			unless unlink $path;
		} elsif (-d $path) {
		    # somebody snuck in and created it
		    return;
		} elsif (-e _) {
		    die qq/ERROR: "$path" exists, but it did not before, /,
			qq/and it is not a directory!\n/;
		}
	    } else {
                last;
            }
	}
	if ($i >= TEMP_MAX_TRIES) {
	    die qq/ERROR: Unable to rename "$tmpdir" to "$path": $errstr\n/;
	}

    } else {
	if (!mkdir($path, $perms)) {
	    die qq/ERROR: Unable to create "$path": $!\n/;
	}
    }
    chmod(($perms &~ umask), $path);
}

sub dir_temp {
    my $template = shift;
    my $dir	 = shift || $CURDIR;
    my($tmpdir);

    MKTEMP: {
	if ($_have_File_Temp) {
	    $tmpdir =
		File::Temp::tempdir($template, 'DIR' => $dir, 'CLEANUP' => 0);
	    last MKTEMP;
	}

	my($i);
	for ($i=0; $i < TEMP_MAX_TRIES; ++$i) {
	    ($tmpdir = $template) =~
		s/X/$TEMP_CHARS[int(rand($#TEMP_CHARS))]/ge;
	    $tmpdir = join($DIRSEP, $dir, $tmpdir);
	    last  if mkdir $tmpdir, 0700;
	}
	if ($i >= TEMP_MAX_TRIES) {
	    die qq/ERROR: Unable to create temp dir "$tmpdir": $!\n/;
	}
    }
    $tmpdir;
}

sub dir_remove {
    my($file) = shift;

    if (-d $file) {
	local(*DIR);
	local($_);
	if (!opendir(DIR, $file)) {
	    warn qq{Warning: Unable to open "$file"\n};
	    return 0;
	}
	my @files = grep(!/^(\.|\..)$/i, readdir(DIR));
	closedir(DIR);
	foreach (@files) {
	    &dir_remove($file . $mhonarc::DIRSEP . $_);
	}
	if (!rmdir($file)) {
	    warn qq{Warning: Unable to remove "$file": $!\n};
	    return 0;
	}

    } else {
	if (!unlink($file)) {
	    warn qq{Warning: Unable to delete "$file": $!\n};
	    return 0;
	}
    }
    1;
}

##---------------------------------------------------------------------------##

sub rand_string {
    my $template = shift;
    $template =~ s/X/$TEMP_CHARS[int(rand($#TEMP_CHARS))]/ge;
    $template;
}

##---------------------------------------------------------------------------##
1;