use Config::IniFiles;
use Net::FTP;
use File::Basename;
use File::Compare;
use File::Find qw(find);
use File::Copy;
use English;
use File::stat;
use XML::Writer;
use IO::File;
use Perot::Guid; # PHF20080930
# prod:
my $dir = "d:\\config\\";
my $config_path = "$dir\\ini"; ###!!! my $config_path = 'config';
# test:
#my $dir = 'C:\projects\iesn\scrums\scrum5';
#my $config_path = 'C:\projects\iesn\scrums\scrum5\ini';
#<---- location of settings
tie my %settings, 'Config::IniFiles', (-file => "$config_path\\setting
+s.ini");
my $setup = \%{$settings{INBOUND}};
my $log = $setup->{ftp_inbound};
my $datestamp = localtime;
LogIt("------------------------------------------------");
LogIt("$datestamp");
my $ServerSetting="ServerSetting";
tie my %server_ini, 'Config::IniFiles', (-file => "$config_path\\serve
+r.ini");
my $ServerConfig = \%{$server_ini{$ServerSetting}};
my $server=$ServerConfig->{server};
# LogIt("server is $server");
my $root = InitializeIt("root");
my $config = InitializeIt("config");
my($account, $file, $DEBUG, $ftp, $sig, $type);
ARGUMENT: foreach (@ARGV) {
#$_ = lc ($_);
# catches file names with spaces & replaces them w/ unders
+cores
if ($_ =~ /(\s)/) {
if ($_ =~ /^-f(.*)$/) {
s/ /_/g;
}
}
$account = uc $1, next ARGUMENT if(/^-a(\S+)/);
$file = $1, next ARGUMENT if(/^-f(\S+)/);
$DEBUG = $1, next ARGUMENT if(/^-d(\S+)/);
}
tie my %ini, 'Config::IniFiles', (-file => "$config", -default => "def
+aults");
my $profile = \%{$ini{$account}};
my ($file_name,$directory_name) = fileparse($file, '\.[^\.]');
my $mapdir = $profile->{MapDIR};
if ($mapdir =~/true/)
{
$outputfile = $file;
$outputfile =~ s/inbound/outbound/i;
LogIt("MapDIR is true.Placing in appropriate subdirectory \n") if
+ ($DEBUG);
my ($file_name,$directory_name) = fileparse($outputfile, '\.[^\.]
+');
$output ="$directory_name$file_name";
}
else
{
$output = $profile->{Destination}. "\\$file_name";
}
# print filesize on received file
my $inode = stat($file);
my $received = $inode->size;
LogIt ("---- Received file $file with $received bytes ----");# if ($DE
+BUG);
my $success = "
Account $account
Sourcefile $file
Destination $output
"
;
## JHE 11/6/13 Fix a 0.1% intermittent failure problem w/ the system
+call:
#jhe @args = ("move", $file, $output);
#jhe if (system(@args) == 0) {
my $placing;
if (move($file, $output)) {
### Log filesize on decrypted file
my $inode1 = stat($output);
$placing = $inode1->size;
LogIt("---- Placing file $output with $placing bytes ----") if ($D
+EBUG);
LogIt("$success");
my $rvmessage = ("$datestamp, $account, $file, $output, $received,
+ $placing");
LogIt("---- XML file created ----");
createXML($rvmessage);
unlink ($file);
}
else
{
my $errormove = "ERROR--MOVE";
my $rverrormove = ("$errormove");
LogIt ("Creating error message XML");
createXML($rverrormove);
#jhe LogIt ("NOTE : system @args failed: $?. \n Error detacted
+: $!");
LogIt ("***ERROR*** move($file, $output) call failed due to:
+$!");
unlink ($file);
}
#####does not change it....unlink $random;
finish();
# Subroutines
# --------------------
sub finish{
# Uses TASKKILL from Windows Resource Kit to Stop Applicati
+on
LogIt("Here is the PID $PID") if $DEBUG;
if ($PID) {
close STDERR;
my @args = ("taskkill /F /PID $PID");
system(@args);
}
}
{
my $fh = '';
sub LogIt{
unless ($fh) {
open $fh, ">> $log" or die "**** DIE **** Can't open log f
+ile '$log' due to: $!\n";
open STDOUT, ">> $log" or die "**** DIE **** Can't redirec
+t STDOUT to log file '$log' due to: $!\n";
open STDERR, ">> $log" or die "**** DIE **** Can't redirec
+t STDERR to log file '$log' due to: $!\n";
}
print $fh "[$$] @_\n";
}
}
sub InitializeIt{
local $_ = shift();
LogIt("---- Initializing $setup->{$_} ----") if ($DEBUG);
if (-e $setup->{$_}) {
return ($setup->{$_});
}
else{
LogIt("Can't find $setup->{$_}");
die;
}
}
sub ExtIt{
local $_ = shift();
local @_ = ();
#LogIt("---- Loading $_ Configurations ----") if ($DEBUG);
my $file_extensions = $setup->{$_};
#LogIt("---- These are the file extensions $file_extensions ----")
+ if ($DEBUG);
open(EXT, $file_extensions);
while (<EXT>) {
chomp;
s/\#.*//; # no comments
s/^\s+//; # no leading white
s/\s+$//; # no trailing white
s/\./\\./;
next unless length;
push(@_, $_);
}
close EXT;
return(join ( '\.|', @_));
}
###_------------------------WORKING HERE
sub detainment{
LogIt("---- Locking him up DETAINMENT ----") if ($DEBUG);
my $Lockdown = \%{$ini{defaults}};
foreach (@_) {
my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
my ($inmate) = fileparse($_);
my $inmate_name = ($account . "_" . $inmate . "_" . $mon. $mday .
+$year . $hour . $min . $sec);
$ftp = Net::FTP->new($Lockdown->{FTPServer}, Debug => 0) || f
+tp_error($_);
$ftp->login($Lockdown->{FTPUsername},$Lockdown->{FTPPassword})
+ || ftp_error($_);
$ftp->binary;
$ftp->put($_, $inmate_name) || ftp_error($_);
$ftp->quit;
LogIt("
The following file has been put into detainment:
Account: $account
File Name: $_ as $inmate_name ");
unlink ($_);
}
finish();
}
sub ftp_error{
LogIt("---- Problem moving file to detainment ----") if ($DEBUG);
LogIt("ERROR--
Could not move the following file to detainment
Filename: $_ ");
LogIt($ftp->code() . " : " . $ftp->message());
my $errormessage = "ERROR--FTP";
my $rverrormessage = ("$errormessage");
LogIt ("Creating error message XML");
createXML($rverrormessage);
die;
}
sub pgp_error{
LogIt("---- There was a PGP error ----") if ($DEBUG);
LogIt("ERROR--
@_
Account Name: $account
File Name: $file");
my $errormessage = "ERROR--PGP";
my $rverrormessage = ("$errormessage");
LogIt ("Creating Error message XML");
createXML($rverrormessage);
if ($sig)
{
detainment($sig,$file);
}
else{
unlink $output;
detainment($file);
}
}
sub sig_check{
if ($type)
{
my $lower=100;
my $upper=200000000;
my $random = int(rand( 200000000-$lower+1 ) ) + $lower;
my @cmds = ("@_ $random");
#LogIt("@cmds")if ($DEBUG);
my @args = (@cmds);
unless (system(@args) == 0) {
unlink $random;
pgp_error("GPG commands failed");
}
LogIt("---- CMD is RUNNING ----") if ($DEBUG);
my $gpgout;
my $gpgin = join (" ",@args);
#LogIt("GPGINPUT is $gpgin");
open(SYSOUT, "$gpgin 2>&1|");
close(SYSOUT);
open (STATUS, "< $random");
local $/ = undef;
$_ = <STATUS>;
my $tempstore = $_;
$tempstore = join ("\n", grep !/]/, split /\n/, $tempstore) ."
+\n";
LogIt ("$tempstore");
if ($_ !~ /VALIDSIG/gi)
{
close STATUS;
unlink $random;
pgp_error("File may not be signed");
}
close STATUS;
unlink $random;
}
else
{
my @cmds = ("@_");
LogIt(@cmds, "\n") if ($DEBUG);
my @args = (@cmds);
system(@args) == 0 || pgp_error("GPG commands failed");
}
unlink $random;
}
sub createXML
{
$message=shift;
while( $message ne "" )
{
#$datestamp,$account,$file,$output,$received,$placing,$server,$mes
+sage,$guid
my $guid_obj = Perot::Guid->new( file => $file ); #
+ PHF20080930
my $guid = $guid_obj->guid;
print STDERR "getting location\n";
my $location = $setup->{ftp_inbound_xmllocation};
print STDERR "location: $location\n";
my $outputfilename=$location.$guid.'.xml';
my $outputfile = IO::File->new("> $outputfilename");
print STDERR "output file: $outputfile\n";
my $writer = XML::Writer->new(OUTPUT => $outputfile);
$writer->xmlDecl("UTF-8");
$writer->startTag("root");
$writer->dataElement( datestamp => $datestamp );
$writer->dataElement( account => $account );
$writer->dataElement( pgpfile => $file );
$writer->dataElement( file => $output );
$writer->dataElement( received => $received );
$writer->dataElement( sending => $placing );
$writer->dataElement( server => $server );
$writer->dataElement( message => $message );
$writer->dataElement( guid => $guid );
$writer->endTag("root");
$writer->end();
#$output->close();
$message=shift;
}
}
This is an existing code and not written by me. Excuse for coding structure and alignments.There are few unused subroutines.I have pasted the script as it is for your investigation | 