#!/usr/bin/perl
###############################################################################################
# #
# # # ##### ##### # ## # ##### # ### # #### #### # #
# # # # # # # # ## # # # # # # # # # # # # #
# ##### # #### ##### # # # ##### # # # ##### # # #### # #
# # # # # # # # ## # # # # # # # # # # #
# # # # # # # # ## ##### ##### ### # # #### # # ##### #
# #
# 4transload.pl Version .508 #
# Release Date: 10/01/2005 #
# #
# You are free to modify this program for your purpose as needed. #
# For inquiries concerning this program, please visit http://www.4transload.us #
# or E-mail: support@4transload.us #
# #
# This Version can use existing log file(s) from 4transload.pl Version .507 #
# #
###############################################################################################
# #
# Platforms: UNIX/Linux and Windows #
# #
# 4transload.pl is written in Perl. #
# 4transload.pl Version .508 was tested using PERL 5.8 #
# and should work with some lower versions of Perl 5 also. #
# #
###############################################################################################
# #
# Begin Modifications #
# #
# 4transload.pl must be uploaded to a directory that can execute Perl programs. #
# Create a new or use an existing directory. #
# #
###############################################################################################
# #
# #!/usr/bin/perl #
# #
# Check the first line of 4transload.pl (#!/usr/bin/perl) and change it if necessary so that #
# the program points to your web servers perl interpreter.The first line is not needed on #
# all operating systems.Generally,UNIX/Linux-yes,Windows-no. #
###############################################################################################
# #
# Case Sensitive #
# #
# $CS='Default'; #
# $CS='Yes'; #
# #
# Be sure to use 'Default' if your servers operating system does not allow case sensitive #
# filenames. #
# #
# This variable is important if you want to relocate all the files to a different operating #
# system.You can use "Default" to avoid case sensitive problems. #
# #
# If your servers operating system does not allow case sensitive filenames in the same #
# directory or you do not want to use that feature, use $CS='Default'; as in the example #
# above. #
# #
# If your servers operating system allows case sensitive filenames in the same directory and #
# you want to use that feature, use $CS='Yes'; as in the example above. #
# #
# Modify variable $CS below if necessary. #
$CS='Default';
###############################################################################################
# #
# The Base Path #
# #
# $base_path='/path/to/transload/directory'; #
# #
# The $base_path is the "PATH" to the directory or directory structure that will receive #
# transloaded files. #
# #
# If you are using one directory only,include the directory name in the $base_path. #
# #
# If you are using multiple directories(refer to the multiple directories.doc),include the #
# directory name up to but not including a file receiving directory name. #
# #
# Modify your $base_path below.Do not include an end slash. #
$base_path='';
###############################################################################################
# #
# The Base URL #
# #
# $base_url='http://www.your_domain.net'; #
# #
# The $base_url is the "URL" to the directory or directory structure that will receive #
# transloaded files. #
# #
# If you are using one directory only,include the directory #
# name in the $base_url unless it is your first level Internet directory. #
# #
# If you are using multiple directories(refer to the multiple directories.doc),include the #
# directory name up to but not including a file receiving directory name. #
# #
# Modify your $base_url below.Do not include an end slash. #
$base_url='';
###############################################################################################
# #
# Continue Page #
# #
# $continue_page="$base_url/cgi-bin/4results.pl"; #
# $continue_page="http://www.4transload.us/cgi-bin/4results.pl"; #
# #
# A Continue Page is generated if a file is successfully transloaded. The '$continue_page' #
# variable is the URL to the file named "4results.pl". #
# #
# The "$base_url" can be used in $continue_page if it is part of the exact URL to #
# 4results.pl. Use the full URL if not. The full URL can be used in either case. #
# #
# Set $continue_page to the URL of 4results.pl #
# #
# 4results.pl must be in an executables directory. #
# 4results.pl can be placed in the same directory as 4transload.pl. #
# #
# Type the URL to 4results.pl below.Do not include an end slash. #
$continue_page="";
###############################################################################################
# #
# Log Directory #
# #
# $log_directory='/path/to/4transload_log'; #
# #
# Place a directory or use an existing one(usually above the Internet)so 4transload.pl can #
# write a log file.The log will record the time,transferred files,and transfer attempts. #
# chmod the directory to 777 if necessary. #
# #
# Type the path to the Log Directory below.Do not include an end slash. #
$log_directory='';
###############################################################################################
# #
# Log File Name #
# #
# $log_file_name='4transload.log'; #
# #
# 4transload.pl will create the specified log file in the Log Directory automatically. #
# #
# ----Notes: 4transload.pl is programmed to create an archive file with the extension ".alog" #
# in the Log Directory each time the log file reaches 1mb.Do not remove or change the name #
# of archive files unless extensively modifying the program. #
# #
# The ".log" and ".alog" files can be opened with a plain text editor such as notepad.---- #
# #
# Type the Log File Name you want to use below. #
$log_file_name='4transload.log';
###############################################################################################
# #
# Temporary Directory Path #
# #
# Example: #
# $temp_path="$base_path/4transload_temp"; #
# $temp_path="/full/path/to/4transload_temp"; #
# #
# Create a directory for the temporary 'Continue Page' files that 4transload.pl generates. #
# These files are created so log entries and transloads are not duplicated. #
# #
# The "$base_path" can be used in $temp_path if it is part of the exact path to the #
# Temporary Directory Path. Use the full path if not. The full path can be used in #
# either case. #
# #
# The directory must be Internet accessible. #
# chmod the directory to 777 if necessary. #
# #
# Type the PATH to the temporary directory below.Do not include an end slash. #
$temp_path="$base_path/4transload_temp";
###############################################################################################
# #
# Temporary Directory URL #
# #
# Example: #
# $temp_url="$base_url/to/4transload_temp"; #
# $temp_url="http://www.4transload.us/url/to/4transload_temp"; #
# #
# #
# The "$base_url" can be used in $temp_url if it is part of the exact URL to the Temporary #
# Directory URL. Use the full URL if not. The full URL can be used in either case. #
# #
# Type the URL to the temporary directory below.Do not include an end slash. #
$temp_url="$base_url/4transload_temp";
###############################################################################################
#No changes are needed here unless you are extensively modifying the program.
#Reads form input
read(STDIN,$input,$ENV{'CONTENT_LENGTH'});
# split the input
@pairs=split(/&/,$input);
# split the name/value pairs
foreach $pair(@pairs){
($name,$value)=split(/=/,$pair);
$name=~tr/+/ /;
$name=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$value=~tr/+/ /;
$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$value=~s/<([^>]|\n)*>//gi;
$value=~tr/\|//d;
$value=~tr/\*//d;
$value=~tr/\n//d;
$value=~tr/<//d;
$value=~tr/>//d;
$value=~tr/"//d;
$FORM{$name}=$value;
}
###############################################################################################
# #
# Multiple Directory Form #
# #
# $YourDir=$FORM{'YourDir'}; #
# #
# Next,!only if you are using multiple directories(refer to the multiple directories.doc). #
# The FORM 'YourDir' is used in the provided html/shtml and can be used without modification. #
# #
# Modify your $FORM below if necessary.Remove the "#" before $YourDir. #
#$YourDir=$FORM{'YourDir'};
###############################################################################################
# #
# Path To Multiple Directory Form #
# #
# $multiple_directories="$YourDir"; #
# #
# Next(!only if you are using multiple directories),make $multiple_directories equal #
# to your FORM value.Remove the "#" before $multiple_directories. #
# #
#$multiple_directories="$YourDir";
###############################################################################################
# #
# Multiple Directory Check #
# #
# EXAMPLE ARRAY #
# #@dir_check=('Transload','Graphics','Graphics/Incoming', #
# #'Transload/HTML','Transload/HTML/Text-Documents'); #
# #
# The reason for "Multiple Directory Check" is so that only directories in the list can be #
# used.This is necessary as a form page can be easily modified. #
# #
# Next(!only if using multiple directories),list ALL the Multiple Directory PATHS exactly as #
# in the form page.Be sure to use the form "value".The example above is as the "YourDir" #
# form(s) in the html/shtml provided.Do not use backslashes. #
# #
# Modify the @dir_check array below if necessary.Remove the #'s before @dir_check=(list);. #
#@dir_check=('Transload','Graphics','Graphics/Incoming',
#'Transload/HTML','Transload/HTML/Text-Documents');
###############################################################################################
# #
# Accepted Extensions #
# #
# EXAMPLE ARRAY #
# @good_extensions=('.aiff','.au','.avi','.bmp','.doc','.gif','.gz','.htm', #
# '.html','.jpeg','.jpg','.mid','.mpeg','.mpg','.mov','.movie','.pdf','.rm', #
# '.tar','.tar.gz','.tif','.tiff','.txt','.wav','.zip'); #
# #
# Only extensions in your @good_extensions array can be transloaded. #
# #
# Simply add extensions(not case sensitive)to fit your program at the @good_extensions array. #
# Include all the "dots" for each extension.Some programs may need only one extension. #
# #
# Modify the @good_extensions array below.Include all the "dots" for each extension. #
@good_extensions=('.bmp','.gif','.htm','.html','.jpg','.jpeg','.zip');
###############################################################################################
# #
# Auto Rename Special File Names #
# #
# EXAMPLE ARRAY #
# @rename_special=('index.html','Default.htm','404','Error403.htm','Error.html'); #
# #
# If you do not want index, default, error, or other special file names transloaded, put the #
# file name in the @rename_special=(); array. Any file with the specified name, no matter if #
# uppercase or lowercase, will be renamed to 'SF_filename'. #
# #
# Examples: #
# index.html would be renamed to SF_index.html #
# Default.htm would be renamed to SF_Default.htm #
# index.bmp would be renamed to SF_index.bmp #
# Error.htm would be renamed to SF_Error.htm #
# 404 would be renamed to SF_404 #
# #
# Modify the @rename_special array below.(not case sensitive). #
@rename_special=('index.html','default.htm','index.htm','default.html');
###############################################################################################
# #
# Automatic Rename #
# #
# $automatic_rename='On'; #
# $automatic_rename=''; #
# #
# To automatically rename files with the same name, set $automatic_rename to On. #
# (not case sensitive) #
# #
# To turn the Automatic Rename feature off, set $automatic_rename to ''. #
# #
# Modify $automatic_rename below. #
$automatic_rename='On';
###############################################################################################
# #
# Identical Files #
# #
# $identical_files='123'; #
# $identical_files='123,Rename'; #
# $identical_files='Yes'; #
# $identical_files='Rename'; #
# $identical_files=''; #
# #
# An indentical file is indentical to another file. #
# They may or may not have the same filename. #
# #
# Using a number limit: #
# To limit the number of indentical files in the same directory simply add your limit. #
# The limit must be at least '2'. Use digits only. #
# To allow 4 indentical files in the same directory you would use $identical_files='4'; #
# To allow 100000 you would use $identical_files='100000'; #
# There is no limit to how many indentical files can be allowed. #
# #
# Using Rename with a number limit: #
# To allow identical files to be renamed only with the "Rename" text box when Automatic #
# Rename is on, simply add a comma and "Rename" after the number limit.(not case sensitive). #
# If Automatic Rename is off, only the number limit would have effect. #
# Example: $identical_files='123,rename'; #
# #
# Using '0' or '1' as the number limit will disallow all indentical files. #
# #
# Using $identical_files='Yes'; (not case sensitive) will allow all indentical files. If #
# Automatic Rename is on, indentical files will be automatically renamed. #
# #
# Using Rename alone: #
# Using $identical_files='Rename'; (not case sensitive) will allow all identical files #
# as long as they are renamed only with the "Rename" text box. Automatic Rename must be on #
# for this to have any effect. #
# #
# Using $identical_files=''; or a format other than described will disallow all #
# indentical files. #
# #
# To control indentical files, modify $identical_files below if necessary. #
$identical_files='4';
###############################################################################################
# #
# Plain Files #
# #
# $plain_file='Yes'; #
# $plain_file=''; #
# #
# To include files without an extension, make $plain_file equal to 'Yes'(is not case #
# sensitive). #
$plain_file='Yes';
###############################################################################################
# #
# Automatically change 'html' extensions to 'htm' #
# #
# $cext='html'; #
# $cext=''; #
# #
# To automatically change 'html' extensions to 'htm', make $cext equal to 'html'; #
$cext='html';
###############################################################################################
# #
# Maximum File Size #
# #
# $max_size='50000'; #
# $max_size=''; #
# #
# To adjust the maximum file size,change the number of bytes at $max_size. #
# 50000 bytes is 50kb.To set the maximum file size to no limit, set $max_size to ''. #
# #
# Be sure to use digits only. #
$max_size='50000';
###############################################################################################
# #
# Optional Text and Hyperlink #
# #
# To place a hyperlink at the bottom of the Transload Results page and Error Messages, write #
# a textual representation of the hyperlink and the hyperlink.This will also place the text #
# on the Continue Page. #
# #
# To use text only, use only $text and make $hlink equal to '' or use # to comment out the #
# line.To use neither, make $text equal to '' or use # to comment out the line. #
# Examples: #
# #
# $text='4transload.us'; #
# $hlink='http://www.4transload.us'; #
# #
# $text='e-mail: webmaster@4transload.us'; #
# $hlink='mailto:webmaster@4transload.us'; #
# #
# Modify Optional Text and Hyperlink below. #
$text='e-mail: webmaster@4transload.us';
$hlink='mailto:webmaster@4transload.us';
###############################################################################################
# #
# Error Messages #
# #
# $error_messages='ON'; #
# $error_messages=''; #
# #
# The error messages can find problems during initial set up or can be used during normal use.#
# #
# For error messages to be ON,(CASE SENSITIVE)make $error_messages equal 'ON'; #
# To turn error messages off, make $error_messages equal to ''; #
# #
# Modify $error_messages below.
$error_messages='ON';
###############################################################################################
# #
# Error Script #
# #
# $error_script="$base_path/cgi-bin/do_error.pl"; #
# $error_script="/full/path/to/do_error.pl"; #
# #
# The "$base_path" can be used in $error_script if it is part of the exact path to the #
# Error Script. Use the full path if not. The full path can be used in either case. #
# #
# Type the PATH to "do_error.pl" as shown above if using error messages.You can leave the #
# PATH to "do_error.pl" in place when not using error messages. #
# #
# do_error.pl must be in an executables directory. #
# do_error.pl can be placed in the same directory as 4transload.pl. #
# #
# Modify $error_script below. #
$error_script="$base_path/cgi-bin/do_error.pl";
###############################################################################################
# #
# controlfile.txt #
# #
# Note! A file named "controlfile.txt" is automatically created in the log file directory. #
# All controlfile.txt does is open and close to control program flow relating #
# to the flock(); function. #
###############################################################################################
# #
# Notice: Setting file permissions may vary. #
# #
###############################################################################################
# #
# End Modifications #
# #
# That's all the modifications for this file(4transload.pl). #
# 4results.pl must also be modified. #
# do_error.pl has one modification(#!/usr/bin/perl) #
# #
# The file "current_transloader.pl" is used with a ".shtml" file.If you are not using #
# ".shtml",you can use an ".html" or ".htm" file. #
# #
# Using .shtml and "current_transloader.pl" will not cause the program(4transload.pl)to work #
# better,it is an optional way to update certain appearance changes in the form page.These #
# changes can also be made easily,if not easier,using standard .html or.htm. #
# #
# DO NOT EDIT BELOW THIS LINE UNLESS EXTENSIVELY MODIFYING THE PROGRAM #
###############################################################################################
$OK_CHARS='-a-zA-Z0-9_. ';
$OK_STRING='-a-zA-Z0-9_. \\\/:';
$OK_RENAME='-a-zA-Z0-9 _';
if(@dir_check){ #check to see if multiple directories are used
unless($multiple_directories eq ""){
foreach $d_ck(@dir_check){
$d_ck=~tr/-/\-/;
if($multiple_directories eq "$d_ck"){
$tpath="$base_path/$multiple_directories";
$t_url="$base_url/$multiple_directories";
last;
}}}}elsif(!@dir_check){ #transload to the $base_path if using one directory
if($multiple_directories eq ""){
$tpath="$base_path";
$t_url="$base_url";
}}
$log_file="$log_directory/$log_file_name";
$controlfile="$log_directory/controlfile.txt";
use Fcntl ':flock';
use POSIX qw(strftime);
if(!-e "$log_file"){
if(open(LOG,">>$log_file")){
flock(LOG,LOCK_EX);
seek (LOG,0,2);
$time_strng=strftime"%a %b %d %H:%M:%S %Y",localtime; #get localtime
print LOG"4transload.pl Log File\n"; #message
print LOG"Created:: $time_strng localtime\n"; #print localtime
print LOG"-------------------------------------------------------------------------------\n";
print LOG"\n\n";
flock(LOG,LOCK_UN);
close(LOG);
}}
if(!-e "$controlfile"){
if(open(CONTROL,">>$controlfile")){
flock(CONTROL,LOCK_EX);
seek (CONTROL,0,2);
$control_file_time=strftime"%a %b %d %H:%M:%S %Y",localtime; #get localtime
print CONTROL"This file is used by 4transload.pl to control program flow.\n"; #message
print CONTROL"Created:: $control_file_time localtime"; #print localtime
flock(CONTROL,LOCK_UN);
close(CONTROL);
}}
unless($error_messages eq ''){ #Do error script
do("$error_script");
}
# sort lenght of extensions from largest to smallest
@good_extensions=sort{length($b)<=>length($a)}@good_extensions;
$random=rand(1234); #random number
$random=~s/\.//g;
$size_limit="$max_size";
@file_keys=keys(%FORM); #Get file keys
foreach $file_key(@file_keys){
chomp($file_key);
if($file_key=~/^file\d+$/){ #Get file keys for file\d+
$file_key=~s/^file//;
push(@file_fields,"$file_key");
}
}
@file_fields=sort{$a<=>$b}@file_fields; #sort file keys smallest to largest
foreach $f_field(@file_fields){ #Start of main loop
undef $cc_name; #reset variables
undef $cname;
undef $cname2;
undef $cname_chars;
undef $cname_ck;
undef $cname_ck2;
undef $cname_gogo;
undef $dd;
undef $f1;
undef $f2;
undef $f3;
undef $f4;
undef $file;
undef $file_rename;
undef $file_transload;
undef $file_url;
undef $filern;
undef $filernck;
undef $ge;
undef $htm_cp;
undef $ifl;
undef $is_s;
undef $l_ge;
undef $nr;
undef $push0;
undef $push1;
undef $push2;
undef $push3;
undef $push4;
undef $qfile;
undef $renamed_file;
undef $renamefile;
undef $renamefile1;
undef $rt;
undef $request;
undef $response;
undef $rn_chars;
undef $rn_rego;
undef $sf;
undef $sf_cp;
undef $sf_cname;
undef $sf_rename;
undef $ttpath;
undef $ua;
undef $url;
undef $url_go;
undef $urlgo_go;
$auto_rn=~s/.*/no/;
$plus_one='0';
undef $max_size; #reset $max_size
$max_size="$size_limit";
undef @f2;
undef @rego;
undef @rego_go; #end of reset variables
$file="file$f_field"; #Get the 'File' form name
$file=$FORM{$file}; #$file = $FORM value
$file=~s/\s+$//; #remove spaces at end
$file=~s/^\s+//; #remove spaces at front
$qfile="$file";
$qfile=quotemeta($qfile); #puts a backslash before each non-word character
$file=~s/%20/ /gi;
$url="$file";
$cname_ck="$file";
$cname_ck=~s/^.*\\//g;
$cname_ck=~s/^.*\///g;
$cname_ck=~s/\s+$//;
$cname_ck=~s/^\s+//;
$cname_chars="$cname_ck";
$cname_ck=~s/[^$OK_CHARS]/_/go;
$filern="filern$f_field"; #Get the 'Rename' form name
$filern=$FORM{$filern}; #$filern = $FORM value
$filern=~s/\s+$//; #remove spaces at end
$filern=~s/^\s+//; #remove spaces at front
$rn_chars="$filern";
$filern=~s/[^$OK_RENAME]/_/go;
$filern=~tr/-/\-/;
$filernck="filernck$f_field"; #Get the 'Check Here' form name
$filernck=$FORM{$filernck};
next if $cname_ck eq ""; #Start next loop if no file name
foreach $ge(@good_extensions){ #Check for good extension
if($ge=~/\./i){
unless($filernck eq "ON"){ #Check if 'Rename' field was used
if($cname_ck=~/$ge$/i){
$l_ge=length($ge);
$cname_ck2=substr($cname_ck,-$l_ge);
$cname_ck=~tr/-/\-/;
$cname_ck=~s/$ge$//i;
$cname_ck=~s/[^$OK_RENAME]/_/go;
$cname="$cname_ck$cname_ck2";
last if $cname_ck2=~/^$ge$/i; #Exit @good_extensions if good filename
}}
if($filernck eq "ON"){ #Check if 'Rename' field was ON
if($cname_ck=~/$ge$/i){
$l_ge=length($ge);
$cname_ck2=substr($cname_ck,-$l_ge);
$cname="$filern$cname_ck2";
last if $cname_ck2=~/^$ge$/i; #Exit @good_extensions if good filename
}}
}}
if($plain_file=~/^yes$/i){ #Allow files without an extension if specified
if($cname eq ""){
unless($filernck eq "ON"){ #Check if 'Rename' field was used
unless($cname_ck=~/\./i){
$cname="$cname_ck";
}}
if($filernck eq "ON"){ #Check if 'Rename' field was ON
unless($cname_ck=~/\./i){
$cname="$filern";
}}
}}
$url_go="$url";
$url_go=~s/[^$OK_STRING]/_/go; #Using $OK_STRING for printing html
if($url_go ne "$url"){
$urlgo_go='urlgo_go';
}
$nr="$url_go";
$nr=~s/^.*\\//gi;
$nr=~s/^.*\///gi;
if($cname eq ""){ #Check if filename was not in @good_extensions list
$url_go=~s/ /\%20/gi;
#Logging
push(@tlog,"$random\|no_return\|$url_go\|$f_field\|$nr\|$urlgo_go\|$qfile");
next;
}
unless($filernck eq 'ON'){
if($cname_chars ne "$cname"){
$cc_name='renamed';
}}
if($filernck eq 'ON'){
unless($rn_chars eq "$filern"){
$cc_name='renamed';
}}
if ($cext eq 'html'){ #Change .html extensions to .htm if specified
if($cname=~/\.$cext$/i){
chop $cname;
$htm_cp='renamed';
}}
foreach $sf(@rename_special){ #Rename Special Files if specified
if($cname=~/^$sf$/i){
$sf_cname="$cname";
undef $cname;
$cname="SF_$sf_cname";
$sf_rename='renamed';
last if $sf_rename eq 'renamed'; #Exit @rename_special loop
}}
$file_transload="$tpath/$cname";
$file_url="$t_url/$cname";
$file_rename="$tpath";
###############################################################################################
# #
# Auto Rename #
if(-e "$file_transload"){
if($automatic_rename=~/^on$/i){
$cname_gogo="$cname";
$cname2="_$cname";
}else{
$ttpath="$tpath";
$ttpath=~s/^.*\\//g;
$ttpath=~s/^.*\///g;
$sf_cp="$url_go\|$sf_rename\|$htm_cp\|$qfile";
push(@tlog,"$random\|autorn_off\|$ttpath\|$f_field\|$cname\|$cc_name\|$urlgo_go\|$sf_cp");
next;
}
opendir(DIR,"$file_rename");
if($CS=~/^Default$/i){
@rego=grep{/^\d+$cname2$/i && -f "$file_rename/$_"}readdir (DIR);
closedir(DIR);
foreach $renamefile1(@rego){
$rt=lc($cname2);
$renamefile=lc($renamefile1);
$rt=~tr/-/\-/;
$renamefile=~s/$rt$//;
push(@rego_go,"$renamefile");
}
}
elsif($CS=~/^Yes$/i){
@rego=grep{/^\d+$cname2$/ && -f "$file_rename/$_"}readdir (DIR);
closedir(DIR);
foreach $renamefile(@rego){
$cname2=~tr/-/\-/;
$renamefile=~s/$cname2$//;
push(@rego_go,"$renamefile");
}
}
if(@rego_go){
@rego_go=sort{$a<=>$b}@rego_go;
foreach $rn_rego(@rego_go){
if($rn_rego==$plus_one){
$plus_one+=1;
}else{
undef(@rego_go);
}
}}
undef $cname;
$cname="$plus_one$cname2";
undef $file_transload;
$file_transload="$file_rename/$cname";
undef $file_url;
$file_url="$t_url/$cname";
$renamed_file='renamed';
$auto_rn=~s/no/yes/;
}
###############################################################################################
require LWP::UserAgent;
$ua=LWP::UserAgent->new;
$request=HTTP::Request->new('GET',"$url");
$response=$ua->request($request);
if($response->is_success){
$is_s='1';
unless($max_size eq ''){
$ua->max_size($max_size);
}
if(!-e "$file_transload"){
$ua->mirror("$url","$file_transload"); #Copy file to a directory
}
else{
$url_go=~s/ /\%20/gi;
$push0="$sf_rename\|$htm_cp\|$qfile";
push(@tlog,"$random\|redo\|$url_go\|$f_field\|$cname\|$cc_name\|$urlgo_go\|$push0");
$transload_results='pF';
next;
}
}
unless($is_s==1){
$url_go=~s/ /\%20/gi;
push(@tlog,"$random\|nofile\|$url_go\|$f_field\|$nr\|$urlgo_go\|$qfile");
next;
}
unless($identical_files=~/^yes$/i){
opendir(DIR,"$file_rename");
@f2=grep{/.*/ && -f "$file_rename/$_"}readdir (DIR);
closedir(DIR);
}
$f1=(-s "$file_transload");
$ifl='1';
if(@f2){
foreach $f2(@f2){
undef $f3;
unless($f2 eq "$cname"){
$f3=(-s "$file_rename/$f2");
if($f1==$f3){
use File::Compare;
if(compare("$file_transload","$file_rename/$f2")==0){ #Compare files with equal bytes
if($identical_files=~/^rename$/i){
if($auto_rn eq 'yes'){
unlink("$file_transload");
$f4="$f2";
$is_s=~s/1/2/;
undef @f2;
}
}
elsif($identical_files=~/^\d+$/i){
if($ifl >= $identical_files){
unlink("$file_transload");
$f4="$f2";
$is_s=~s/1/2/;
undef @f2;
}
$ifl+=1;
}
elsif($identical_files=~/^\d+\,rename$/i){
if($auto_rn eq 'yes'){
unlink("$file_transload");
$f4="$f2";
$is_s=~s/1/2/;
undef @f2;
}
if($ifl >= $identical_files){
unlink("$file_transload");
$f4="$f2";
$is_s=~s/1/2/;
undef @f2;
}
$ifl+=1;
}
else{
unlink("$file_transload");
$f4="$f2";
$is_s=~s/1/2/;
undef @f2;
}
}
}
}# End of foreach $f2(@f2)
}# End of if(@f2)
}# unless($f2 eq "$cname")
if($is_s==2){
$ttpath="$tpath";
$ttpath=~s/^.*\\//g;
$ttpath=~s/^.*\///g;
undef $file_url;
if($identical_files=~/^\d+\,rename$/i){
$file_url="$t_url/$cname_gogo";
}else{
$file_url="$t_url/$f4";
}
$file_url=~s/ /\%20/g;
$push1="$random\|identical\|$identical_files\|$f_field\|$cname\|$ttpath\|$file_url\|$f3\|";
$push2="$automatic_rename\|$auto_rn\|$sf_rename\|$htm_cp\|$qfile";
push(@tlog,"$push1$push2");
}# End of if($is_s==2)
next if $is_s==2;
$transload_results='pF';
$file_url=~s/ /\%20/gi;
if("$size_limit" >= '0'){ #check if $max_size was reached
if($f1 >= "$size_limit"){
$dd='note'; #note if max size was reached
}}
$push3="$random\|results\|$cc_name\|$sf_rename\|$renamed_file\|$f_field\|$cname_gogo\|";
$push4="$cname\|$f1\|$dd\|$urlgo_go\|$url_go\|$file_url\|$htm_cp\|$qfile";
push(@tlog,"$push3$push4");
}#End of main loop
###############################################################################################
#Logging transloader transfers and attempts.
if(open(COPY,">>$controlfile")){
if(flock(COPY,LOCK_EX)){
if($szz=(-s "$log_file")){
$sz="$szz";
}
if(-r $log_file){
$rf="R " ;
}
if(-w $log_file){
$wf="W ";
}
if(-x $log_file){
$ef="E ";
}
if(@tlog){
push(@tlog,"$random\|logsp\|$sz\|$rf\|$wf\|$ef");
push(@tlog,"$random\|text_hlink\|$text\|$hlink");
}
if(!@tlog){
push(@nd_log,"$random\|logsp\|$sz\|$rf\|$wf\|$ef");
push(@nd_log,"$random\|text_hlink\|$text\|$hlink");
}
unless($sz > '1000000'){
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time);
if($mon=~/^[0-9]$/){
$mon=~s/$mon/0$mon/}
if($mday=~/^[0-9]$/){
$mday=~s/$mday/0$mday/}
if($hour=~/^[0-9]$/){
$hour=~s/$hour/0$hour/}
if($min=~/^[0-9]$/){
$min=~s/$min/0$min/}
if($sec=~/^[0-9]$/){
$sec=~s/$sec/0$sec/}
$year+=1900;
$logged_time="$year$mon$mday$hour$min$sec";
if(open(LOG,">>$log_file")){
flock(LOG,LOCK_EX);
seek (LOG,0,2);
if(@tlog){
$time_string=strftime"%a %b %d %H:%M:%S %Y",localtime;
print LOG"$random\|Date\|$time_string\|$logged_time\n";
print LOG join"\n",@tlog; print LOG"\n\n";
flock(LOG,LOCK_UN);
close(LOG);
flock(COPY,LOCK_UN);
close(COPY);
&continue
}
if(!@tlog){
$time_string=strftime"%a %b %d %H:%M:%S %Y",localtime;
print LOG"$random\|Date\|$time_string\|$logged_time\n";
print LOG join"\n",@nd_log;
print LOG"\n"; print LOG"No Data\n\n";
flock(LOG,LOCK_UN);
close(LOG);
flock(COPY,LOCK_UN);
close(COPY);
&continue
}
}}
elsif($sz > '1000000'){
sleep 1; #program sleeps one second to allow for traffic
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime(time);
if($mon=~/^[0-9]$/){
$mon=~s/$mon/0$mon/}
if($mday=~/^[0-9]$/){
$mday=~s/$mday/0$mday/}
if($hour=~/^[0-9]$/){
$hour=~s/$hour/0$hour/}
if($min=~/^[0-9]$/){
$min=~s/$min/0$min/}
if($sec=~/^[0-9]$/){
$sec=~s/$sec/0$sec/}
$year+=1900;
$logged_time="$year$mon$mday$hour$min$sec";
$arclog="$log_directory/$logged_time\.alog";
unless(-e "$arclog"){ #just a precaution
use File::Copy; #method-use File::Copy;
if(copy("$log_file","$arclog")){
use File::Compare; #method-use File::Compare;
if(compare("$log_file","$arclog")==0){
$time_strng=~s/$time_strng//;
if(open(LOG,">$log_file")){
flock(LOG,LOCK_EX);
seek (LOG,0,2);
$time_strng=strftime"%a %b %d %H:%M:%S %Y",localtime;
print LOG"4transload.pl Log File\n";
print LOG"Created:: $time_strng localtime\n";
print LOG"-------------------------------------------------------------------------------\n";
print LOG"\n\n";
}
}
elsif(open(LOG,">>$log_file")){
flock(LOG,LOCK_EX);
seek (LOG,0,2);
}
}
}
if(@tlog){
$time_string=strftime"%a %b %d %H:%M:%S %Y",localtime;
print LOG"$random\|Date\|$time_string\|$logged_time\n";
print LOG join"\n",@tlog; print LOG"\n\n";
flock(LOG,LOCK_UN);
close(LOG);
flock(COPY,LOCK_UN);
close(COPY);
&continue
}
if(!@tlog){
$time_string=strftime"%a %b %d %H:%M:%S %Y",localtime;
print LOG"$random\|Date\|$time_string\|$logged_time\n";
print LOG join"\n",@nd_log;
print LOG"\n"; print LOG"No Data\n\n";
flock(LOG,LOCK_UN);
close(LOG);
flock(COPY,LOCK_UN);
close(COPY);
&continue
}
}
}
}
#End of Logging
###############################################################################################
#Print Continue page
sub continue{
if($transload_results eq 'pF'){
open(FILE,">$temp_path/$random\.html"); #Print $random.html if a file was saved
print FILE"<html>\n\n";
print FILE"<head>\n";
print FILE"<meta http-equiv=\"Content-Type\"\n";
print FILE"content=\"text/html; charset=iso-8859-1\">\n";
print FILE"<meta name=\"GENERATOR\" content=\"Microsoft FrontPage Express 2.0\">\n";
print FILE"<title>Continue to Transload Results</title>\n";
print FILE"</head>\n\n";
print FILE"<body bgcolor=\"#F9F4F0\">\n\n";
print FILE"<p align=\"center\"><font size=\"4\" face=\"Book Antiqua\">Please\n";
print FILE"Continue To Results Page</font></p>\n\n";
print FILE"<p> </p>\n\n";
print FILE"<form\n";
print FILE"action=\"$continue_page\"\n";
print FILE"method=\"POST\">\n";
print FILE" <input type=\"hidden\" name=\"back\" value=\"back2\"><input\n";
print FILE" type=\"hidden\" name=\"logged_time\" value=\"$logged_time\"><input\n";
print FILE" type=\"hidden\" name=\"random\" value=\"$random\"><input\n";
print FILE" type=\"hidden\" name=\"time_string\" value=\"$time_string\"><p\n";
print FILE" align=\"center\"><input type=\"submit\" name=\"continue\"\n";
print FILE" value=\"Continue\"\n";
print FILE"style=\"font-family:Courier;font-size:medium;background:#FFFFFF\"></p>\n";
print FILE"</form>\n";
unless($text eq ""){
print FILE"\n";
print FILE"<p> </p>\n\n";
print FILE"<p align=\"center\"><font face=\"Arial\">$text</font></p>\n";
}
print FILE"</body>\n";
print FILE"</html>\n";
close(FILE);
print "Location:$temp_url/$random\.html\n\n";
exit;
}else{
print"Content-type:text/html\n\n";
print"<html>\n\n"; #Print cgi page if no file was saved
print"<head>\n";
print"<meta http-equiv=\"Content-Type\"\n";
print"content=\"text/html; charset=iso-8859-1\">\n";
print"<meta name=\"GENERATOR\" content=\"Microsoft FrontPage Express 2.0\">\n";
print"<title>Continue to Transload Results</title>\n";
print"</head>\n\n";
print"<body bgcolor=\"#F9F4F0\">\n\n";
print"<p align=\"center\"><font size=\"4\" face=\"Book Antiqua\">Please\n";
print"Continue To Results Page</font></p>\n\n";
print"<p> </p>\n\n";
print"<form\n";
print"action=\"$continue_page\"\n";
print"method=\"POST\">\n";
print" <input type=\"hidden\" name=\"back\" value=\"back2\"><input\n";
print" type=\"hidden\" name=\"logged_time\" value=\"$logged_time\"><input\n";
print" type=\"hidden\" name=\"random\" value=\"$random\"><input\n";
print" type=\"hidden\" name=\"time_string\" value=\"$time_string\"><p\n";
print" align=\"center\"><input type=\"submit\" name=\"continue\"\n";
print" value=\"Continue\"\n";
print"style=\"font-family:Courier;font-size:medium;background:#FFFFFF\"></p>\n";
print"</form>\n";
unless($text eq ""){
print"\n";
print"<p> </p>\n\n";
print"<p align=\"center\"><font face=\"Arial\">$text</font></p>\n";
}
print"</body>\n";
print"</html>\n";
exit;
}
}#End of sub continue