package Net::FullAuto::FA_Core;
### OPEN SOURCE LICENSE - GNU PUBLIC LICENSE Version 3.0 #######
#
# Net::FullAuto - Powerful Network Process Automation Software
# Copyright (C) 2011 Brian M. Kelly
#
# 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 3 of the License, or
# 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, see <http://www.gnu.org/licenses/>.
#
################################################################
## ******* Misc Notes ******************************************
## For Testing Multiple Iterations in a BASH shell environment
#
# num=0; while (( $num < 1000 )); do fullauto.pl --login *******
# --password --code hello_world --log; let num+=1;
# echo "FINISHED NUM=$num"; done
#
## For re-configuring CPAN:
#
# at CPAN prompt (cpan[1]) type: o conf init
#
## For creating gpg secret key for use with cpansign -s
#
# gpg --gen-key (then follow onscreen instructions)
#
# http://irtfweb.ifa.hawaii.edu/~lockhart/gpg/gpg-cs.html (gpg cheatsheet)
#
## For running CPAN with sudo
#
# sudo -i cpan (-i loads the root environment)
#
## For compiling into MSWin32 setup executable with PAR::Packager
#
# pp -c -o "Setup FullAuto MSWin32-x86.exe"
# -l C:\strawberry\perl\bin\libgcc_s_sjlj-1.dll Makefile.PL
# -a bin -a ChangeLog -a inc -a lib -a t -a META.yml
# -a LICENSE -a MANIFEST -a README --icon FA_Setup.ico
#
# http://download.oracle.com/berkeley-db/db-5.1.19.tar.gz
#
## For OpenSolaris - getting a dev environment
#
# pfexec pkg install ss-dev
#
## For Slow SSH on Cygwin
#
# verify that the fifth field in the user entry in /etc/passwd
# references the correct host name of the machine.
# loginId,U-WRONGHOSTNAME\loginId,S-1-5-21-...
# -to- loginId,U-RIGHTHOSTNAME\loginId,S-1-5-21...
#
# Also - in the /etc/ssh_config, set UseDNS to no.
#
## *************************************************************
use strict;
use warnings;
our $progname=substr($0,(rindex $0,'/')+1,-3);
our @tran=('','',0,$$."_".$^T,'',0);
$ENV{OS}='' if !$ENV{OS};
my $md_='';our $thismonth='';our $thisyear='';
($md_,$thismonth,$thisyear)=(localtime)[3,4,5];
my $mo_=$thismonth;my $yr_=$thisyear;
$md_="0$md_" if $md_<10;
$mo_++;$mo_="0$mo_" if $mo_<10;
my $yr__=sprintf("%02d",$yr_%100);
my $yr____=(1900+$yr_);
my $mdy="$mo_$md_$yr__";
my $mdyyyy="$mo_$md_$yr____";
my $tm=scalar localtime($^T);
my $hms=substr($tm,11,8);
$hms=~s/^(\d\d):(\d\d):(\d\d)$/h${1}m${2}s${3}/;
my $hr=$1;my $mn=$2;my $sc=$3;
our $curyear=$thisyear + 1900;
our $curcen=unpack('a2',$curyear);
our @invoked=($^T, $tm, $mdy, $hms, $hr, $mn, $sc, $mdyyyy);
BEGIN {
$main::netfull='';
unless (exists $INC{'Net/FullAuto.pm'}) {
foreach my $fpath (@INC) {
my $f=$fpath;
if (-e $f.'/Net/FullAuto.pm') {
$main::netfull=$f.'/Net/FullAuto.pm';
last;
}
}
} else {
$main::netfull=$INC{'Net/FullAuto.pm'};
}
}
BEGIN {
if ($^O eq 'MSWin32' || $^O eq 'MSWin64') {
print "\n FATAL ERROR! : Cygwin Linux Emulation Layer".
"\n is required to use FullAuto".
"\n on Windows - goto www.cygwin.com.".
"\n\n \(Be sure to install OpenSSH and the sshd ".
"service\).\n\n";
exit;
}
#use if ($^O eq 'cygwin'), 'Win32::Semaphore';
if ($^O eq 'cygwin') {
my $srvout=`/bin/cygrunsrv -Q cygserver 2>&1`;
if (-1<index $srvout,'Stopped') {
print "\nFatal Error: The Cygwin cygserver service is NOT",
" running:\n\n${srvout}To start type: 'net use cygserver'\n\n";
exit;
} elsif (-1<index $srvout,'The specified service does not exist') {
print "\nFatal Error: The Cygwin cygserver service is NOT",
" installed:\n\n${srvout}To install type: ",
"'/bin/cygserver-config'\n\n";
exit;
}
$srvout=`/bin/cygrunsrv -Q sshd 2>&1`;
if (-1<index $srvout,'Stopped') {
print "\nFatal Error: The Cygwin sshd (Secure Shell) service is NOT",
" running:\n\n${srvout}To start type: 'net use sshd'\n\n";
exit;
} elsif (-1<index $srvout,'The specified service does not exist') {
print "\nFatal Error: The Cygwin sshd (Secure Shell) service is NOT",
" installed:\n\n${srvout}To install type: ",
"'/bin/ssh-host-config --privileged'\n\n";
exit;
}
}
use IPC::Semaphore;
use IPC::SysV qw(IPC_CREAT SEM_UNDO S_IRWXU);
push @INC, substr($main::netfull,0,-3);
}
use warnings;
{
no warnings;
use Socket;
require Exporter;
}
our @ISA = qw(Exporter Net::Telnet Cwd);
our @EXPORT = qw(%Hosts $localhost getpasswd
connect_host get_all_hosts
$username connect_ftp $cron
connect_telnet connect_sftp
send_email $log connect_ssh
connect_secure connect_insecure
connect_reverse $prod $random
@invoked $cleanup pick Menu
$progname memnow acquire_semaphore
release_semaphore $savetran %hours
$increment %month ls_timestamp
cleanup $dest_first_hash %days
test_file test_dir timelocal
%GLOBAL @GLOBAL $MRLOG $^O
$funkyprompt handle_error
$quiet $batch $unattended
$passwd_file_loc $fullauto
%email_addresses @plans
%email_defaults $service
persist_get persist_put
$berkeleydb);
{
no warnings;
use BerkeleyDB;
use Sys::Hostname;
our $local_hostname=&Sys::Hostname::hostname;
use Data::Dump::Streamer;
use Time::Local;
use Crypt::CBC;
use Crypt::DES;
use Cwd qw(getcwd);
use Digest::MD5 qw(md5);
use Digest::SHA qw(sha256_hex);
use English;
use Email::Sender::Simple qw(sendmail);
use Email::Sender::Transport::SMTP qw();
use Errno qw(EAGAIN EINTR EWOULDBLOCK);
use File::stat;
use File::Copy;
use File::Path;
use MIME::Entity;
use Module::Load::Conditional qw[can_load];
use Net::Telnet;
use Getopt::Long;
use Pod::Usage;
use Term::ReadKey;
use Term::RawInput;
use LWP::UserAgent ();
use LWP::MediaTypes qw(guess_media_type media_suffix);
use URI ();
use HTTP::Date ();
use IO::Handle;
use IO::Select;
use IO::Capture::Stderr;
use IO::CaptureOutput;
use Capture::Tiny;
use String::Random;
use Symbol qw(qualify_to_ref);
use Tie::Cache;
use IO::Pty;
use POSIX qw(setsid uname);
};
our $home_dir='~';
if (exists $ENV{HOME} && -d $ENV{HOME}) {
$home_dir=$ENV{HOME};
} elsif (exists $ENV{USER} && $ENV{USER}) {
if (-d "/home/$ENV{USER}") {
$home_dir="/home/$ENV{USER}";
} elsif (-d "/export/home/$ENV{USER}") {
$home_dir="/export/home/$ENV{USER}";
}
} elsif ((getpwuid($<))[7]) {
$home_dir=(getpwuid($<))[7];
}
BEGIN {
my $md_='';our $thismonth='';our $thisyear='';
($md_,$thismonth,$thisyear)=(localtime)[3,4,5];
my $mo_=$thismonth;my $yr_=$thisyear;
$md_="0$md_" if $md_<10;
$mo_++;$mo_="0$mo_" if $mo_<10;
my $yr__=sprintf("%02d",$yr_%100);
my $yr____=(1900+$yr_);
my $mdy="$mo_$md_$yr__";
my $mdyyyy="$mo_$md_$yr____";
my $tm=scalar localtime($^T);
my $hms=substr($tm,11,8);
$hms=~s/^(\d\d):(\d\d):(\d\d)$/h${1}m${2}s${3}/;
my $hr=$1;my $mn=$2;my $sc=$3;
our $curyear=$thisyear + 1900;
our $curcen=unpack('a2',$curyear);
our @invoked=($^T, $tm, $mdy, $hms, $hr, $mn, $sc, $mdyyyy);
my $customdir='Net/FullAuto/Custom';
our $fa_conf='';
if (defined $Term::Menus::fa_conf) {
$fa_conf=$Term::Menus::fa_conf;
if (defined $fa_conf->[0]) {
eval {
require $fa_conf->[0];
my $mod=substr($fa_conf->[0],(rindex $fa_conf->[0],'/')+1,-3);
import $mod;
$fa_conf=$mod.'.pm';
};
}
}
our $fa_host='';
if (defined $Term::Menus::fa_host) {
$fa_host=$Term::Menus::fa_host;
if (defined $fa_host->[0]) {
eval {
require $fa_host->[0];
my $mod=substr($fa_host->[0],(rindex $fa_host->[0],'/')+1,-3);
import $mod;
$fa_host=$mod.'.pm';
};
}
}
our $fa_maps='';
if (defined $Term::Menus::fa_maps) {
$fa_maps=$Term::Menus::fa_maps;
if (defined $fa_maps->[0]) {
eval {
require $fa_maps->[0];
my $mod=substr($fa_maps->[0],(rindex $fa_maps->[0],'/')+1,-3);
import $mod;
$fa_maps=$mod.'.pm';
};
}
}
our $fa_menu='';
if (defined $Term::Menus::fa_menu) {
$fa_menu=$Term::Menus::fa_menu;
if (defined $fa_menu->[0]) {
eval {
require $fa_menu->[0];
my $mod=substr($fa_menu->[0],(rindex $fa_menu->[0],'/')+1,-3);
import $mod;
$fa_menu=$mod.'.pm';
};
}
}
our $bashpath='';
if (-e '/usr/bin/bash') {
$bashpath='/usr/bin/';
} elsif (-e '/bin/bash') {
$bashpath='/bin/';
} elsif (-e '/usr/local/bin/bash') {
$bashpath='/usr/local/bin/';
}
our $greppath='';
if (-e '/usr/bin/grep') {
$greppath='/usr/bin/';
} elsif (-e '/bin/grep') {
$greppath='/bin/';
} elsif (-e '/usr/local/bin/grep') {
$greppath='/usr/local/bin/';
}
our $findpath='';
if (-e '/usr/bin/find') {
$findpath='/usr/bin/';
} elsif (-e '/bin/find') {
$findpath='/bin/';
} elsif (-e '/usr/local/bin/find') {
$findpath='/usr/local/bin/';
}
our $lspath='';
if (-e '/usr/bin/ls') {
$lspath='/usr/bin/';
} elsif (-e '/bin/ls') {
$lspath='/bin/';
} elsif (-e '/usr/local/bin/ls') {
$lspath='/usr/local/bin/';
}
our $sedpath='';
if (-e '/usr/bin/sed') {
$sedpath='/usr/bin/';
} elsif (-e '/bin/sed') {
$sedpath='/bin/';
} elsif (-e '/usr/local/bin/sed') {
$sedpath='/usr/local/bin/';
}
our $printfpath='';
if (-e '/usr/bin/printf') {
$printfpath='/usr/bin/';
} elsif (-e '/bin/printf') {
$printfpath='/bin/';
} elsif (-e '/usr/local/bin/printf') {
$printfpath='/usr/local/bin/';
}
our $pspath='';
if (-e '/usr/bin/ps') {
$pspath='/usr/bin/';
} elsif (-e '/bin/ps') {
$pspath='/bin/';
} elsif (-e '/usr/local/bin/ps') {
$pspath='/usr/local/bin/';
}
our $sshpath='';
if (-e '/usr/bin/ssh') {
$sshpath='/usr/bin/';
} elsif (-e '/bin/ssh') {
$sshpath='/bin/';
} elsif (-e '/usr/local/bin/ssh') {
$sshpath='/usr/local/bin/';
}
our $telnetpath='';
if (-e '/usr/bin/telnet') {
$telnetpath='/usr/bin/';
} elsif (-e '/bin/telnet') {
$telnetpath='/bin/';
} elsif (-e '/usr/local/bin/telnet') {
$telnetpath='/usr/local/bin/';
}
our $sftppath='';our $sftpport='';
if (-e '/usr/bin/sftp') {
$sftppath='/usr/bin/';
$sftpport=`${sftppath}sftp 2>&1`;
} elsif (-e '/bin/sftp') {
$sftppath='/bin/';
$sftpport=`${sftppath}sftp 2>&1`;
} elsif (-e '/usr/local/bin/sftp') {
$sftppath='/usr/local/bin/';
$sftpport=`${sftppath}sftp 2>&1`;
}
if ($sftpport) {
if ($sftpport=~/-P sftp_server_path/s) {
$sftpport='-oPort=';
} else {
$sftpport='-P ';
}
}
our $ftppath='';
if (-e '/usr/bin/ftp') {
$ftppath='/usr/bin/';
} elsif (-e '/bin/ftp') {
$ftppath='/bin/';
} elsif (-e '/usr/local/bin/ftp') {
$ftppath='/usr/local/bin/';
}
our $mountpath='';
if (-e '/usr/bin/mount') {
$mountpath='/usr/bin/';
} elsif (-e '/bin/mount') {
$mountpath='/bin/';
} elsif (-e '/usr/local/bin/mount') {
$mountpath='/usr/local/bin/';
}
our $killpath='';
if (-e '/usr/bin/kill') {
$killpath='/usr/bin/';
} elsif (-e '/bin/kill') {
$killpath='/bin/';
} elsif (-e '/usr/local/bin/kill') {
$killpath='/usr/local/bin/';
}
our $stringspath='';
if (-e '/usr/bin/strings') {
$stringspath='/usr/bin/';
} elsif (-e '/bin/strings') {
$stringspath='/bin/';
} elsif (-e '/usr/local/bin/strings') {
$stringspath='/usr/local/bin/';
}
our $tarpath='';
if (-e '/usr/bin/tar') {
$tarpath='/usr/bin/';
} elsif (-e '/bin/tar') {
$tarpath='/bin/';
} elsif (-e '/usr/local/bin/tar') {
$tarpath='/usr/local/bin/';
}
our $xargspath='';
if (-e '/usr/bin/xargs') {
$xargspath='/usr/bin/';
} elsif (-e '/bin/xargs') {
$xargspath='/bin/';
} elsif (-e '/usr/local/bin/xargs') {
$xargspath='/usr/local/bin/';
}
our $pingpath='';
if ($^O eq 'cygwin') {
my $windir=$ENV{'WINDIR'};
$windir=~s/\\/\//g;
$pingpath="$windir/system32/";
} elsif (-e '/usr/bin/ping') {
$pingpath='/usr/bin/';
} elsif (-e '/bin/ping') {
$pingpath='/bin/';
} elsif (-e '/usr/local/bin/ping') {
$pingpath='/usr/local/bin/';
} elsif (-e '/etc/ping') {
$pingpath='/etc/';
} elsif (-e '/usr/sbin/ping') {
$pingpath='/usr/sbin/';
}
our $termwidth=''; our $termheight='';
if (!$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug) {
eval {
no strict 'subs';
($termwidth, $termheight) = GetTerminalSize(STDOUT);
};
if ($@) {
$termwidth='';$termheight='';
}
}
}
# Globally Scoped Variables, but Intentionally NOT Initialized.
# Getopt::Long needs it this way for some args to work properly.
our ($plan,$plan_ignore_error,$log,$cron,$edit,$version,$set,
$default,$facode,$faconf,$fahost,$famaps,$famenu,$passwrd,
$usrname,$import,$export,$VERSION,%GLOBAL,@GLOBAL);
# Globally Scoped and Intialized Variables.
our $blanklines='';our $oldpasswd='';our $authorize_connect='';
our $scrub=0;our $pcnt=0;our $chk_id='';our $d_sub='';
our $deploy_info='';our $f_sub='';our $updatepw=0;
our $shown='';our $websphere_not_running=0;my @hours=();
our $master_hostlabel='';our $random=0;our @plans=();
our $parent_menu='';our @menu_args=();our $savetran=0;
our $MRLOG='';our @pid_ts=();our %drives=();our @month=();
our $username='';our @passwd=('','');our %cygpathw=();
our $localhost={};our %localhost=();our %cygpathu=();
our @RCM_Link=();our @FTM_Link=();our $cleanup=0;our %Maps=();
our $starting_memory=0;our $custom_code_module_file='';
our %email_addresses=();our $debug=0;our %tiedb=();
our @ascii_que=();our $passetts=['','','','','','','','','',''];
our %Connections=();our $tranback=0;our @ascii=();our $uhray='';
our %base_excluded_dirs=();our %base_excluded_files=();
our %hours=();our %month=();our %Hosts=();our $berkeleydb='';
our %same_host_as_Master=("__Master_${$}__"=>'-','localhost'=>'-');
our @same_host_as_Master=();our $dest_first_hash='';
our %file_rename=();our %rename_file=();our $quiet='';
our %filerename=();our %renamefile=();our %fullmonth=();
our %Processes=();our %shellpids=();our %ftpcwd=();
our @DeploySMB_Proxy=('');our @DeployRCM_Proxy=('');
our @DeployFTM_Proxy=('');our $master_transfer_dir='';
our %perms=();our @ApacheNode=();our $test=0;our %days=();
our $prod=0;our $force_pause_for_exceed=0;our $tosspass=0;
our $timeout=30;our $cltimeout='X';our $slave=0;our $dcipher='';
our %email_defaults=();our $increment=0;our %tosspass=();
our $email_defaults='';our %semaphores=();our $batch='';
our $unattended='';our $fullauto='';our $service='';
our %base_shortcut_info=();our @dhostlabels=();our %monthconv=();
our %hourconv=();our @weekdays=();our %weekdaysconv=();
our $funkyprompt='\\\\137\\\\146\\\\165\\\\156\\\\153\\\\171\\\\120'.
'\\\\162\\\\157\\\\155\\\\160\\\\164\\\\137';
our $specialperms='none';
{
my $ex=$0;
if ($^O eq 'cygwin') {
$ex=~s/\.pl$/\.exe/;
} else {
$ex=~s/\.pl$//;
}
if (-u $ex) {
umask(077);
$specialperms='setuid';
} elsif (-g $ex) {
umask(007);
$specialperms='setgid';
}
};
%hours=('01'=>'01a','02'=>'02a','03'=>'03a','04'=>'04a',
'05'=>'05a','06'=>'06a','07'=>'07a','08'=>'08a',
'09'=>'09a','10'=>'10a','11'=>'11a','00'=>'12a',
'13'=>'01p','14'=>'02p','15'=>'03p','16'=>'04p',
'17'=>'05p','18'=>'06p','19'=>'07p','20'=>'08p',
'21'=>'09p','22'=>'10p','23'=>'11p','12'=>'12p',
'01a'=>'01','02a'=>'02','03a'=>'03','04a'=>'04',
'05a'=>'05','06a'=>'06','07a'=>'07','08a'=>'08',
'09a'=>'09','10a'=>'10','11a'=>'11','12a'=>'00',
'01p'=>'13','02p'=>'14','03p'=>'15','04p'=>'16',
'05p'=>'17','06p'=>'18','07p'=>'19','08p'=>'20',
'09p'=>'21','10p'=>'22','11p'=>'23','12p'=>'12');
@hours=('12:00am',' 1:00am',' 2:00am',' 3:00am',' 4:00am',
' 5:00am',' 6:00am',' 7:00am',' 8:00am',' 9:00am',
'10:00am','11:00am','12:00pm',' 1:00pm',' 2:00pm',
' 3:00pm',' 4:00pm',' 5:00pm',' 6:00pm',' 7:00pm',
' 8:00pm',' 9:00pm','10:00pm','11:00pm');
%hourconv=('12:00am'=>0,' 1:00am'=>1,' 2:00am'=>2,' 3:00am'=>3,
' 4:00am'=>4,' 5:00am'=>5,' 6:00am'=>6,' 7:00am'=>7,
' 8:00am'=>8,' 9:00am'=>9,'10:00am'=>10,'11:00am'=>11,
'12:00pm'=>12,' 1:00pm'=>13,' 2:00pm'=>14,' 3:00pm'=>15,
' 4:00pm'=>16,' 5:00pm'=>17,' 6:00pm'=>18,' 7:00pm'=>19,
' 8:00pm'=>20,' 9:00pm'=>21,'10:00pm'=>22,'11:00pm'=>23);
@weekdays=('Sunday ','Monday ','Tuesday ','Wednesday',
'Thursday ','Friday ','Saturday ');
%weekdaysconv=('Sunday '=>1,'Monday '=>2,'Tuesday '=>3,
'Wednesday'=>4,'Thursday '=>5,'Friday '=>6,
'Saturday '=>7);
%month=('01'=>'Jan','02'=>'Feb','03'=>'Mar','04'=>'Apr',
'05'=>'May','06'=>'Jun','07'=>'Jul','08'=>'Aug',
'09'=>'Sep','10'=>'Oct','11'=>'Nov','12'=>'Dec',
'Jan'=>'01','Feb'=>'02','Mar'=>'03','Apr'=>'04',
'May'=>'05','Jun'=>'06','Jul'=>'07','Aug'=>'08',
'Sep'=>'09','Oct'=>'10','Nov'=>'11','Dec'=>'12');
@month=('January ','February ','March ',
'April ','May ','June ','July ',
'August ','September','October ','November ',
'December ');
%monthconv=('January '=>1,'February'=>2,'March '=>3,
'April '=>4,'May '=>5,'June '=>6,
'July '=>7,'August '=>8,'September'=>9,
'October '=>10,'November'=>11,'December'=>12);
%fullmonth=('Jan'=>'January','Feb'=>'February','Mar'=>'March',
'Apr'=>'April','May'=>'May','Jun'=>'June',
'Jul'=>'July','Aug'=>'August','Sep'=>'September',
'Sept'=>'September','Oct'=>'October',
'Nov'=>'November','Dec'=>'December',
'January'=>'Jan','February'=>'Feb','March'=>'Mar',
'April'=>'Apr','May'=>'May','June'=>'Jun',
'July'=>'Jul','August'=>'Aug','September'=>'Sep',
'October'=>'Oct','November'=>'Nov',
'December'=>'Dec');
%days=('Mon'=>'Monday','Tue'=>'Tuesday','Tues'=>'Tuesday',
'Wed'=>'Wednesday','Thu'=>'Thursday','Thur'=>'Thursday',
'Thurs'=>'Thursday','Fri'=>'Friday','Sat'=>'Saturday',
'Sun'=>'Sunday','Monday'=>'Mon','Tuesday'=>'Tue',
'Wednesday'=>'Wed','Thursday'=>'Thu','Friday'=>'Fri',
'Sat'=>'Saturday','Sun'=>'Sunday');
%perms=('rwx'=>'7','rw-'=>'6','r-x'=>'5','r--'=>'4',
'-wx'=>'3','-w-'=>'2','--x'=>'1','---'=>'0',
'rwt'=>'7','rwT'=>'6','r-t'=>'5','r-T'=>'4',
'-wt'=>'3','-wT'=>'2','--t'=>'1','--T'=>'0',
'rws'=>'7','rwS'=>'6','r-s'=>'5','r-S'=>'4',
'-ws'=>'3','-wS'=>'2','--s'=>'1','--S'=>'0');
@ascii=(['10','012','061','060'],['11','013','061','061'],
['12','014','061','062'],['13','015','061','063'],
['14','016','061','064'],['15','017','061','065'],
['16','020','061','066'],['17','021','061','067'],
['18','022','061','070'],['19','023','061','071'],
['20','024','062','060'],['21','025','062','061'],
['22','026','062','062'],['23','027','062','063'],
['24','030','062','064'],['25','031','062','065'],
['26','032','062','066'],['27','033','062','067'],
['28','034','062','070'],['29','035','062','071'],
['30','036','063','060'],['31','037','063','061'],
['32','040','063','062'],['33','041','063','063'],
['34','042','063','064'],['35','043','063','065'],
['36','044','063','066'],['37','045','063','067'],
['38','046','063','070'],['39','047','063','071'],
['40','050','064','060'],['41','051','064','061'],
['42','052','064','062'],['43','053','064','063'],
['44','054','064','064'],['45','055','064','065'],
['46','056','064','066'],['47','057','064','067'],
['48','060','064','070'],['49','061','064','071'],
['50','062','065','060'],['51','063','065','061'],
['52','064','065','062'],['53','065','065','063'],
['54','066','065','064'],['55','067','065','065'],
['56','070','065','066'],['57','071','065','067'],
['58','072','065','070'],['59','073','065','071'],
['60','074','066','060'],['61','075','066','061'],
['62','076','066','062'],['63','077','066','063']);
#['64','100','066','064'],['65','101','066','065'],
#['66','102','066','066'],['67','103','066','067'],
#['68','104','066','070'],['69','105','066','071'],
#['70','106','067','060'],['71','107','067','061'],
#['72','110','067','062'],['73','111','067','063'],
#['74','112','067','064'],['75','113','067','065'],
#['76','114','067','066'],['77','115','067','067'],
#['78','116','067','070'],['79','117','067','071'],
#['80','120','070','060'],['81','121','070','061'],
#['82','122','070','062'],['83','123','070','063'],
#['84','124','070','064'],['85','125','070','065'],
#['86','126','070','066'],['87','127','070','067'],
#['88','130','070','070'],['89','131','070','071'],
#['90','132','071','060'],['91','133','071','061'],
#['92','134','071','062'],['93','135','071','063'],
#['94','136','071','064'],['95','137','071','065'],
#['96','140','071','066'],['97','141','071','067'],
#['98','142','071','070'],['99','143','071','071']);
@ascii_que=@ascii;
#if ($^O ne 'cygwin') {
# If using an exceed X-window launched from
# a desktop icon and configured to launch
# this script/program automatically, then
# set $force_pause_for_exceed to pause the
# script before a forced exit following an
# error condition.
#print "HOMEDIR=$home_dir and UID=$UID and EUID=$EUID\n";<STDIN>;
# open (FH,"<$home_dir/.sh_history") ||
# warn "Cannot open .sh_history file! : $!";
# my @command_history=<FH>;
# CORE::close(FH);
# foreach (@command_history) {
# if (/xterm/ and /$0/) {
# $force_pause=1;last;
# }
# }
#}
# our $maintainer='Brian Kelly';
# our $maintainer_phone='';
#@RCM_Link=('telnet');
#@RCM_Link=('ssh','telnet');
#@RCM_Link=('telnet','http');
# Options: telnet, ssh,
# telnet_proxy, ssh_proxy
# Order from left to right
# determines attempt order.
# Only one method is required.
#@FTM_Link=('ftp');
@FTM_Link=('sftp','ftp');
#@FTM_Link=('ftp','http');
# Options: ftp sftp
# ftp_proxy sftp_proxy
# Same as above.
my $count=0;
# Set Blanklines
if ($^O eq 'cygwin') {
while ($count++!=5) { $blanklines.="\n" }
} else {
while ($count++!=5) { $blanklines.="\n" }
}
# cleanup subroutine called during normal & abnormal terminations
sub cleanup {
my @topcaller=caller;
my $param_one=$_[0];
my $param_two=$_[1]||='';
my ($stdout,$stderr,$track)=('','','');
unless (defined $param_one) {
$param_one='';
}
print "\nINFO: main::cleanup() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::cleanup() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (keys %semaphores) {
foreach my $ipc_key (keys %semaphores) {
$ipc_key||='';
next if $ipc_key=~/^\s*$/;
if (-1<index $semaphores{$ipc_key},'IPC::') {
my $val=$semaphores{$ipc_key}->getval(0)||0;
if (1<$val) {
$semaphores{$ipc_key}->op(0,-1,&SEM_UNDO);
} else {
$semaphores{$ipc_key}->remove;
}
} else {
$semaphores{$ipc_key}->wait(0);
}
}
}
my $tm='';my $ob='';my %cleansync=();
my $new_cmd='';my $cmd='';my $clean_master='';
my @cmd=();my %did_tran=();
my $kill_arg=($^O eq 'cygwin')?'f':9;
foreach my $hostlabel (keys %Processes) {
foreach my $id (keys %{$Processes{$hostlabel}}) {
foreach my $type (reverse sort keys
%{$Processes{$hostlabel}{$id}}) {
my ($cnct_type,$id_type)=split /_/, $type;
my $show1="CNCT_TYPE=$cnct_type and HOSTLABEL=$hostlabel "
."and PROCESS=".$Processes{$hostlabel}{$id}{$type}
." and DeploySMB=$DeploySMB_Proxy[0]<==\n";
print $show1 if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG $show1 if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($cnct_type eq 'cmd'
&& $hostlabel eq $DeploySMB_Proxy[0]) {
my ($cmd_fh,$cmd_pid,$shell_pid,$cmd)=
@{$Processes{$hostlabel}{$id}{$type}};
if (defined fileno $cmd_fh) {
$cmd_fh->print("\004");
my $next=0;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
while (my $line=$cmd_fh->get) {
print $Net::FullAuto::FA_Core::MRLOG "cleanup() LINE_1=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$line=~s/\s*$//s;
last if $line=~/_funkyPrompt_$/s;
last if $line=~/Killed by signal 2\.$/s;
my ($stdout,$stderr)=('','');
($stdout,$stderr)=&kill($shell_pid,$kill_arg)
if &testpid($shell_pid);
if ($cmd_pid) {
if (&testpid($cmd_pid)) {
($stdout,$stderr)=&kill($cmd_pid,$kill_arg);
$next=1;return;
}
}
$cmd_fh->print("\003");
}
}; next if $next;
}
if ($@) {
print "clean_ERRORRRRR=$@\n" if $Net::FullAuto::FA_Core::debug;
}
if (exists $Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}) {
my $tmpdir=${$Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}}[0];
my $tdir=${$Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}}[1];
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"cd $tmpdir");
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"rm -rf $tdir");
}
foreach my $pid_ts (@pid_ts) {
$cmd_fh->cmd("rm -f *${pid_ts}*");
}
if ($cmd) {
# DO ps cmd and find pid and then kill
}
if ($Net::FullAuto::FA_Core::tran[0]
&& !exists $did_tran{$hostlabel}) {
$clean_master=1;
$clean_master=2 if $tran[2];
if ($tran[1] eq $hostlabel &&
$tran[1] ne "__Master_${$}__" && !exists
$same_host_as_Master{$tran[1]}) {
my $cmd="cd $tran[0] | sed -e "
."\'s/^/stdout: /\' 2>&1";
$cmd_fh->cmd($cmd);
$cmd_fh->cmd("rm -f transfer$tran[3]*tar");
if ($tran[2]) {
$cmd_fh->cmd('cd ..');
}
if ($tran[4] && !$savetran) {
$cmd_fh->cmd(
"cmd /c rmdir /s /q transfer$tran[3]");
if (&test_dir($cmd_fh,"transfer$tran[3]")) {
$cmd_fh->cmd(
"chmod -R 777 transfer$tran[3]");
$cmd_fh->cmd(
"cmd /c rmdir /s /q transfer$tran[3]");
}
}
} $did_tran{$hostlabel}='-';
} ($stdout,$stderr)=&kill($shell_pid,$kill_arg)
if &testpid($shell_pid);
}
if ($cnct_type eq 'ftm') {
my ($ftp_fh,$ftp_pid,$shell_pid,$ig_nore)=
@{$Processes{$hostlabel}{$id}{$type}};
if (defined fileno $ftp_fh) {
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
SC: while (defined fileno $ftp_fh) {
$ftp_fh->print("\004");
print "FTP_FH_ERRMSG=",$ftp_fh->errmsg,"\n" if $ftp_fh->errmsg
&& $Net::FullAuto::FA_Core::debug;
while (my $line=$ftp_fh->get) {
print $Net::FullAuto::FA_Core::MRLOG "cleanup() LINE_2=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last if $line=~/_funkyPrompt_$|
logout|221\sGoodbye/sx;
last SC if $line=~/Connection.*closed|Exit\sstatus\s0/s;
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last SC if $count++==20;
} else { $count=0 }
if ($^O eq 'cygwin' ||
(-1<index $line,'password:')) {
$ftp_fh->print("\004");
} else {
$ftp_fh->print('exit');
select(undef,undef,undef,0.02);
# sleep for 1/50th second;
}
}
}
};
if ($@) {
print "WHAT IS THE LINE_2 EVALERROR=$@<====\n" if $Net::FullAuto::FA_Core::debug;
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';
} else { $ftp_fh->close();die "$@ $!" }
}
}
if (($tran[0] || $hostlabel eq "__Master_${$}__")
&& !exists $did_tran{$hostlabel}) {
$clean_master=1;
if ($^O eq 'cygwin') {
$clean_master=2 if $tran[2];
$clean_master=3 if $tran[4]
&& $clean_master!=2;
} $did_tran{$hostlabel}='-';
}
($stdout,$stderr)=&kill($shell_pid,$kill_arg)
if &testpid($shell_pid);
($stdout,$stderr)=&kill($ftp_pid,$kill_arg)
if &testpid($ftp_pid);
$ftp_fh->close();
} else {
my ($cmd_fh,$cmd_pid,$shell_pid,$cmd)=
@{$Processes{$hostlabel}{$id}{$type}};
if (defined fileno $cmd_fh) {
my $gone=1;my $was_a_local=0;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
CC: while (defined fileno $cmd_fh) {
$cmd_fh->print($Net::FullAuto::FA_Core::printfpath.
"printf $funkyprompt");
while (my $line=$cmd_fh->get) {
print $Net::FullAuto::FA_Core::MRLOG "cleanup() LINE_3=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (-1<index $line,'logout') {
if (-1<index $line,'Exit status 0') {
last CC;
} else {
last;
}
} elsif ($line=~/221\sGoodbye/sx) {
last;
}
if ($line=~/_funkyPrompt_$/s) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&clean_filehandle($cmd_fh);
if ($cfh_error eq 'Exit status 0') {
last CC;
} else {
$cmd_fh->print("exit");
}
} elsif (($line=~/Killed|_funkyPrompt_/s) ||
($line=~/[:\$%>#-] ?$/s) ||
($line=~/sion denied.*[)][.]\s*$/s)) {
print $Net::FullAuto::FA_Core::MRLOG "cleanup() SHOULD BE LAST CC=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$gone=0;last CC;
} elsif (-1<index $line,'Exit status 0') {
last CC;
} elsif (-1<index $line,
'Connection to localhost closed') {
$was_a_local=1;
last CC;
} elsif ($line=~/Connection.*closed/s) {
last CC;
}
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last CC if $count++==20;
} else { $count=0 }
if (-1<index $line,'password:'
|| -1<index $line,'Permission denied') {
$cmd_fh->print("\004");
}
}
}
};
print "WOW I ACTUALLY GOT OUT3 and GONE=$gone and WASALOCAL=$was_a_local AND CMD_ERR=",
$cmd_fh->errmsg,"<==\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"cleanup() I AM OUT OF CC and EVALERR=$@ ".
"and WAS=$was_a_local and GONE=$gone<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($@) {
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';
} else { $cmd_fh->close();die "$@ $!" }
}
print $Net::FullAuto::FA_Core::MRLOG "cleanup() I GOT TO WAS A LOCAL\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (!$was_a_local && !$gone &&
exists $Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}) {
print $Net::FullAuto::FA_Core::MRLOG "IN !WASALOCAL AND !GONE<====\n";
print "IN !WASALOCAL AND !GONE<====\n";
my $tmpdir=${$Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}}[0];
my $tdir=${$Net::FullAuto::FA_Core::tmp_files_dirs{$cmd_fh}}[1];
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"cd $tmpdir");
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_fh,
_hostlabel=>[ $hostlabel,'' ] },"rm -rf $tdir");
}
if ($tran[0] && !exists $did_tran{$hostlabel}) {
$clean_master=1;
if ($^O eq 'cygwin') {
$clean_master=2 if $tran[2];
$clean_master=3 if $tran[4]
&& $clean_master!=2;
}
if (!$was_a_local && !$gone
&& $tran[1] eq $hostlabel &&
$tran[1] ne "__Master_${$}__" && !exists
$same_host_as_Master{$tran[1]}) {
my $cmd="cd $tran[0] | sed -e "
."\'s/^/stdout: /\' 2>&1";
$cmd_fh->print($cmd);
while (my $line=$cmd_fh->get) {
last if $line=~/_funkyPrompt_/;
}
$cmd_fh->cmd("rm -f transfer$tran[3]*tar")
if !$savetran;
if ($tran[2]) {
$cmd_fh->cmd('cd ..');
}
if ($tran[4]) {
$cmd_fh->cmd(
"cmd /c rmdir /s /q transfer$tran[3]")
if !$savetran;
if (&test_dir($cmd_fh,"transfer$tran[3]")) {
$cmd_fh->cmd(
"chmod -R 777 transfer$tran[3]");
$cmd_fh->cmd(
"cmd /c rmdir /s /q transfer$tran[3]")
if !$savetran;
}
}
} $did_tran{$hostlabel}='-';
} elsif ($tran[3] && !$savetran) {
if ($was_a_local) {
$localhost->cmd("rm -f transfer$tran[3]*tar");
} elsif (!$gone) {
if ($Net::FullAuto::FA_Core::alarm_sounded) {
print "WE ARE TRYING SOMETHING and ALRM SOUNDED\n";
$cmd_fh->print("\003");
print "WOW - GOT TO CLEAN_FILEHANDLE\n";
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_fh);
($stdout,$stderr)=&kill($shell_pid,$kill_arg);
($stdout,$stderr)=&kill($cmd_pid,$kill_arg);
print "GOT OUT OF CLEAN_FILEHANDLE\n";
last;
}
$cmd_fh->print("rm -f transfer$tran[3]*tar");
my $lin='';my $cownt=0;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
while (my $line=$cmd_fh->get) {
$lin.=$line;
$lin=~s/\s*$//s;
if ($lin=~/_funkyPrompt_/s ||
$lin=~/assword: ?$/m ||
$lin=~/Exit\sstatus\s0/m ||
$lin=~/sion denied.*[)][.]\s*$/s ||
$lin=~/[$|%|>|#|-|:] ?$/s) {
last;
} elsif ($lin=~/(Connection.+close.+)$|
Exit\sstatus\s-1$|
Killed\sby\ssignal\s2\.$/xm) {
my $one=$1;$one||='';
if ($one=~/local.+close/) {
$was_a_local=1;last;
} elsif ($one=~/Connection clo/) {
$gone=1;last;
}
} elsif ($cownt++<20) {
$gone=1;last;
} else { $cmd_fh->print("\003") }
}
};
}
}
print $Net::FullAuto::FA_Core::MRLOG "GOT EVEN FARTHER HERE\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($was_a_local) {
foreach my $pid_ts (@pid_ts) {
$localhost->cmd("rm -f *${pid_ts}*");
}
} elsif (!$gone) {
foreach my $pid_ts (@pid_ts) {
$cmd_fh->cmd("rm -f *${pid_ts}*");
}
}
if (!$was_a_local && !$gone) {
$cmd_fh->autoflush(1);
eval {
$cmd_fh->print('exit');
while (my $line=$cmd_fh->get) {
$line=~s/\s//g;
if ($line=~/onnection.*close/
|| $line=~/_funkyPrompt_/
|| $line=~/siondenied.*[)][.]$/
|| $line=~/logout/
|| $line=~/cleanup/
|| $line=~/Exitstatus(0|-1)/
|| $line=~/exit\s*$/s
|| $line=~/[$|%|>|#|-|:]$/) {
$cmd_fh->close;last;
}
}
};
}
if (&testpid($shell_pid)) {
eval {
print $Net::FullAuto::FA_Core::MRLOG
"WHAT IS SHELL_PID=$shell_pid "
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
};
print $Net::FullAuto::FA_Core::MRLOG
"LINE ".__LINE__." ERROR=$@\n"
if $@ && $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
eval {
$localhost->{_sh_pid}||='';
print $Net::FullAuto::FA_Core::MRLOG
"and \$\$=$$ and ".
"$localhost->{_sh_pid}\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
};
print $Net::FullAuto::FA_Core::MRLOG
"LINE ".__LINE__." ERROR=$@\n"
if $@ && $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($stdout,$stderr)=&kill($shell_pid,$kill_arg)
}
print $Net::FullAuto::FA_Core::MRLOG "GETTING READY TO KILL!!!!! CMD\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($stdout,$stderr)=&kill($cmd_pid,$kill_arg) if &testpid($cmd_pid);
}
}
}
}
}
if ($clean_master) {
print $Net::FullAuto::FA_Core::MRLOG
"INFO: &cleanup() GOING TO CLEAN MASTER\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($tran[3]) {
#$localhost->{_cmd_handle}->print("\003");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost->{_cmd_handle});
&handle_error("CLEANUP ERROR -> $cfh_error",'-1') if $cfh_error
&& (-1==index $cfh_error,'Connection to localhost closed');
($stdout,$stderr)=$localhost->cmd("cd $master_transfer_dir");
&handle_error("CLEANUP ERROR -> $stderr",'-1') if $stderr;
($stdout,$stderr)=
$localhost->cmd("rm -f transfer${tran[3]}*tar");
($stdout,$stderr)=
$localhost->cmd("rm -f transfer${tran[3]}*tar")
if $stderr;
&handle_error("CLEANUP ERROR -> $stderr",'-1') if $stderr;
if ($^O eq 'cygwin') {
if ($clean_master==2) {
$localhost->cmd('cd ..');
}
if ($clean_master==2 || $clean_master==3) {
$localhost->cmd(
"cmd /c rmdir /s /q transfer$tran[3]");
if (&test_dir($localhost->{_cmd_handle},
"transfer$tran[3]")) {
$localhost->cmd(
"chmod -R 777 transfer$tran[3]");
$localhost->cmd(
"cmd /c rmdir /s /q transfer$tran[3]")
if !$savetran;
}
}
}
}
foreach my $pid_ts (@pid_ts) {
$localhost->cmd("rm -f *${pid_ts}*");
}
}
($stdout,$stderr)=&kill($localhost->{_cmd_pid},$kill_arg);
#($stdout,$stderr)=$localhost->cmd('hostname');
#print "LOCALHOSTSTDOUT=$stdout<== and LOCALHOSTSTDERR=$stderr<==\n";
($stdout,$stderr)=&kill($localhost->{_sh_pid},$kill_arg);
%{$localhost}=();undef $localhost;
%Processes=();
%Connections=();
@pid_ts=();
if (defined $master_hostlabel &&
defined $username) {
&scrub_passwd_file($master_hostlabel,
$username);
}
if ($Net::FullAuto::FA_Core::makeplan) {
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_plans.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);
my $plan_number=$Net::FullAuto::FA_Core::makeplan->{'Number'}||'';
my $plan_title =$Net::FullAuto::FA_Core::makeplan->{'Title'}||'';
my $put_plan=Data::Dump::Streamer::Dump(
$Net::FullAuto::FA_Core::makeplan)->Out();
if ($plan_number) {
my $pregx=qr/\]quit\[|INT|ERROR/;
unless ($Net::FullAuto::FA_Core::plan_ignore_error) {
$pregx=qr/\]quit\[|INT/;
}
unless ($param_two=~/$pregx/) {
my $status=$bdb->db_put($plan_number,$put_plan);
print "\n\n ################ NEW PLAN ##################\n\n",
" Number: $plan_number\n",
" Title: $plan_title\n\n",
" WAS SUCCESSFULLY CREATED!\n";
}
}
undef $bdb;
$dbenv->close();
undef $dbenv;
}
if ((!$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet) {
if ($^O ne 'cygwin') {
print "\n";
} else {
print "\n\n";
}
} ReadMode 0;
print $Net::FullAuto::FA_Core::MRLOG "INFO: GOING TO CLOSE LOG\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$MRLOG||='';
CORE::close($MRLOG) if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$MRLOG='';
$Hosts{"__Master_${$}__"}{'LogFile'}||='';
print "\n LOGFILE ==> \"",$Hosts{"__Master_${$}__"}{'LogFile'},"\"\n\n\n"
if $Net::FullAuto::FA_Core::log && !($Net::FullAuto::FA_Core::quiet ||
$Net::FullAuto::FA_Core::cron);
print "FullAuto COMPLETED SUCCESSFULLY on ".localtime()."\n"
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
if (!$Net::FullAuto::FA_Core::log
&& exists $Hosts{"__Master_${$}__"}{'LogFile'}
&& $Hosts{"__Master_${$}__"}{'LogFile'}) {
unlink $Hosts{"__Master_${$}__"}{'LogFile'};
}
return 1 if $param_one;
exit 0;
};
# Handle INT SIGNAL interruption
$SIG{ INT } = sub{
print "\n\nCAUGHT AN INTERUPT SIGNAL!!\n";
print $Net::FullAuto::FA_Core::MRLOG
"\n\n=============================",
"\n==== INTERUPT SIGNAL ====",
"\n=============================\n\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&release_semaphore(6543);
$cleanup=1;&cleanup('','INT') };
our $alarm_sounded=0;
$SIG{ ALRM } = sub{ open(AL,">>ALRM.txt");
print AL scalar(localtime())."\n";
close AL;
$alarm_sounded=1;
print "CAUGHT AN ALRM!! FROM ",caller,"\n";
$cleanup=1;&cleanup('','ALRM') };
$SIG{ CHLD } = 'IGNORE';
my @Hosts=@{&check_Hosts($Net::FullAuto::FA_Core::fa_host)};
sub grep_for_string_existence_only
{
my $file=$_[0];
my $pattern=$_[1];
my $return_value=0;
eval {
open(FH,"<$file") || return 0;
my $keygen_flag=0;
while (my $line=<FH>) {
if ($line=~/^\[1\]|ssh-rsa/) {
$keygen_flag=1;
last;
}
if ($line=~/$pattern/) {
$return_value=1;
last;
}
}
if ($keygen_flag) {
my ($stdout,$stderr)=('','');
my $output=`ssh-keygen -F localhost 2>&1`;
$return_value=1 if $output=~/localhost|^\[1\]|ssh-rsa/s;
}
};
return $return_value;
}
sub version
{
can_load(modules => { "Net::FullAuto" => 0 });
my $version=<<VERSION;
This is Net::FullAuto, v$Net::FullAuto::VERSION
(See fullauto -V or fa -V for more detail)
Copyright 2000-2011, Brian M. Kelly
FullAuto may be copied only under the terms of the GNU General Public License,
which may be found in the FullAuto source distribution.
Complete documentation for FullAuto, including FAQ lists, should be found on
this system using "man fullauto" or "perldoc fullauto". If you have access
to the Internet, point your browser at http://www.fullautosoftware.net/, the
FullAuto Home Page.
VERSION
print $version;
exit;
}
sub VERSION
{
can_load(modules => { "Term::Menus" => 0 });
can_load(modules => { "Net::FullAuto" => 0 });
my $term_menus_path=
substr($INC{'Term/Menus.pm'},0,
(rindex $INC{'Term/Menus.pm'},'Term'));
my $net_fulla_path=
substr($INC{'Net/FullAuto.pm'},0,
(rindex $INC{'Net/FullAuto.pm'},'Net'));
$term_menus_path=~s/\/share\//\/lib\//
if -1<index $term_menus_path,'share';
my $o='';
foreach my $p (@INC) {
$o=$p;
last if -1<index $o,$term_menus_path;
last if "$o/" eq $term_menus_path;
}
my @tmlist=();
if (-f $o.'/auto/Term/Menus/.packlist') {
open (TH,"<$o/auto/Term/Menus/.packlist");
while (my $f=<TH>) {
chomp $f;
push @tmlist,$f;
}
close(TH);
}
my @falist=();
if (-f $o.'/auto/Net/FullAuto/.packlist') {
open (PH,"<$o/auto/Net/FullAuto/.packlist");
@falist=<PH>;
close(PH);
}
my @pl=();my @exe=();my @O=();my %Cust=();my @Dist=();
my @Tpm=();my @html=();my @Core=();my @README=();
foreach my $file (@falist) {
chomp $file;
if ($file=~/\.pm$/) {
if (-1<index $file,'Distro') {
push @Dist, $file;next;
} elsif (-1<index $file,'Custom') {
$Cust{$file}='';next;
} else { push @Core, $file;next }
} elsif ($file=~/\.pl$/) {
push @pl, $file;next;
} elsif ($file=~/fullauto(?:\.exe)*$/) {
push @exe, $file;next;
} elsif ($file=~/1$/) {
push @O, $file;next;
} elsif ($file=~/html$/) {
push @html, $file;next;
} elsif ($file=~/3pm/) {
push @Tpm, $file;next;
} elsif (-1<index $file,'README') {
if (-1<index $file,'Custom/README') {
my $path=$file;
$path=~s/\/[^\/]+$//;
opendir(my $dh, $path) || die "can't opendir $path: $!";
while (my $file=readdir($dh)) {
$Cust{"$path/$file"}='' if $file!~/^[.]|README$/
&& -f "$path/$file";
}
closedir $dh;
}
push @README, $file;
}
}
print "\nTerm::Menus Version $Term::Menus::VERSION\n",
(join "\n",@tmlist),"\n\n",
"Net::FullAuto Version $Net::FullAuto::VERSION\n",
(join "\n",@pl),"\n",
(join "\n",@exe),"\n\n";
print '',(join "\n",@O),"\n" if -1<$#O;
print '',(join "\n",@Tpm),"\n",
(join "\n",@html),"\n",
(join "\n",@README),"\n\n",
(join "\n",sort @Dist),"\n\n",
(join "\n",sort keys %Cust),"\n\n",
(join "\n",reverse @Core),"\n";
exit;
}
sub pick
{
return &Menus::pick(@_);
}
sub Menu
{
#print "FAMENUCALLER=",caller,"\n";
can_load(modules => { "Term::Menus" => 0 });
return &Term::Menus::Menu(@_);
}
sub get_today
{
my @what=split / +/, scalar localtime(time);
my $day=$days{$what[0]};
my $month=$fullmonth{$what[1]};
my $what="$day, $month $what[2], $what[4]";
return $what;
}
sub get_tomorrow
{
my $t=time+86400;
my @what=split / +/, scalar localtime($t);
my $day=$days{$what[0]};
my $month=$fullmonth{$what[1]};
my $what="$day, $month $what[2], $what[4]";
return $what;
}
sub get_now_am_pm
{
my $t=unpack('a5',(split / +/, scalar localtime(time))[3]);
my $i=unpack('a2',$t);
if ($i<12) {
substr($t,0,1)='' if $i<10;
return $t.'am';
} elsif ($i==12) {
return $t.'pm';
} else {
substr($t,0,2)=unpack('a2',$t)-12;
return $t.'pm';
}
}
sub ls_timestamp
{
my $line=$_[0];my $size='';
my $mn='';my $dy='';my $time='';my $fileyr='';
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;
if ($line=~s/^.*\s+($rx1|$rx2)$/$1/) {
$line=~/^(\d+)\s+(\w\w\w)\s+(\d+)\s+(\d\d:\d\d\s+|\d\d\d\d\s+)+.*$/;
$size=$1;$mn=$Net::FullAuto::FA_Core::month{$2};$dy=$3;$time=$4;
}
my $hr=12;my $mt='00';
if (length $time==4) {
$fileyr=$time;
} else {
($hr,$mt)=unpack('a2 @3 a2',"$time");
my $yr=unpack('x1 a2',"$Net::FullAuto::FA_Core::thisyear");
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
} elsif ($Net::FullAuto::FA_Core::thismonth==$mn-1) {
my $filetime=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);
if (time()<$filetime) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
}
}
}
return $size, timelocal(0,$mt,$hr,$dy,$mn-1,$fileyr);
}
sub find_berkeleydb_recover {
print "find_berkeleydb_recover CALLER=",caller,"\n";<STDIN>;
my @topcaller=caller;
my $hlab="localhost - ".hostname;
print "\nINFO: main::find_berkeleydb_recover() (((((((CALLER))))))) ".
"for HostLabel $hlab:\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::find_berkeleydb_recover() (((((((CALLER))))))) ".
"for HostLabel $hlab:\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $berkeleydb_perl_module_lib='';
if ((defined $fa_conf::berkeleydb_perl_module_lib) &&
($fa_conf::berkeleydb_perl_module_lib) &&
(-f $fa_conf::berkeleydb_perl_module_lib)) {
$berkeleydb_perl_module_lib=$fa_conf::berkeleydb_perl_module_lib;
} else {
require ExtUtils::Installed;
my ($inst) = ExtUtils::Installed->new();
my @db_path = grep { /\.dll|\.so/ } $inst->files("BerkeleyDB");
if (-f $db_path[0] && (-f $Hosts{"__Master_${$}__"}{'FA_Core'}.
"Custom/$Net::FullAuto::FA_Core::fa_conf")) {
$berkeleydb_perl_module_lib=$db_path[0];
my $fconf=$Hosts{"__Master_${$}__"}{'FA_Core'}.'Custom/'.
$Net::FullAuto::FA_Core::fa_conf;
open(CH,"+<$fconf") or &handle_error("Cannot open $fconf");
flock CH, 2;
my @data=<CH>;
my $bd=0;my @new=();
foreach my $ln (@data) {
my $l=$ln;
if (($bd==0) &&
($l=~/^\s*[#]*\s*our\s+[\$]berkeleydb_perl_module_lib\s*=/)) {
push @new, "our \$berkeleydb_perl_module_lib = \"".
$db_path[0]."\";\n";
$bd=1;
} else {
push @new, $l;
}
}
unless ($bd) {
@new=();
foreach my $ln (@data) {
my $l=$ln;
if (($bd==0) &&
($l=~/^\s*[#]*\s*our\s*(?!ISA|VERSION|EXPORT)/)) {
push @new, "our \$berkeleydb_perl_module_lib = \"".
$db_path[0]."\";\n";
push @new, $ln;
$bd=1;
} else {
push @new, $ln;
}
}
}
seek CH, 0, 0;
truncate CH, 0;
print CH @new;
close CH;
}
}
my $bcmd="${Net::FullAuto::FA_Core::stringspath}strings ".
"$berkeleydb_perl_module_lib ".
"| ${Net::FullAuto::FA_Core::greppath}grep Release";
my $bver=`$bcmd`;
$bver=~s/^.*?version \d+\.\d+\.(.*?)\.\d+:.*$/$1/s;
if ((defined $fa_conf::berkeleydb) &&
($fa_conf::berkeleydb) && (-d $fa_conf::berkeleydb)) {
if (-1<index $fa_conf::berkeleydb,$bver) {
if (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_recover';
} elsif (-f $fa_conf::berkeleydb.'/db_recover') {
return $fa_conf::berkeleydb.'/db_recover';
}
} elsif (-d $fa_conf::berkeleydb.'/include') {
if (-f $fa_conf::berkeleydb.'/include/db.h') {
my $dbh=$fa_conf::berkeleydb.'/include/db.h';
open(FH,"<$fa_conf::berkeleydb/include/db.h")
or &handle_error(
"Cannot open $fa_conf::berkeleydb/include/db.h");
my @finc=<FH>;
close(FH);
foreach my $line (@finc) {
if ($line=~/^.*VERSION.*$bver.*$/) {
if (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_recover';
} elsif (-f $fa_conf::berkeleydb.'/db_recover') {
return $fa_conf::berkeleydb.'/db_recover';
}
}
}
&handle_error("Cannot Locate BerkeleyDB installation");
} elsif (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_recover';
} elsif (-f $fa_conf::berkeleydb.'/db_recover') {
return $fa_conf::berkeleydb.'/db_recover';
} else {
&handle_error("Cannot Locate BerkeleyDB db_recover utility");
}
} elsif (-d $fa_conf::berkeleydb.'/bin') {
return $fa_conf::berkeleydb.'/bin/db_recover';
} elsif (-f $fa_conf::berkeleydb.'/db_recover') {
return $fa_conf::berkeleydb.'/db_recover';
} elsif ($^O eq 'cygwin' && (-f "/bin/db${bver}_recover.exe")) {
return "/bin/db${bver}_recover.exe";
} else {
&handle_error("Cannot Locate BerkeleyDB db_recover utility");
}
} else {
my @output=();
my $testgrep =`${Net::FullAuto::FA_Core::greppath}grep -H 2>&1`;
my $testgrep2=`${Net::FullAuto::FA_Core::greppath}grep 2>&1`;
my $grepopt='';
if ((-1==index $testgrep,'illegal option')
&& (-1==index $testgrep2,'-insvxbhwyu')) {
$grepopt='-H ';
}
my $find_cmd1="${Net::FullAuto::FA_Core::findpath}find ";
my $find_cmd2=" -name \"*.h\" ".
"| ${Net::FullAuto::FA_Core::xargspath}xargs ".
"${Net::FullAuto::FA_Core::greppath}grep ".
"${grepopt}DB_VERSION_STRING";
print "\nSearching for latest verison of BerkeleyDB.\n".
"This may take up to five minutes ...\n\n";
foreach my $dir ('/usr/local/',
'/usr/','/opt/',(getpwuid $>)[7].'/') {
next if unpack('a1',$dir) eq '.';
next unless -d $dir;
opendir(DIR, $dir) or die $!;
while (my $file = readdir(DIR) ) {
next if ($file eq "." or $file eq ".." or $file eq "doc" or
$file eq "X11R6" or $file eq "docs" or
$file eq "man" or $file eq "ssl" or
$file eq "license" or $file eq "logfile" or
$file eq "bin" or ($^O eq 'cygwin' &&
($file eq "Application Data" or
$file eq "Favorites" or $file eq
"Local Settings" or $file eq "Recent" or
$file eq "Start Menu" or $file eq "SendTo" or
$file eq "NetHood" or $file eq "PrintHood")));
if (-d $dir.$file) {
print "Searching $dir$file ...\n";
my @subout=`$find_cmd1\"$dir$file\"$find_cmd2`;
if (-1<$#subout) {
require CPAN::Config;
my $ccon=(defined $CPAN::Config &&
exists $CPAN::Config->{cpan_home})?
$CPAN::Config->{cpan_home}:'';
my @vers=();my %verhash=();
foreach my $version (@subout) {
next if (-1<index $version, $ccon) ||
(-1<index $version, 'Net-FullAuto-') ||
$version!~/db.h:.*DB_VERSION_STRING/;
my @fileparts=split 'db.h:', $version;
$fileparts[1]=~s/^.*DB (\d+[^:]+):.*$/$1/;
if (-1<index $fileparts[1], $bver) {
my $bintest=$subout[0];
substr($bintest,(rindex $bintest,'include'))='bin';
$berkeleydb=substr($bintest,0,-4)
if -d $bintest;
}
}
}
}
last if $berkeleydb;
} last if $berkeleydb;
}
$berkeleydb||='';
if ($berkeleydb) {
my $fconf=$Hosts{"__Master_${$}__"}{'FA_Core'}.'Custom/'.
$Net::FullAuto::FA_Core::fa_conf;
open(CH,"+<$fconf") or &handle_error("Cannot open $fconf");
flock CH, 2;
my @data=<CH>;
my $bd=0;my @new=();
foreach my $ln (@data) {
if (($bd==0) && ($ln=~/^\s*[#]*\s*our\s+[\$]berkeleydb\s*=/)) {
push @new, "our \$berkeleydb = \"$berkeleydb\";\n";
$bd=1;
} else {
push @new, $ln;
}
}
unless ($bd) {
@new=();
foreach my $ln (@data) {
my $l=$ln;
if (($bd==0) &&
($l=~/^\s*[#]*\s*our\s+(?!ISA|VERSION|EXPORT)/)) {
push @new, "our \$berkeleydb = \"".
$berkeleydb."\";\n";
push @new, $ln;
$bd=1;
} else {
push @new, $ln;
}
}
}
seek CH, 0, 0;
truncate CH, 0;
print CH @new;
close CH;
}
return $berkeleydb.'/bin/db_recover';
}
}
sub edit {
eval {
die;
};
my $path=$@;
$path=~s/Died at (.*)FA_Core.pm.*$/$1/;
my $username=getlogin || getpwuid($<);
chomp($path);
my $cpath=$path."Custom/$username/";
my $tpath=$path;
$tpath=~s/Net.*//;
our $fa_code='';
our $fa_conf='';
our $fa_host='';
our $fa_maps='';
our $fa_menu='';
require Term::Menus;
if (defined $Term::Menus::fa_conf) {
$fa_conf=$Term::Menus::fa_conf;
if (-d $tpath.'Net/FullAuto/Custom/'.$username) {
eval {
require 'Net/FullAuto/Custom/'.$username.'/Conf/'.$fa_conf;
my $mod=substr($fa_conf,(rindex $fa_conf,'/')+1,-3);
import $mod;
$fa_conf=$mod.'.pm';
};
if ($@) {
die "ERROR=$@\n";
}
}
}
if (defined $Term::Menus::fa_code) {
$fa_code=$Term::Menus::fa_code;
}
if (defined $Term::Menus::fa_host) {
$fa_host=$Term::Menus::fa_host;
}
if (defined $Term::Menus::fa_maps) {
$fa_maps=$Term::Menus::fa_maps;
}
if (defined $Term::Menus::fa_menu) {
$fa_menu=$Term::Menus::fa_menu;
}
my $editor='';
$fa_conf::editor||='';
unless ($editor=$fa_conf::editor) {
if ($^O eq 'cygwin') {
my $mount=`/bin/mount -p`;
$mount=~s/^.*(\/\S+).*$/$1/s;
if (-e $mount.
'/c/Program Files/Windows NT/Accessories/wordpad.exe') {
$editor=$mount.
'/c/Program Files/Windows NT/Accessories/wordpad.exe';
} elsif (-e '/bin/vim-nox.exe') {
$editor='/bin/vim-nox.exe';
}
} else {
if (-e '/usr/bin/vi') {
$editor='/usr/bin/vi';
} elsif (-e '/bin/vi') {
$editor='/bin/vi';
} elsif (-e '/usr/bin/emacs') {
$editor='/usr/bin/emacs';
}
}
}
my $savdir=Cwd::cwd();
if ($_[0]=~/ho*s*t*|^fa_host$/i) {
$cpath.='Host';
system("cd $cpath;\"$editor\" ".
"$fa_host;cd \"$savdir\"");
} elsif ($_[0]=~/^m$|^me$|^men$|^menu$|^fa_menu$/i) {
$cpath.='Menu';
$fa_menu=~s/^(fa_.*)_demo(.pm)$/$1$2/
unless -f "$cpath./$fa_menu";
system("cd $cpath;\"$editor\" ".
"$fa_menu;cd \"$savdir\"");
} elsif ($_[0]=~/map*s*|^fa_maps$/i) {
$cpath.='Maps';
system("cd $cpath;\"$editor\" ".
"$fa_maps;cd \"$savdir\"");
} elsif ($_[0]=~/^c$|^co$|^cod$|^code$|^fa_code$/i) {
$cpath.='Code';
$fa_code=~s/^(fa_.*)_demo(.pm)$/$1$2/
unless -f "$cpath./$fa_code";
system("cd $cpath;\"$editor\" ".
"$fa_code;cd \"$savdir\"");
} elsif ($_[0]=~/con*f*|^fa_conf$/i) {
$cpath.='Conf';
system("cd $cpath;\"$editor\" ".
"$fa_conf;cd \"$savdir\"");
} elsif ($_[0]=~/f/) {
system("cd $path;\"$editor\" FA_Core.pm;cd \"$savdir\"");
} elsif ($_[0]=~/t/) {
system("cd ${tpath}Term;\"$editor\" Menus.pm;cd \"$savdir\"");
} else {
my $stderr='';my $stdout='';
chdir $cpath;
($stdout,$stderr)=cmd("${Net::FullAuto::FA_Core::lspath}ls -lR");
die $stderr if $stderr;
my @files=split "\n", $stdout;
my @file=();my $dirr='';
foreach my $file (@files) {
next if $file=~/^\s*$/;
next if unpack('a1',$file) eq 'd';
next if $file=~/^total/;
next if $file eq '.:';
if (unpack('a2',$file) eq './') {
$dirr=unpack('x2a*',$file);
chop($dirr);
next;
}
chomp($file);
next if $file=~/\/$/;
next if $file eq 'README';
$file=~s/^.*\d\d:\d\d\s+(.*)$/$1/;
push @file,$username.'/'.$dirr.'/'.$file;
}
my %Menu_1=(
Label => 'Menu_1',
Item_1 => {
Text => "]C[",
Convey => \@file,
},
Select => 'One',
Banner => "\n Choose a File to Edit :"
);
my $file=Menu(\%Menu_1);
if ($file eq ']quit[') {
print "\n";
exit;
}
chdir '..';
system("\"$editor\" $file");
chdir $savdir;
}
exit;
}
my $today=unpack('x2a2',$invoked[7]);
my $curmonth=unpack('a2',$invoked[7]);
my $fullmonth=$month[$curmonth-1];
$fullmonth=~s/\s*$//;
my $todays_date="$fullmonth $today, $curyear";
my $endyear=$curyear + 20;
my %mdates=();
my $lastday='';
my $showmins=sub { package showmins;
my $datechosen=']P[';
$datechosen=~s/^(?:Today|Tomorrow) - //;
$datechosen=~s/^[A-Za-z]+, //;
my @hrmn=();
if ($datechosen eq $todays_date) {
my $now=unpack('a2',(split ':',
&Net::FullAuto::FA_Core::get_now_am_pm)[1]);
$now++;
foreach my $hr (@hours[$invoked[4]..23]) {
foreach my $mn ($now..59) {
if (length $mn==1) {
$mn='0'.$mn;
}
push @hrmn, unpack('a3',$hr).$mn.unpack('x5a2',$hr);
} $now=0;
} return @hrmn;
} else {
foreach my $hr (@hours[0..23]) {
foreach my $mn (0..59) {
if (length $mn==1) {
$mn='0'.$mn;
}
push @hrmn, unpack('a3',$hr).$mn.unpack('x5a2',$hr);
}
} return @hrmn;
}
};
my $hours=sub { package hours;
my $date_chosen=']P[';
$date_chosen=~s/^(?:Today|Tomorrow) - //;
$date_chosen=~s/^[A-Za-z]+, //;
if ($date_chosen eq $todays_date) {
my $in=$invoked[4]+1;
return (@hours[$in..23])
} else { return @hours } };
my $cal_months=sub { package cal_months;
my $yr=']P[';
my @munths=();
my $cmonth=$curmonth-1;
if ($curyear==$yr) {
if ($curmonth==12) {
@munths=$month[11];
} else {
@munths=@month[$cmonth..11];
}
} else {
@munths=@month;
}
my @new=map { $_.' '.']P[' } @munths;
return @new };
my $currmonth=$curmonth;
foreach my $year ($curyear..$endyear) {
my $cnt=0;
if ($year ne $curyear) {
$currmonth=1;
} else {
$cnt=$currmonth-1;
}
foreach my $mth ($currmonth..12) {
$lastday=POSIX::mktime(0,0,0,0,$mth-1+1,$year-1900,0,0,-1);
my $d=localtime($lastday);
my @d=split ' ',$d;
$mdates{$year}{$month[$cnt++]}=$d[2];
}
}
my $fulldays=sub { package fulldays;
my ($a,$b)=('','');
($a,$b)=split / +/, ']P[';
my $c=pack('A9',$a);
my @n=();
my $s=1;
$s=$today if $b eq $curyear &&
-1<index $month[$curmonth-1],$a;
foreach my $d ($s..$mdates{$b}{$c}) {
$d='0'.$d if length $d==1;
push @n, $a.' '.$d.', '.$b;
}
return @n };
sub plan {
print "PLANCALLER=",caller,"\n";
#my $bcmd="${Net::FullAuto::FA_Core::stringspath}strings ".
# "$Net::FullAuto::FA_Core::berklib ".
# "| ${Net::FullAuto::FA_Core::greppath}grep Release";
#my $bver=`$bcmd`;
#$bver=~s/^.*?version \d+\.\d+\.(.*?)\.\d+:.*$/$1/s;
my $track='';
my %new_plan_options_menu=(
Label => 'new_plan_options_menu',
Item_1 => {
Text => 'Set Optional Maximum Number of Invocations',
},
Item_2 => {
Text => 'Set Optional Expiration Date and/or Time',
},
Item_3 => {
Text => 'Set Authorized Users of this Plan',
},
);
my %select_min_for_invocation=(
Label => 'select_min_for_invocation',
Item_1=> {
Text => "]C[",
Convey => $showmins,
Result => sub{ return 'select_min_for_invocation '.
']P[{one_time_launch} '.
']S[ | ]P[{choose_from_fullauto_plans}' }
},
Banner=> " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Job Invocation Time :",
);
my %select_hour_for_invocation=(
Label => 'select_hour_for_invocation',
Item_1=> {
Text => "Show Minutes",
Result => \%select_min_for_invocation,
},
Item_2=> {
Text => "]C[",
Convey => $hours,
Result => sub{ return 'select_hour_for_invocation '.
']P[{one_time_launch} '.
']S[ | ]P[{choose_from_fullauto_plans}' }
},
Banner=> " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Job Invocation Time for\n\n ]P[ :",
);
my %select_cal_mins_for_plan=(
Label => 'select_cal_mins_for_plan',
Item_1=> {
Text => "]C[",
Convey => $showmins,
Result => sub{ return 'select_cal_mins_for_plan '.
']|[ ]P[{select_cal_months_for_plan} '.
']|[ ]P[{select_cal_days_for_plan} '.
']|[ ]P[{select_cal_hours_for_plan} ]|[ '.
']S[ ]|[ ]P[{choose_from_fullauto_plans}' }
},
Banner=> " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Job Invocation Time :",
);
my %select_cal_hours_for_plan=(
Label => 'select_cal_hours_for_plan',
Item_1=> {
Text => "Show Minutes",
Negate => [ 'Item_2' ],
Result => \%select_cal_mins_for_plan,
},
Item_2=> {
Text => "]C[",
Convey => $hours,
Negate => [ 'Item_1' ],
Result => sub{ return 'select_cal_hours_for_plan '.
']|[ ]P[{select_cal_months_for_plan} '.
']|[ ]P[{select_cal_days_for_plan} ]|[ '.
']S[ ]|[ ]P[{choose_from_fullauto_plans}' }
},
Banner=> " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Job Invocation Time :",
);
my %select_cal_days_for_plan=(
Label => 'select_cal_days_for_plan',
Item_1=> {
Text => "]C[",
Convey => $fulldays,
Result => \%select_cal_hours_for_plan,
},
Banner=> ' Please Select a Job cal_days Invocation Time :'
);
my %select_cal_months_for_plan=(
Label => 'select_cal_months_for_plan',
Item_1=> {
Text => "]C[",
Convey => $cal_months,
Result => \%select_cal_days_for_plan,
},
Banner=> ' Please Select a Month :'
);
my %calendar_years_for_plan=(
Label => 'calendar_years_for_plan',
Item_1=> {
Text => "]C[",
Convey => [$curyear..$endyear],
Result => \%select_cal_months_for_plan,
},
Banner=> ' Please Select a Year :'
);
my %select_recurrent_minutes=(
Label => 'select_recurrent_minutes',
Item_1=> {
Text => "Minute ]C[",
#Convey => $showmins,
Convey => [0..59],
Result => sub{ return '][[ select_recurrent_minutes '.
']|[ ]P[{select_recurrent_months} '.
']|[ ]P[{select_recurrent_weekdays} '.
']|[ ]P[{select_recurrent_days} '.
']|[ ]P[{select_recurrent_hours} ]|[ '.
']S[ ]|[ ]P[{choose_from_fullauto_plans} ]][' }
},
Select=> "Many",
Banner=> " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Select the --MINUTE(S)-- of the Day Where\n\n ".
"Plan - ]P[{choose_from_fullauto_plans}".
"\n\n Will be Run :",
);
my %select_recurrent_hours=(
Label => 'select_recurrent_hours',
#Item_1=> {
# Text => "Show Minutes",
# Negate => [ 'Item_2' ],
# Result => \%select_recurrent_minutes,
#},
Item_1 => {
Text => 'Hour ]C[',
Convey => $hours,
Result => \%select_recurrent_minutes,
#Negate => [ 'Item_1' ],
#Result => sub{ return 'select_recurrent_hours '.
# ']|[ ]P[{select_recurrent_months} '.
# ']|[ ]P[{select_recurrent_days} ]|[ '.
# ']S[ ]|[ ]P[{choose_from_fullauto_plans}' }
},
Select => 'Many',
Banner => " Select the --HOUR(S)-- of the Day Where\n\n ".
"Plan - ]P[{choose_from_fullauto_plans}".
"\n\n Will be Run :",
);
my %select_recurrent_days=(
Label => 'select_recurrent_days',
Item_1 => {
Text => 'Day ]C[',
Convey => [1..31],
Result => \%select_recurrent_hours,
},
Select => 'Many',
Banner => " Select the --DAY(S)-- of the Month Where\n\n ".
"Plan - ]P[{choose_from_fullauto_plans}".
"\n\n Will be Run :",
);
my %select_recurrent_weekdays=(
Label => 'select_recurrent_weekdays',
Item_1 => {
Text => ']C[',
Convey => \@weekdays,
Result => \%select_recurrent_days,
},
Select => 'Many',
Banner => " Select the --WEEKDAY(S)-- Where\n\n ".
"Plan - ]P[{choose_from_fullauto_plans}".
"\n\n Will be Run :",
);
my %select_recurrent_months=(
Label => 'select_recurrent_months',
Item_1 => {
Text => ']C[',
Convey => \@month,
Result => \%select_recurrent_weekdays,
},
Select => 'Many',
Banner => " Select the --MONTH(S)-- where\n\n ".
"Plan - ]P[{choose_from_fullauto_plans}".
"\n\n Will be Run :",
);
my %one_time_launch=(
Label => 'one_time_launch',
Item_1 => {
Text => 'FULL CALENDAR',
Result => \%calendar_years_for_plan,
},
Item_2 => {
Text => "]C[",
Convey => sub { return 'Today - '.&get_today() },
Result => \%select_hour_for_invocation,
},
Item_3 => {
Text => "]C[",
Convey => sub { return 'Tomorrow - '.&get_tomorrow() },
Result => \%select_hour_for_invocation,
},
Banner => " Select Invocation Time for\n\n ".
"Plan - ]P[{choose_from_fullauto_plans}",
);
my %select_type_of_scheduled_plan=(
Label => 'select_type_of_scheduled_plan',
Item_1 => {
Text => 'This Plan will Launch Recurrently',
Result => \%select_recurrent_months,
},
Item_2 => {
Text => 'This Plan will Launch One Time Only',
Result => \%one_time_launch,
},
Banner => " Select Type of Scheduled Job for\n\n Plan - ]P["
);
my %choose_from_fullauto_plans=(
Label => 'choose_from_fullauto_plans',
Item_1 => {
Text => "]C[",
Convey => sub { return @{&Net::FullAuto::FA_Core::getplans()} },
Result => \%select_type_of_scheduled_plan,
},
Banner => " Select a Plan to Schedule:",
);
my %setup_new_sched_job_menu=(
Label => 'setup_new_sched_job_menu',
Item_1 => {
Text => 'Choose a FullAuto Plan to Schedule',
Result => \%choose_from_fullauto_plans,
},
Item_2 => {
Text => 'Choose a FullAuto Custom Code Block to Schedule',
},
Item_3 => {
Text => 'Set up a Non-FullAuto Task to Schedule',
},
Banner => ' Select a Task to Perform',
);
my %plan_menu=(
Label => 'plan_menu',
Item_1 => {
Text => 'Accept Defaults and Create New Plan',
#Result => sub { return '' },
},
Item_2 => {
Text => 'Set Options for New Plan',
Result => \%new_plan_options_menu,
},
Item_3 => {
Text => 'Set Up a New Scheduled Job',
Result => \%setup_new_sched_job_menu,
},
Item_4 => {
Text => 'Work with Existing Plans',
},
Item_5 => {
Text => 'Work with Existing Scheduled Jobs',
},
Banner => " FullAuto Job Planning Menu\n\n".
" \"Always plan ahead. It wasn\'t raining when Noah\n".
" built the ark.\" - Richard C. Cushing\n\n".
" Plan: Indicated by a Plan Number, A FullAuto \"Plan\"\n".
" is a Complete Job Definition composed of recorded\n".
" User interaction Menu choices and Input. FullAuto\n".
" \"Plans\" allow otherwise manual/interactive processes\n".
" to be run unattended when FullAuto is started with\n".
" the --cron or --unattended or --fullauto options.\n\n".
" Job: A FullAuto \"Scheduled Job\" is a fully unattended\n".
" invocation of a pre-created \"Plan\". Not all Plans\n".
" are \"Scheduled Jobs\", but all \"Scheduled Jobs\" are\n".
" directed by a \"Plan\". FullAuto uses external cron\n".
" for it's scheduling engine.",
);
my $output=&Menu(\%plan_menu);
&cleanup() if $output=~/\]quit\[/i;
#print "WHAT IS OUTPUTFRESH=$output\n";
my $outp=join ' ', @{$output} if ref $output eq 'ARRAY';
print "OUTPUT=$outp\n" if defined $outp && $outp;
if ($output ne ']quit[') {
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_plans.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);
my $new_plan_number=0;
my ($k,$v) = ('','') ;
if ($output eq 'Accept Defaults and Create New Plan') {
my $cursor = $bdb->db_cursor() ;
my $status=$cursor->c_get($k, $v, DB_LAST);
$new_plan_number=++$k;
undef $cursor;
my $plann={ 'Number' =>$new_plan_number,
'Created'=>$Net::FullAuto::FA_Core::invoked[2],
'Creator'=>$Net::FullAuto::FA_Core::username,
'Host' =>$Net::FullAuto::FA_Core::local_hostname,
'Plan' =>[] };
undef $bdb;
$dbenv->close();
undef $dbenv;
return $plann;
} elsif ($output eq 'Work with Existing Plans') {
my $plans=getplans($bdb);
if (-1<$#{$plans}) {
my %existing=(
Label => 'existing',
Item_1=> {
Text => "]C[",
Convey => $plans
},
Banner=> ' Select a Plan to work with:'
);
my $outp=Menu(\%existing);
undef $bdb;
$dbenv->close();
undef $dbenv;
undef $Net::FullAuto::FA_Core::makeplan;
&cleanup();
} else {
print "\n\n ########################### NOTE ".
"###########################\n\n".
" *NO* Plans have been \"made\" with ".
"this FullAuto installation.\n\n";
&cleanup();
}
} elsif (ref $output eq 'ARRAY' && $output->[0]
eq 'select_recurrent_minutes') {
my ($monthstring,$weekdaysstring,$daystring,
$hourstring,$minstring,$weekstring)=
('','','','','');
if (ref $output->[1] eq 'ARRAY') {
if ($#{$output->[1]}==11) {
$monthstring='*';
} elsif ($#{$output->[1]}==0) {
$monthstring=$monthconv{${$output->[1]}[0]};
} else {
my $cnt=$monthconv{${$output->[1]}[0]};
my $save_start=$cnt;
foreach my $month (@{$output->[1]}) {
unless ($cnt++==$monthconv{$month}) {
$save_start=-1;
}
$monthstring.=$monthconv{$month}.',';
}
if (-1<$save_start) {
$monthstring=$save_start.'-'.
$monthconv{${$output->[1]}
[$#{$output->[1]}]};
} else {
chop $monthstring;
}
}
} else {
$monthstring=$monthconv{$output->[1]};
}
if (ref $output->[2] eq 'ARRAY') {
if ($#{$output->[2]}==6) {
$weekdaysstring='*';
} elsif ($#{$output->[2]}==0) {
$weekdaysstring=$weekdaysconv{${$output->[2]}[0]};
} else {
my $cnt=$weekdaysconv{${$output->[2]}[0]};
my $save_start=$cnt;
foreach my $weekday (@{$output->[2]}) {
unless ($cnt++==$weekdaysconv{$weekday}) {
$save_start=-1;
}
$weekdaysstring.=$weekdaysconv{$weekday}.',';
}
if (-1<$save_start) {
$weekdaysstring=$save_start.'-'.
$weekdaysconv{${$output->[2]}
[$#{$output->[2]}]};
} else {
chop $weekdaysstring;
}
}
} else {
$weekdaysstring=$weekdaysconv{$output->[2]};
}
if (ref $output->[3] eq 'ARRAY') {
if ($#{$output->[3]}==30) {
$daystring='*';
} elsif ($#{$output->[3]}==0) {
$daystring=unpack('x5 a*',${$output->[3]}[0]);
} else {
my $cnt=unpack('x5 a*',${$output->[3]}[0]);
my $save_start=$cnt;
foreach my $day (@{$output->[3]}) {
$day=unpack('x5 a*',$day);
unless ($cnt++==$day) {
$save_start=-1;
}
$daystring.=$day.',';
}
if (-1<$save_start) {
$daystring=$save_start.'-'.
${$output->[3]}[$#{$output->[3]}];
} else {
chop $daystring;
}
}
} else {
$daystring=unpack('x5 a*',{$output->[3]});
}
if (ref $output->[4] eq 'ARRAY') {
if ($#{$output->[4]}==23) {
$hourstring='*';
} elsif ($#{$output->[4]}==0) {
$hourstring=$hourconv{${$output->[4]}[0]};
} else {
my $cnt=$hourconv{unpack('x6 a*',${$output->[4]}[0])};
my $save_start=$cnt;
foreach my $hour (@{$output->[4]}) {
unless ($cnt++==$hourconv{unpack('x6 a*',$hour)}) {
$save_start=-1;
}
$hourstring.=$hourconv{unpack('x6 a*',$hour)}.',';
}
if (-1<$save_start) {
$hourstring=$save_start.'-'.
$hourconv{unpack('x6 a*',${$output->[4]}
[$#{$output->[4]}])};
} else {
chop $hourstring;
}
}
} else {
$hourstring=$hourconv{unpack('x6 a*',$output->[4])};
}
if (ref $output->[5] eq 'ARRAY') {
if ($#{$output->[5]}==59) {
$minstring='*';
} elsif ($#{$output->[5]}==0) {
$minstring=unpack('x8 a*',${$output->[5]}[0]);
} else {
my $cnt=unpack('x8 a*',${$output->[5]}[0]);
my $save_start=$cnt;
foreach my $minute (@{$output->[5]}) {
$minute=unpack('x8 a*',$minute);
unless ($cnt++==$minute) {
$save_start=-1;
}
$minstring.=$minute.',';
}
if (-1<$save_start) {
$minstring=$save_start.'-'.
${$output->[5]}[$#{$output->[5]}];
} else {
chop $minstring;
}
}
} else {
$minstring=unpack('x8 a*',$output->[5]);
}
my $planstring=$output->[6];
my $cronstring=$minstring.' '.$hourstring.' '.$daystring.' '.
$monthstring.' '.$weekdaysstring;
print "CRONSTRING=$cronstring\n";
our $crontabpath='';
if (-e '/usr/bin/crontab') {
$crontabpath='/usr/bin/';
} elsif (-e '/bin/crontab') {
$crontabpath='/bin/';
} elsif (-e '/usr/local/bin/crontab') {
$crontabpath='/usr/local/bin/';
}
my ($stdout,$stderr)=('','');
($stdout,$stderr)=cmd("${crontabpath}crontab -l");
#print "WAHT IS CRONTABSTDOUT=$stdout\n";
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Jobs') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Jobs');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Jobs',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_jobs.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);
if ($stderr && -1<index $stderr,'no crontab') {
$planstring=~tr/ //s;
my $plnn=$planstring;
$plnn=~s/^(\d+).*$/$1/;
my $dig=sha256_hex("$cronstring /usr/local/bin/fa --login ".
"$username --password --plan $plnn");
($stdout,$stderr)=cmd($Net::FullAuto::FA_Core::printfpath.
"printf \"# FullAuto Plan $planstring \]|\[ $dig\012".
"$cronstring /usr/local/bin/fa --login $username ".
"--password --plan $plnn\012\"".'| crontab -');
} elsif ($stdout=~/^\s*[^#].*$/m) {
my $line='';
foreach my $line (split "\n", $stdout) {
if ($line=~/^\s*[#]/) {
next if (-1<index $line,'# DO NOT EDIT T');
next if $line=~/^# \(.* installed on /;
next if (-1<index $line,'# (Cron version');
print "COMMENTED LINE=$line\n";
my @plancom=split ' ',$line;
my $plnum='';my $chksum='';
print "WHAT IS THIS=$plancom[$#plancom-2]\n";
if ($plancom[$#plancom-1] eq ']|[') {
$chksum=$plancom[$#plancom];
$plnum=$plancom[3];
}
print "PLAN=$plnum and CHKSUM=$chksum\n";
} else {
print "UNCOMMENTED LINE=$line<==\n";
my $tesline=sha256_hex($line);
print "TESTLINE=$tesline<==\n";
}
#print "LINE=$line\n";
}
print "WE GOT CRON CONTENTS=$stdout<==\n";
}
print "STDOUTCRONT=$stdout<==\n";
print "STDERRCRONT=$stderr<==\n";
}
undef $Net::FullAuto::FA_Core::makeplan;
&cleanup();
} else {
undef $Net::FullAuto::FA_Core::makeplan;
&cleanup();
}
}
sub persist_get {
my $track='';
my $key=$_[0]||'';
&handle_error("Missing Arguements: ".
"&persist_get\(\[key\]\)")
unless $key;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_persist.db",
-Flags => DB_CREATE,
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);
$key.='&';
$key.=join '&', caller;
$key.='&'.$Net::FullAuto::FA_Core::local_hostname.$username;
my $value='';
my $status=$bdb->db_get($key,$value);
$value||='';
undef $bdb;
$dbenv->close();
undef $dbenv;
return ($value,$key,$status);
}
sub persist_put {
my $key=$_[0]||'';
my $value=$_[1]||'';
&handle_error("Missing Arguements: ".
"&persist_put\(".
"\[key_returned_from_persist_get\],".
"\[string_to_persist\]\)")
unless $key && $value;
my $track='';
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Persist',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_persist.db",
-Flags => DB_CREATE,
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);
my $status=$bdb->db_put($key,$value);
undef $bdb;
$dbenv->close();
undef $dbenv;
return $status;
}
sub openplandb {
print "openplandb CALLER=",caller,"\n";
my $track='';
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_plans.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);
return $bdb;
}
sub getplans {
my $bdb=openplandb;
my $cursor=$bdb->db_cursor();
my @plans=();
my ($k,$v)=('','');
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
$v=~s/\$HASH\d*\s*=\s*//s;
my $planhash=eval $v;
$planhash->{'Title'}||='';
push @plans, pack('A10',$k).$planhash->{'Title'};
}
undef $cursor;
return \@plans;
}
sub sysreadline(*;$) {
my($handle, $timeout) = @_;
$handle = qualify_to_ref($handle, caller());
my $infinitely_patient = (@_ == 1 || $timeout < 0);
my $start_time = time();
my $selector = IO::Select->new();
$selector->add($handle);
my $line = '';
SLEEP:
until (at_eol($line)) {
unless ($infinitely_patient) {
return $line if time() > ($start_time + $timeout);
}
#sleep only 1 second before checking again
next SLEEP unless $selector->can_read(1.0);
INPUT_READY:
while ($selector->can_read(0.0)) {
my $was_blocking = $handle->blocking(0);
CHAR: while (sysread($handle, my $nextbyte, 1)) {
$line .= $nextbyte;
last CHAR if $nextbyte eq "\n";
}
$handle->blocking($was_blocking);
# if incomplete line, keep trying
next SLEEP unless at_eol($line);
last INPUT_READY;
}
}
return $line;
} sub at_eol($) { $_[0] =~ /\n\z/ }
sub acquire_semaphore
{
my @topcaller=caller;
print "acquire_semaphore() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "acquire_semaphore() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $sem='';
my $IPC_KEY=(defined $_[0] && $_[0])?$_[0]:'1234';
my $process_description=$_[1]||'';
my $semaphorecount=$_[2];
my $semaphore_count;
$semaphore_count=(defined $semaphorecount && 0<$semaphorecount) ?
$semaphorecount : 1;
&handle_error(("IPC Semaphore FATAL ERROR:\n\n"
." semaphore count argument must greater than zero\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__')
if $semaphore_count<1;
my $semaphore_timeout=$_[3]||180;
if (0) {
#if ($^O eq 'cygwin') {
# try to open a semaphore
my $sem=Win32::Semaphore->open($IPC_KEY);
if (defined $sem && $sem) {
# wait for semaphore to be zero
my $previous='';
if ($semaphore_count<2) {
if ($process_description
&& ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet)) {
print
"\n\n Status: Waiting for lock release. Another FullAuto",
"\n process has a lock on ",$process_description,
"\n . . .\n\n";
}
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($timeout-1);
my $stim=$semaphore_timeout * 1000;
$sem->wait($stim);
sleep 2;
alarm(0);
};
if ($@) {
&handle_error(("Win32 Semaphore Timed Out:\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
}
} elsif (!$sem->release(1,$previous)) {
&handle_error(("FATAL ERROR: Maximum Number of FullAuto Processes"
." Exists:\n\n"
." Maximum Number => $semaphore_count\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
}
}
# create a semaphore
--$semaphore_count if 1<$semaphore_count;
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}=
Win32::Semaphore->new(0,$semaphore_count,$IPC_KEY)
|| &handle_error(("Could not create Win32 Semaphore: $!\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
} else {
# create a semaphore
unless ($IPC_KEY=~/^\d+$/) {
$IPC_KEY=sha256_hex($IPC_KEY);
$IPC_KEY=~s/[A-Z|a-z]//g;
$IPC_KEY=substr($IPC_KEY,0,4);
}
$sem = IPC::Semaphore->new($IPC_KEY,$semaphore_count,&S_IRWXU);
if (defined $sem && $sem) {
if ($semaphore_count<2) {
if ($process_description
&& ((!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet)) {
print
"\n\n Status: Waiting for lock release. Another FullAuto",
"\n process has a lock on ",$process_description,
"\n . . .\n",
"\n (Hint: If lock fails to release in a reasonable",
"\n time period, use command line tools 'ipcs'",
"\n and 'ipcrm' to investigate and resolve, or",
"\n simply restart the host computer)\n";
}
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($timeout-1);
# Decrement the semaphore count by 1
my $success=
$sem->op(0,-1,&SEM_UNDO);
# blocks if semaphore is zero
my $result = int $!; # capture the value of errno
$success||=0;$result||=0;
if (!$success && $result == &EINTR) {
die $result;
}
sleep 2;
alarm(0);
};
if ($@) {
&handle_error(("IPC Semaphore Timed Out:\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
}
} else {
my $value=$sem->getval(0);
if ($semaphore_count<=$value) {
# semaphore was zero, no slots available
&handle_error(
("FATAL ERROR: Maximum Number of FullAuto Processes"
." Exists:\n\n"
." Maximum Number => $semaphore_count: $!\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
} else {
$sem->op(0,1,&SEM_UNDO);
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}=$sem;
}
}
} else {
# create a semaphore
$sem=IPC::Semaphore->new(
$IPC_KEY,$semaphore_count,&S_IRWXU|&IPC_CREAT)
|| &handle_error(("Could not create IPC Semaphore\n\n"
." Called by " . join ' ', @topcaller),'__cleanup__');
$sem->op(0,1,&SEM_UNDO) if 1<$semaphore_count;
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}=$sem;
}
}
return $sem
}
sub test_semaphore
{
my @topcaller=caller;
print "test_semaphore() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "test_semaphore() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $IPC_KEY=$_[0];
$IPC_KEY||=1234;
my $opstring='';
my $opstring1='';
my $opstring2='';
my $semnum=0;
my $semop=0;
my $semflag=0;
if ($^O eq 'cygwin') {
# try to open a semaphore
if (Win32::Semaphore->open($IPC_KEY)) {
return 1;
} else {
return 0;
}
} elsif (0) {
}
}
sub release_semaphore
{
my @topcaller=caller;
print "release_semaphore() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "release_semaphore() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $IPC_KEY=$_[0]||0;
my $semaphore_timeout=$_[1]||180;
if (exists $Net::FullAuto::FA_Core::semaphores{$IPC_KEY}) {
if (0) {
#if ($^O eq 'cygwin') {
# Increment the semaphore count by 1
# Destroy the semaphore
my $previous='';
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}->release(1,$previous);
delete $Net::FullAuto::FA_Core::semaphores{$IPC_KEY};
# once past this point, any process waiting can proceed
} else {
# Increment the semaphore count by 1
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}->op(0,1,&SEM_UNDO);
$Net::FullAuto::FA_Core::semaphores{$IPC_KEY}->remove;
delete $Net::FullAuto::FA_Core::semaphores{$IPC_KEY};
# once past this point, any process waiting can proceed
}
}
}
sub kill
{
my @topcaller=caller;
print "\nINFO: main::kill() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::kill() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $pid=$_[0];my $arg=$_[1]||'';my $cmd=[];
my $stdout='';my $ignore='';
my $killpath=$Net::FullAuto::FA_Core::killpath;
if (exists $Hosts{"__Master_${$}__"}{'kill'}) {
$killpath=$Hosts{"__Master_${$}__"}{'kill'};
$killpath.='/' if $killpath!~/\/$/;
}
my $bashpath=$Net::FullAuto::FA_Core::bashpath;
if (exists $Hosts{"__Master_${$}__"}{'bash'}) {
$bashpath=$Hosts{"__Master_${$}__"}{'bash'};
$bashpath.='/' if $bashpath!~/\/$/;
}
my $sedpath=$Net::FullAuto::FA_Core::sedpath;
if (exists $Hosts{"__Master_${$}__"}{'sed'}) {
$sedpath=$Hosts{"__Master_${$}__"}{'sed'};
$sedpath.='/' if $sedpath!~/\/$/;
}
if ($pid) {
if ($arg) {
if ($^O eq 'cygwin') {
$cmd=[ "${killpath}kill -$arg $pid" ]
} else {
$cmd=[ "${bashpath}bash",'-c',
"\"${killpath}kill -$arg $pid\" 2>&1" ]
}
} else {
if ($^O eq 'cygwin') {
$cmd=[ "${killpath}kill $pid" ]
} else {
$cmd=[ "${bashpath}bash",'-c',
"\"${killpath}kill $pid\" 2>&1" ]
}
}
}
print $Net::FullAuto::FA_Core::MRLOG "BEFOREKILL -> ",join ' ',@{$cmd},"\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $mystdout='';
IO::CaptureOutput::capture sub {
($ignore,$stdout)=&setuid_cmd($cmd,5);
}, \$mystdout;
$stdout||='';
if (wantarray) {
return $stdout,'';
} else { return $stdout }
}
sub testpid
{
my @topcaller=caller;
print "\nINFO: main::testpid() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::testpid() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $pid=$_[0];
if (!$pid) {
if (wantarray) {
return 0,'';
} else { return 0 }
}
my $killpath=$Net::FullAuto::FA_Core::killpath;
if (exists $Hosts{"__Master_${$}__"}{'kill'}) {
$killpath=$Hosts{"__Master_${$}__"}{'kill'};
$killpath.='/' if $killpath!~/\/$/;
}
my $bashpath=$Net::FullAuto::FA_Core::bashpath;
if (exists $Hosts{"__Master_${$}__"}{'bash'}) {
$bashpath=$Hosts{"__Master_${$}__"}{'bash'};
$bashpath.='/' if $bashpath!~/\/$/;
}
my $sedpath=$Net::FullAuto::FA_Core::sedpath;
if (exists $Hosts{"__Master_${$}__"}{'sed'}) {
$sedpath=$Hosts{"__Master_${$}__"}{'sed'};
$sedpath.='/' if $sedpath!~/\/$/;
}
my $cmd=[ "${bashpath}bash",'-c',
"if ${killpath}kill -0 $pid"
." \012then echo 1\012else echo 0\012fi"
." | ${sedpath}sed -e \'s/^/stdout: /' 2>&1" ];
my $mystdout='';my $stdout='';my $stderr='';
IO::CaptureOutput::capture sub {
($stdout,$stderr)=&setuid_cmd($cmd,5);
}, \$mystdout;
chomp $mystdout;
if ($mystdout=~s/^stdout: ?//) {
$stdout=$mystdout;
} elsif ($mystdout) {
$stderr=$mystdout;
}
print $Net::FullAuto::FA_Core::MRLOG
"\nppppppp &main::testpid() ppppppp STDOUT ",
"==>$stdout<== and STDERR ==>$stderr<==",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nppppppp &main::testpid() ppppppp STDOUT ",
"==>$stdout<== and STDERR ==>$stderr<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if (wantarray) {
return $stdout, $stderr;
} elsif ($stdout) {
return $stdout;
} elsif ($stderr) {
&Net::FullAuto::FA_Core::handle_error($stderr);
} else { return $stdout }
}
sub get_master_info
{
my $Local_HostName='';my $Local_FullHostName='';
my $Local_IP_Address={};
$Local_HostName=(uname)[1];
$Local_HostName=&Sys::Hostname::hostname if !$Local_HostName;
my $addr='';
if ($^O ne 'cygwin') {
if ($Local_HostName!~/^localhost\.local/) {
$addr=gethostbyname($Local_HostName) ||
&handle_error(
"Couldn't Resolve Local Hostname $Local_HostName : ");
my $gip=sprintf "%vd", $addr;
# --CONTINUE-- print "WHAT IS GIP=$gip<==\n";
$same_host_as_Master{$gip}='-';
$Local_IP_Address->{$gip}='-';
$Local_FullHostName=gethostbyaddr($addr,AF_INET) ||
handle_error(
"Couldn't Re-Resolve Local Hostname $Local_HostName : ");
} else {
my $gip='127.0.0.1';
$same_host_as_Master{$gip}='-';
$Local_IP_Address->{$gip}='-';
$Local_FullHostName=$Local_HostName;
}
} else {
#my $route=cmd('cmd /c route print',3);
my $route=cmd('route print',3);
my $getip=0;
foreach my $line (split /^/, $route) {
if (!$getip) {
if (-1<index $line, 'Metric') {
$getip=1;
} else { next }
} else {
my $gip=(split ' ', $line)[3];
next if !$gip;
next if -1==index $gip,'.';
$Local_IP_Address->{$gip}='-';
$same_host_as_Master{$gip}='-';
next if $gip=~/\d+\.0\.0\.1/;
}
}
}
$Local_FullHostName=$Local_HostName if !$Local_FullHostName;
$same_host_as_Master{$Local_HostName}='hostname';
$same_host_as_Master{$Local_FullHostName}='fullhostname';
return $Local_HostName,$Local_FullHostName,$Local_IP_Address;
}
sub check_Hosts
{
our ($Local_HostName,$Local_FullHostName,$Local_IP_Address)=
&get_master_info;
my $chk_hostname='';my $chk_ip='';my $trandir_flag='';
my $name=substr($_[0],0,-3);
my @Hosts=();
{
no warnings;
@Hosts=eval "\@${name}::Hosts";
}
my @Cycle=@Hosts;
my $username=getlogin || getpwuid($<);
HOST: foreach my $h (@Cycle) {
my $host=$h;
my $hostn='';my $ipn='';my $lh_key=0;
foreach my $keee (keys %{$host}) {
my $ke=$keee;
if (lc($ke) eq 'label' && lc($host->{$ke}) eq 'localhost') {
$lh_key=1;
} elsif (lc($ke) eq 'hostname') {
$hostn=$host->{$ke};
} elsif (lc($ke) eq 'ip') {
$ipn=$host->{$ke};
}
}
if ($hostn eq lc($Local_FullHostName)) {
$chk_hostname=$Local_FullHostName;
} elsif ($hostn eq lc($Local_HostName)) {
$chk_hostname=$Local_HostName;
} elsif (exists $Local_IP_Address->{$ipn}) {
$chk_ip=$ipn;
} elsif ($lh_key) {
} else { next }
if ($chk_hostname || $chk_ip || $lh_key==1) {
my $hash="\'Label\'=>\'__Master_${$}__\'\,";
$same_host_as_Master{$host->{'Label'}}='-';
foreach my $key (keys %{$host}) {
if (lc($key) eq 'sshport') {
next HOST;
} elsif (lc($key) eq 'label') {
if (lc($host->{$key}) eq 'localhost') {
$hash="\'Label\'=>\'__Master_${$}__\'\,";
foreach my $kee (keys %{$host}) {
if (lc($kee) eq 'label') {
next;
} elsif ((lc(unpack('a1',$kee)) eq 's') &&
(lc($kee) eq 'su' || lc($kee) eq 'su_id' ||
lc($kee) eq 'suloginid' || lc($kee) eq 'suid' ||
lc($kee) eq 'sulogin')) {
if ($host->{$kee}) {
$hash.="\'SU_ID\'=>\'$host->{$kee}\'\,";
} else {
$hash.="\'SU_ID\'=>\'root\'\,";
} next;
} elsif (lc($kee) eq 'hostname' && !$chk_hostname) {
if (defined $Local_HostName) {
$hash.="\'HostName'=>\'".$Local_HostName."\'\,";
} elsif (defined $Local_FullHostName) {
$hash.="\'HostName'=>\'".$Local_FullHostName."\'\,";
} next;
} elsif (lc($kee) eq 'ip' && !$chk_hostname && keys
%{$Local_IP_Address}) {
$hash.="\'IP'=>\'".
(keys %{$Local_IP_Address})[0]."\'\,";
next;
} else {
$hash.="\'$kee'=>\'".$host->{$kee}."\'\,";
}
}
my $li_flag=0;my $hn_flag=0;my $ip_flag=0;
foreach my $ky (eval "\{ $hash \}") {
if (lc($ky) eq 'loginid' || lc($ky) eq 'login') {
$li_flag=1;
} elsif (lc($ky) eq 'hostname') {
$hn_flag=1;
} elsif (lc($ky) eq 'ip') {
$ip_flag=1;
}
}
$hash.="\'LoginID'=>\'".$username."\'\," unless $li_flag;
unless ($hn_flag) {
if (defined $Local_HostName) {
$hash.="\'HostName'=>\'".$Local_HostName."\'\,";
} elsif (defined $Local_FullHostName) {
$hash.="\'HostName'=>\'".$Local_FullHostName."\'\,";
}
}
unless ($ip_flag) {
if (keys %{$Local_IP_Address}) {
$hash.="\'IP'=>\'".
(keys %{$Local_IP_Address})[0]."\'\,";
}
}
$hash.="\'Uname'=>\'".(uname)[0]."\'\,";
my $has=eval "\{ $hash \}";
unshift @Hosts, $has;
next HOST;
} else {
next;
}
} elsif ((lc(unpack('a1',$key)) eq 's') && (lc($key) eq 'su' ||
lc($key) eq 'su_id' || lc($key) eq 'suloginid'
|| lc($key) eq 'suid' || lc($key) eq 'sulogin')) {
next if $host->{'Label'} eq 'localhost';
next HOST;
} elsif ((lc(unpack('a1',$key)) eq 'l') && (lc($key) eq 'loginid'
|| lc($key) eq 'login') && $host->{$key} eq $username) {
next;
} elsif ($key eq 'SMB_Proxy'
|| $key eq 'RCM_Proxy'
|| $key eq 'FTM_Proxy') {
next;
} elsif (lc($key) eq 'hostName' && !$chk_hostname) {
if (defined $Local_HostName) {
$hash.="\'HostName'=>\'".$Local_HostName."\'\,";
} elsif (defined $Local_FullHostName) {
$hash.="\'HostName'=>\'".$Local_FullHostName."\'\,";
} next;
} elsif (lc($key) eq 'ip' && !$chk_hostname && keys
%{$Local_IP_Address}) {
$hash.="\'IP'=>\'".(keys %{$Local_IP_Address})[0]."\'\,";
next;
} elsif (lc($key) eq 'transferdir') {
$hash.="\'TransferDir'=>\'".${$host}{$key}."\'\,";
next HOST;
}
$hash.="\'$key'=>\'".${$host}{$key}."\'\,";
} $hash.="\'Uname'=>\'".(uname)[0]."\'\,";
unshift @Hosts, eval "\{ $hash \}";last;
}
}
if (!$chk_hostname && !$chk_ip) {
my $hostn='';my $ip='';
if ($Local_FullHostName) {
$hostn="\'HostName'=>\'$Local_FullHostName\'\,";
} elsif ($Local_HostName) {
$hostn="\'HostName'=>\'$Local_HostName\'\,";
}
if (keys %{$Local_IP_Address}) {
$ip="'IP'=>\'".(keys %{$Local_IP_Address})[0]."\',";
}
my $label="\'Label\'=>\'__Master_${$}__\',";
my $uname="'Uname'=>'".(uname)[0]."',";
my $local="'Local'=>'connect_ssh_telnet',";
my $remote="'Remote'=>'connect_host',";
unshift @Hosts,
eval "\{ $ip$hostn$label$uname$local$remote \}";
} return \@Hosts;
}
$Hosts{"__Master_${$}__"}{'HostName'}=&Sys::Hostname::hostname if
!exists $Hosts{"__Master_${$}__"}{'HostName'};
$Hosts{"__Master_${$}__"}{'IP'}='' if
!exists $Hosts{"__Master_${$}__"}{'IP'};
if (!exists $Hosts{"__Master_${$}__"}{'Cipher'}) {
$Hosts{"__Master_${$}__"}{'Cipher'}='DES';
} else {
eval "require " . $Hosts{"__Master_${$}__"}{'Cipher'};
&handle_error($@) if $@;
}
#sub check_Maps
#{
# foreach my $map (@fa_maps::Maps) {
# my $RCM_map=(exists ${$map}{'RCM'})?lc(${$map}{'RCM'}):'';
# my $FCM_map=(exists ${$map}{'FCM'})?${$map}{'FCM'}:'';
# }
# unshift @fa_maps::Maps, eval "\{ $map \}";last;
# unshift @fa_maps::Maps, eval "\{ $map \}";last;
#}
my %msproxies=();my %uxproxies=();my %labels=();
my %DeploySMB_Proxy=();my %DeployFTM_Proxy=();
my %DeployRCM_Proxy=();my $msflag='';my $uxflag='';
foreach my $host (@Hosts) {
$host->{'Label'}||='';
if (exists $labels{$host->{'Label'}} &&
($host->{'Label'} ne "__Master_${$}__")) {
&handle_error("DUPLICATE LABEL DETECTED - $host->{'Label'}");
} $labels{${$host}{'Label'}}='' if $host->{'Label'};
if (exists ${$host}{'SMB_Proxy'}) {
if (exists $msproxies{${$host}{'SMB_Proxy'}} &&
${$msproxies{${$host}{'SMB_Proxy'}}}[0] eq ${$host}{'SMB_Proxy'}
&& ${$msproxies{${$host}{'SMB_Proxy'}}}[1] eq 'SMB_Proxy') {
my $die="\n FATAL ERROR! - Duplicate \"'SMB_Proxy' =>"
." \" Values Detected.\n\n Hint: No Host "
."Unit in $Net::FullAuto::FA_Core::fa_host should have"
."\n "
."the same value for 'SMB_Proxy' =>\n\n {\n"
." ...\n\n 'SMB_Proxy' => 1,"
."\n ...\n },\n {\n "
."...\n\n 'SMB_Proxy' => 2,\n ..."
."\n },\n";
&handle_error($die);
} else {
$msproxies{${$host}{'SMB_Proxy'}}
=["${$host}{'SMB_Proxy'}",'SMB_Proxy'];
}
}
if (exists ${$host}{'RCM_Proxy'}) {
if (exists $uxproxies{${$host}{'RCM_Proxy'}} &&
${$uxproxies{${$host}{'RCM_Proxy'}}}[0] eq ${$host}{'RCM_Proxy'}
&& ${$uxproxies{${$host}{'RCM_Proxy'}}}[1] eq 'RCM_Proxy') {
&handle_error("DUPLICATE \"RCM_Proxy\" HOSTUNIT DETECTED");
} else {
$uxproxies{${$host}{'RCM_Proxy'}}
=["${$host}{'RCM_Proxy'}",'RCM_Proxy'];
}
}
if (exists ${$host}{'FTM_Proxy'}) {
if (exists $uxproxies{${$host}{'FTM_Proxy'}} &&
${$uxproxies{${$host}{'FTM_Proxy'}}}[0]
eq ${$host}{'FTM_Proxy'}
&& ${$uxproxies{${$host}{'FTM_Proxy'}}}[1] eq 'FTM_Proxy') {
&handle_error("DUPLICATE \"RCM_Proxy\" HOSTUNIT DETECTED");
} else {
$uxproxies{${$host}{'FTM_Proxy'}}
=[${$host}{'FTM_Proxy'},'FTM_Proxy'];
}
}
foreach my $key (keys %{$host}) {
${$Hosts{${$host}{'Label'}}}{$key}=${$host}{$key};
if ($key eq 'SMB_Proxy') {
if (exists $same_host_as_Master{${$host}{'Label'}}) {
if (${$host}{'SMB_Proxy'}=~/^(\d+)$/) {
$DeploySMB_Proxy{${$host}{'SMB_Proxy'}}
="__Master_${$}__";
} else { push @DeploySMB_Proxy, "__Master_${$}__" }
} elsif (&ping(${$host}{'IP'},'__return__') ||
&ping(${$host}{'HostName'},'__return__')) {
if (${$host}{'SMB_Proxy'}=~/^(\d+)$/) {
$DeploySMB_Proxy{${$host}{'SMB_Proxy'}}
=${$host}{'Label'};
} else { push @DeploySMB_Proxy, ${$host}{'Label'} }
}
}
if ($key eq 'RCM_Proxy') {
if (exists $same_host_as_Master{${$host}{'Label'}}) {
if (exists ${$host}{'RCM_Proxy'} &&
${$host}{'RCM_Proxy'}=~/^(\d+)$/) {
$DeployRCM_Proxy{${$host}{'RCM_Proxy'}}
="__Master_${$}__";
} else { push @DeployRCM_Proxy, "__Master_${$}__" }
} elsif ((exists ${$host}{'IP'} &&
&ping(${$host}{'IP'},'__return__')) ||
(exists ${$host}{'HostName'} &&
&ping(${$host}{'HostName'},'__return__'))) {
if (exists ${$host}{'RCM_Proxy'} &&
${$host}{'RCM_Proxy'}=~/^(\d+)$/) {
$DeployRCM_Proxy{${$host}{'RCM_Proxy'}}
=${$host}{'Label'};
} else { push @DeployRCM_Proxy, ${$host}{'Label'} }
}
}
if ($key eq 'FTM_Proxy') {
if (exists $same_host_as_Master{${$host}{'Label'}}) {
if (${$host}{'FTM_Proxy'}=~/^(\d+)$/) {
$DeployFTM_Proxy{${$host}{'FTM_Proxy'}}
="__Master_${$}__";
} else { push @DeployFTM_Proxy, "__Master_${$}__" }
} elsif (&ping(${$host}{'IP'},'__return__') ||
&ping(${$host}{'HostName'},'__return__')) {
if (${$host}{'FTM_Proxy'}=~/^(\d+)$/) {
$DeployFTM_Proxy{${$host}{'FTM_Proxy'}}
=${$host}{'Label'};
} else { push @DeployFTM_Proxy, ${$host}{'Label'} }
}
}
}
}
if (keys %DeploySMB_Proxy) {
foreach my $key (reverse sort keys %DeploySMB_Proxy) {
unshift @DeploySMB_Proxy, $DeploySMB_Proxy{$key};
}
}
if (keys %DeployRCM_Proxy) {
foreach my $key (reverse sort keys %DeployRCM_Proxy) {
unshift @DeployRCM_Proxy, $DeployRCM_Proxy{$key};
}
}
if (keys %DeployFTM_Proxy) {
foreach my $key (reverse sort keys %DeployFTM_Proxy) {
unshift @DeployFTM_Proxy, $DeployFTM_Proxy{$key};
}
}
#my $ps__=($^O eq 'cygwin')?'ps':$pspath.'ps';
my $ps_stdout=&cmd($Net::FullAuto::FA_Core::pspath.'ps');
sub get_all_hosts
{
return keys %Hosts;
}
sub connect_sftp
{
push @_, '__sftp__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_ftp
{
push @_, '__ftp__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_ftp_sftp
{
push @_, '__ftp_sftp__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_sftp_ftp
{
push @_, '__sftp_ftp__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_ssh
{
my @topcaller=caller;
print "connect_ssh() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "connect_ssh() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
push @_, '__ssh__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $handle;
}
}
sub connect_ssh_telnet
{
my @topcaller=caller;
print "connect_ssh-telnet() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "connect_ssh-telnet() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
push @_, '__ssh_telnet__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n";
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n";
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n";
return $handle;
}
}
sub connect_telnet_ssh
{
my @topcaller=caller;
print "connect_ssh-telnet() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "connect_ssh-telnet() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
push @_, '__telnet_ssh__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n";
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n";
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n";
return $handle;
}
}
sub connect_secure
{
my @topcaller=caller;
print "connect_secure() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "connect_ssh() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
push @_, '__secure__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $handle;
}
}
sub connect_insecure
{
my @topcaller=caller;
print "connect_insecure() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "connect_insecure() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
push @_, '__insecure__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE1\n";
return $handle,$stderr;
} elsif ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "GOTSSHCONNECTERRORDYING\n";
&handle_error($stderr,'-4','__cleanup__');
} else {
print $Net::FullAuto::FA_Core::MRLOG "RETURNINGSSH_HANDLE2\n";
return $handle;
}
}
sub connect_telnet
{
push @_, '__telnet__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_reverse
{
push @_, '__reverse__';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_cmd
{
my @topcaller=caller;
print "\nINFO: main::connect_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::connect_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($handle,$stderr)=('','');
($handle,$stderr)=connect_host(@_);
if (wantarray) {
return $handle,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4','__cleanup__');
} else {
return $handle;
}
}
sub connect_host
{
my @topcaller=caller;
print "\nINFO: main::connect_host() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::connect_host() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $caller=(caller(1))[3];
substr($caller,0,(index $caller,'::')+2)='';
my $sub='';my $_connect='connect_host';
if ((-1<index $caller,'connect_ftp')
|| (-1<index $caller,'connect_telnet')
|| (-1<index $caller,'connect_ssh')
|| (-1<index $caller,'connect_sftp')
|| (-1<index $caller,'connect_secure')
|| (-1<index $caller,'connect_insecure')
|| (-1<index $caller,'connect_reverse')) {
$_connect=(split '::', $caller)[2];
($caller,$sub)=split '::', (caller(2))[3];
$caller.='.pm';
} else {
my @called=caller(2);
#if ((-1<index $caller,'mirror') || (-1<index $caller,'login_retry')
# || (-1<index $caller,'connect_cmd')) {
if ((-1<index $caller,'mirror') || (-1<index $caller,'login_retry')) {
$sub=$called[3]
} else {
$caller=$called[3];
$caller=(caller(0))[0] if $caller=~/[(]eval[)]/;
$called[6]||='';
$sub=($called[6])?$called[6]:$called[3];
$sub=~s/^.*:://;
} $sub=~s/\s*\;\n*//
}
my $hostlabel=$_[0];
$Net::FullAuto::FA_Core::cltimeout||='X';
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$timeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (defined $_[1] && $_[1]=~/^[1-9]+/) {
$timeout=$_[1];
} elsif ((-1==index $caller,'mirror') &&
(-1==index $caller,'login_retry')) {
my $time_out='$' . (caller)[0] . '::timeout';
$time_out= eval $time_out;
if ($@ || $time_out!~/^[1-9]+/) {
$timeout=30;
} else { $timeout=$time_out }
} else { $timeout=30 }
if (defined $_[2] && lc($_[2]) ne '__telnet__' && lc($_[2]) ne '__ftp__') {
$Net::FullAuto::FA_Core::test=$_[2];
} else {
my $tst='$' . (caller)[0] . '::test';
$tst= eval $tst;
if ($@ || $tst!~/^[1-9]+/) {
$Net::FullAuto::FA_Core::test=0;
} else { $Net::FullAuto::FA_Core::test=$tst }
}
unless (exists $Hosts{$hostlabel}) {
my $die="\n FATAL ERROR - The First Argument to "
."&connect_host()\n -> \"$hostlabel"
."\"\n Called from the User Defined "
."Subroutine\n -> \&$sub\n "
." in the \"Custom Code\" module file"
."\n -> $caller is NOT a\n"
." Valid Host Label\n\n"
." Be sure there is Valid Host "
."Block\n Entry in the Hosts file\n"
." -> $Net::FullAuto::FA_Core::fa_host .\n\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print $die if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
&handle_error($die,'__cleanup__');
}
my $new_handle='';my $stderr='';
if ($_connect eq 'connect_ssh'
|| $_connect eq 'connect_telnet') {
($new_handle,$stderr)=new Rem_Command($hostlabel,
'__new_master__',$_connect);
print $Net::FullAuto::FA_Core::MRLOG "connect_host()1 STDERRFOR1011=$stderr<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
} else {
($new_handle,$stderr)=new File_Transfer($hostlabel,
'__new_master__',$_connect);
print $Net::FullAuto::FA_Core::MRLOG "connect_host()2 STDERRFOR1011=$stderr<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
if (wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNING1\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $new_handle,$stderr;
} elsif (!$stderr) {
print $Net::FullAuto::FA_Core::MRLOG "RETURNING2\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $new_handle;
} else {
print $Net::FullAuto::FA_Core::MRLOG "DIEINGNOWHERE\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__');
}
}
sub memnow
{
my $stdout='';my $stderr='';my $all=0;
$all=1 if $_[0] && grep { /__all__/i } @_;
if ($_[0] && ref $_[0] eq 'HASH') {
if ($^O eq 'cygwin') {
($stdout,$stderr)=&Net::FullAuto::FA_Core::cmd(
$_[0],"cat /proc/meminfo");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'__cleanup__') if $stderr
&& !wantarray
}
} else {
if ($^O eq 'cygwin') {
($stdout,$stderr)=&Net::FullAuto::FA_Core::cmd("cat /proc/meminfo");
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__') if $stderr
&& !wantarray
}
}
if (!$all && $^O eq 'cygwin') {
my $cnt=0;
foreach my $line (split /^/, $stdout) {
next if !$cnt++;
$stdout=substr($line,(rindex $line,' ')+1,-1);
last;
}
}
if (wantarray) {
return $stdout, $stderr;
} else {
return $stdout;
}
}
sub handle_error
{
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;
print "FA_Core::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "FA_Core::handle_error() CALLER=",
(join ' ',@topcaller),"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#$Net::FullAuto::FA_Core::log=0 if $logreset;
my $return=0;
my $line_adjust=0;my $warn=0;
my $error=$_[0];my $track='';
my $cleanup=0;
my $mail='';my $new_invoked='';
if (defined $_[1] && $_[1]) {
if (ref $_[1] eq 'HASH') {
$mail=$_[1];
} elsif (ref $_[1] eq 'ARRAY') {
$track=$_[1];
} else {
if ($_[1] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[1] eq '__return__') {
$return=1;
} elsif ($_[1] eq '__warn__') {
$warn=1;
} elsif ($_[1]=~/^\s*-(\d+)\s*$/) {
$line_adjust=-$1;
} else {
print "ARG1 is NOT recognized\n==>$_[1]<==\n";
}
}
}
if (defined $_[2] && $_[2]) {
if (ref $_[2] eq 'HASH') {
$mail=$_[2];
} elsif (ref $_[2] eq 'ARRAY') {
$track=$_[2];
} else {
if ($_[2] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[2] eq '__return__') {
$return=1;
} elsif ($_[2] eq '__warn__') {
$warn=1;
} elsif ($_[2]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;
} else {
print "ARG2 is NOT recognized\n==>$_[2]<==\n";
}
}
}
if (defined $_[3] && $_[3]) {
if (ref $_[3] eq 'HASH') {
$mail=$_[3];
} elsif (ref $_[3] eq 'ARRAY') {
$track=$_[3];
} else {
if ($_[3] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[3] eq '__return__') {
$return=1;
} elsif ($_[3] eq '__warn__') {
$warn=1;
} elsif ($_[3]=~/^-(\d+)/) {
$line_adjust=-$1;
} else {
print "ARG3 is NOT recognized\n==>$_[3]<==\n";
}
}
}
if (defined $_[4] && $_[4]) {
if (ref $_[4] eq 'HASH') {
$mail=$_[4];
} elsif (ref $_[4] eq 'ARRAY') {
$track=$_[4];
} else {
if ($_[4] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[4] eq '__return__') {
$return=1;
} elsif ($_[4] eq '__warn__') {
$warn=1;
} elsif ($_[4]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;
} else {
print "ARG4 is NOT recognized\n==>$_[4]<==\n";
}
}
}
if (defined $_[5] && $_[5]) {
if (ref $_[5] eq 'HASH') {
$mail=$_[5];
} elsif (ref $_[5] eq 'ARRAY') {
$track=$_[5];
} else {
if ($_[5] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[5] eq '__return__') {
$return=1;
} elsif ($_[5] eq '__warn__') {
$warn=1;
} elsif ($_[5]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;
} else {
print "ARG5 is NOT recognized\n==>$_[5]<==\n";
}
}
}
if (defined $_[6] && $_[6]) {
if (ref $_[6] eq 'HASH') {
$mail=$_[6];
} elsif (ref $_[6] eq 'ARRAY') {
$track=$_[6];
} else {
if ($_[6] eq '__cleanup__') {
$cleanup=1;
} elsif ($_[6] eq '__return__') {
$return=1;
} elsif ($_[6] eq '__warn__') {
$warn=1;
} elsif ($_[6]=~/^\s*-(\d+)\s*/) {
$line_adjust=-$1;
} else {
print "ARG6 is NOT recognized\n==>$_[6]<==\n";
}
}
} my $line='';
if ($line_adjust) {
if (unpack('a1',$line_adjust) eq '-') {
$line_adjust=unpack('x1 a*',$line_adjust);
$line=$topcaller[2]-$line_adjust;
} else {
$line=$topcaller[2]+$line_adjust;
}
} else { $line=$topcaller[2] }
my $tie_err='';my $trackdb='';my $hostlabel='';
my $command='';my $suberr='';
if ($track) {
($trackdb=${$track}[0])=~s/\.db$//;
$hostlabel=${$track}[1];
$command=${$track}[2];
$suberr=${$track}[3] if defined ${$track}[3] && ${$track}[3];
$suberr||='';
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}."Track") {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}."Track");
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Track',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${trackdb}.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);
my $tref='';
my $status=$bdb->db_get($invoked[2],$tref);
$tref=eval $tref;
if (!$status && exists ${$tref}{"${hostlabel}_$command"}
&& ${$tref}{"${hostlabel}_$command"}
eq $error) {
# loop the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);
}
}
undef $cursor;
undef $bdb;
$dbenv->close();
undef $dbenv;
if ($^O eq 'cygwin') {
if (keys %Net::FullAuto::FA_Core::semaphores) {
foreach my $ipc_key (keys %Net::FullAuto::FA_Core::semaphores) {
$Net::FullAuto::FA_Core::semaphores{$ipc_key}->release(1);
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};
}
}
} else {
no strict 'subs';
semctl(34, 0, SETVAL, -1);
} return 1,'';
} elsif ($suberr && exists ${$tref}{"${hostlabel}_$suberr"}
&& ${$tref}{"${hostlabel}_$suberr"}
eq $suberr) {
# loop the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);
}
}
undef $cursor;
undef $bdb;
$dbenv->close();
undef $dbenv;
if ($^O eq 'cygwin') {
if (keys %Net::FullAuto::FA_Core::semaphores) {
foreach my $ipc_key (keys %Net::FullAuto::FA_Core::semaphores) {
$Net::FullAuto::FA_Core::semaphores{$ipc_key}->release(1);
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};
}
}
} else {
no strict 'subs';
semctl(34, 0, SETVAL, -1);
} return 1,'';
} else {
${$tref}{"${hostlabel}_$command"}=$error;
my $put_tref=Data::Dump::Streamer::Dump($tref)->Out();
$status=$bdb->db_put($invoked[2],$put_tref);
undef $bdb;
$dbenv->close();
undef $dbenv;
$return=1;
}
# loop the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
if ($k!=$invoked[2]) {
$bdb->db_del($k);
}
}
undef $cursor;
undef $bdb;
$dbenv->close();
undef $dbenv;
} my $errtxt='';
if (10<length $error && unpack('a11',$error) ne 'FATAL ERROR') {
$error=~s/\s*$//s;$error=~s/^\s*//s;
$errtxt="$error\n\n at $topcaller[0] "
."$topcaller[1] line $line.\n";
} else {
$errtxt=$error
}
#print $Net::FullAuto::FA_Core::MRLOG "HANDLE_ERROR ERRTXT=$errtxt<==\n";
if ($errtxt=~/^You have mail/) {
print $Net::FullAuto::FA_Core::MRLOG "\nAttn: --> $errtxt\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nAttn: --> $errtxt\n\n";
return
} elsif ($track || $return || $cleanup) {
print $Net::FullAuto::FA_Core::MRLOG "\n $errtxt"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n $errtxt"
}
if ($mail) {
if ($warn) {
send_email($mail,$Net::FullAuto::FA_Core::debug,'__warn__');
} else { send_email($mail,$Net::FullAuto::FA_Core::debug) }
} elsif (!$mail && exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq 'notify_on_error'
&& ($track && ($cleanup || $return))) {
my %mail=(Body=>" $errtxt");
if ($warn) {
send_email(\%mail,$Net::FullAuto::FA_Core::debug,'__warn__');
} else { send_email(\%mail,$Net::FullAuto::FA_Core::debug) }
}
if ($track) {
if (wantarray) {
if ($^O eq 'cygwin') {
if (keys %Net::FullAuto::FA_Core::semaphores) {
foreach my $ipc_key (keys %Net::FullAuto::FA_Core::semaphores) {
$Net::FullAuto::FA_Core::semaphores{$ipc_key}->release(1);
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};
}
}
} else {
no strict 'subs';
semctl(34, 0, SETVAL, -1);
} return 0,$errtxt;
} else {
if ($^O eq 'cygwin') {
if (keys %Net::FullAuto::FA_Core::semaphores) {
foreach my $ipc_key (keys %Net::FullAuto::FA_Core::semaphores) {
$Net::FullAuto::FA_Core::semaphores{$ipc_key}->release(1);
delete $Net::FullAuto::FA_Core::semaphores{$ipc_key};
}
}
} else {
no strict 'subs';
semctl(34, 0, SETVAL, -1);
} return 0,'';
}
} elsif ($cleanup) {
&cleanup($return,'ERROR');
} else {
print "WE ARE GOING TO DIE IN HANDLE_ERROR and CALLER=",(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "WE ARE GOING TO DIE IN HANDLE_ERROR and CALLER=",(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($return && $warn) {
print "\n $errtxt\n";
} else { die $errtxt }
}
}
sub lookup_hostinfo_from_label
{
my @topcaller=caller;
print "lookup_hostinfo_from_label() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "lookup_hostinfo_from_label() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $ip='';my $hostname='';my $use='';my $ms_share='';
my $ms_domain='';my $cmd_cnct=[''];my $ftr_cnct=[''];
my $login_id='';my $su_id='';my $chmod='';my $ping='';
my $owner='';my $group='';my $transfer_dir='';
my $rcm_chain='';my $rcm_map='';my $uname='';
my $ip_flag='';my $hn_flag='';
my $hostlabel=$_[0];my $_connect=$_[1]||'';
$hostlabel="__Master_${$}__" if lc($hostlabel) eq 'localhost';
my $timeout=0;
$use=$Hosts{$hostlabel}{'Use'} if exists
$Hosts{$hostlabel}{'Use'} &&
$Hosts{$hostlabel}{'Use'};
my $defined_use=0;
$defined_use=$use if $use;
$ping=$Hosts{$hostlabel}{'Ping'} if exists
$Hosts{$hostlabel}{'Ping'} &&
$Hosts{$hostlabel}{'Ping'};
foreach my $key (keys %{$Hosts{$hostlabel}}) {
print $Net::FullAuto::FA_Core::MRLOG "KEY FROM HOST HASH=$key and USE=$use\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (!$use || (!$defined_use && $ip && !$hostname)) {
if ($key eq 'IP') {
if (ref $Hosts{$hostlabel}{$key} eq 'CODE') {
$ip=$Hosts{$hostlabel}{$key}->();
} else {
$ip=$Hosts{$hostlabel}{$key};
}
if (exists $same_host_as_Master{$ip} || $ping) {
if (exists $same_host_as_Master{$ip}
|| !(&ping($ip,'__return__'))[1]) {
$use='ip';
} else { $ip_flag=1 }
}
} elsif (lc($key) eq 'hostname') {
$hostname=$Hosts{$hostlabel}{$key};
if ($hostname && $ping) {
if (&ping($hostname,'__return__')) {
$use='hostname';
} else {
my $pinghost=$hostname;
$pinghost=substr($hostname,0,
(index $hostname,'.'))
if -1<index $hostname,'.';
if (&ping($pinghost,'__return__')) {
$Hosts{$hostlabel}{'HostName'}=$pinghost;
$hostname=$pinghost;
$use='hostname';
} else { $hn_flag=1 }
}
}
}
} elsif (lc($key) eq 'ip') {
$ip=$Hosts{$hostlabel}{$key};
if (!exists $same_host_as_Master{$ip} && $ping) {
unless (&ping($ip,'__return__')) {
if ($defined_use eq 'ip') {
$ip_flag=1;$defined_use=0;$use=0;
}
}
}
} elsif (lc($key) eq 'hostname') {
$hostname=$Hosts{$hostlabel}{$key};
if ($ping) {
my $pinghost=$hostname;
$pinghost=substr($hostname,0,
(index $hostname,'.'))
if -1<index $hostname,'.';
unless (&ping($pinghost,'__return__')) {
if ($defined_use eq 'hostname') {
$hn_flag=1;$defined_use=0;$use=0;
}
}
}
}
if (lc($key) eq 'ms_share') {
$ms_share=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'MS_Domain') {
$ms_domain=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'Remote') {
my $rem_cnct=$Hosts{$hostlabel}{$key};
if (!exists $same_host_as_Master{$hostlabel}) {
if ($_connect && $rem_cnct ne $_connect) {
if (($rem_cnct eq 'connect_ssh'
|| $rem_cnct eq 'connect_telnet'
|| $rem_cnct eq 'connect_sftp'
|| $rem_cnct eq 'connect_ftp')
|| (($_connect eq 'connect_secure'
|| $_connect eq 'connect_insecure')
&& ($rem_cnct ne 'connect_host'
&& $rem_cnct ne 'connect_reverse'))) {
my $die.="\n \"Remote\" Value: \'$rem_cnct\'"
."\n for Host Block --> $hostlabel"
."\n in file "
.$Net::FullAuto::FA_Core::fa_host
."\n conflicts with calling connect"
."\n method: $_connect";
&handle_error($die);
} elsif ($_connect eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];
$cmd_cnct=[ 'ssh' ];
} elsif ($_connect eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];
$cmd_cnct=[ 'telnet' ];
} elsif ($_connect eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];
$cmd_cnct=[ 'ssh','telnet' ];
} elsif ($_connect eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];
$cmd_cnct=[ 'telnet','ssh' ];
}
}
} else {
if ($rem_cnct eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];
$cmd_cnct=[ 'ssh' ];
} elsif ($rem_cnct eq 'connect_ssh') {
$cmd_cnct=[ 'ssh' ];
} elsif ($rem_cnct eq 'connect_sftp') {
$ftr_cnct=[ 'sftp' ];
} elsif ($rem_cnct eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];
$cmd_cnct=[ 'ssh','telnet' ];
} elsif ($rem_cnct eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];
$cmd_cnct=[ 'telnet' ];
} elsif ($rem_cnct eq 'connect_telnet') {
$cmd_cnct=[ 'telnet' ];
} elsif ($rem_cnct eq 'connect_ftp') {
$ftr_cnct=[ 'ftp' ];
} elsif ($ftr_cnct eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];
$cmd_cnct=[ 'telnet','ssh' ];
}
}
} elsif ((lc(unpack('a1',$key)) eq 'l') && (lc($key) eq 'loginid'
|| $key eq 'login')) {
$login_id=$Hosts{$hostlabel}{$key};
$Hosts{$hostlabel}{'LoginID'}=$login_id;
} elsif ((lc(unpack('a1',$key)) eq 's') && (lc($key) eq 'su' ||
lc($key) eq 'su_id' || lc($key) eq 'suloginid'
|| lc($key) eq 'suid' || lc($key) eq 'sulogin')) {
$su_id=$Hosts{$hostlabel}{$key};
$Hosts{$hostlabel}{'SU_ID'}=$su_id;
} elsif ($key eq 'Chmod') {
$chmod=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'Owner') {
$owner=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'Group') {
$group=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'Timeout') {
$timeout=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'TransferDir') {
$transfer_dir=$Hosts{$hostlabel}{$key};
$transfer_dir=~s/[\/\\]*$//;
} elsif ($key eq 'RCM_Chain') {
$rcm_chain=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'RCM_Map') {
$rcm_map=$Hosts{$hostlabel}{$key};
} elsif ($key eq 'Uname') {
$uname=$Hosts{$hostlabel}{$key};
}
print $Net::FullAuto::FA_Core::MRLOG "GOING BACK TO TOP OF FOR LOOP\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
if (!$#{$ftr_cnct}) {
if ($_connect eq 'connect_secure') {
$ftr_cnct=[ 'sftp' ];
$cmd_cnct=[ 'ssh' ];
} elsif ($_connect eq 'connect_host') {
$ftr_cnct=[ 'sftp','ftp' ];
$cmd_cnct=[ 'ssh','telnet' ];
} elsif ($_connect eq 'connect_ssh') {
$cmd_cnct=[ 'ssh' ];
} elsif ($_connect eq 'connect_sftp') {
$ftr_cnct=[ 'sftp' ];
} elsif ($_connect eq 'connect_telnet') {
$cmd_cnct=[ 'telnet' ];
} elsif ($_connect eq 'connect_ftp') {
$ftr_cnct=[ 'ftp' ];
} elsif ($_connect eq 'connect_insecure') {
$ftr_cnct=[ 'ftp' ];
$cmd_cnct=[ 'telnet' ];
} elsif ($_connect eq 'connect_reverse') {
$ftr_cnct=[ 'ftp','sftp' ];
$cmd_cnct=[ 'telnet','ssh' ];
}
}
print $Net::FullAuto::FA_Core::MRLOG "WHAT IS USE?=$use\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (!$use || (!$ip && !$hostname)) {
my $die="Cannot Contact Server \'$hostlabel\' -";
my $fah=$Net::FullAuto::FA_Core::fa_host;
if ($ip_flag) {
$die.="\n 1ping failed for ip address $ip";
if ($hn_flag) {
$die.="\n and hostname: $hostname\n" if $hostname;
} &handle_error($die);
} elsif ($hn_flag) {
$die.="\n 2ping failed for hostname: $hostname &"
."\n No ip address if defined for Server"
."\n --> $hostlabel in $fah file.";
&handle_error($die);
} elsif ($hostname || ($use eq 'ip' && !$ip)) {
$use='hostname';
} elsif ($ip) {
$use='ip';
} else {
$die.="\n No ip address or hostname defined for Server"
."\n --> $hostlabel in $fah file.";
&handle_error($die);
}
} elsif ($use eq 'hostname' && !$hostname && $ip) {
$use='ip';
} elsif ($use eq 'ip' && !$ip && $hostname) {
$use='hostname';
}
return ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$timeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping);
}
sub pty_do_cmd
{
my @topcaller=caller;
print "\nINFO: FA_Core::pty_do_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nFA_Core::pty_do_cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $cmd='';my @args=();
($cmd,@args)=@_;
my $pty='';my $pty_err='';my $try=0;
my $capture = IO::Capture::Stderr->new();
$capture->start();
while (1) {
my $m="Hint: Try Rebooting the Local Host";
eval {
$pty = IO::Pty->new;
};
if ($@) {
if ($@=~/Cannot open/is && $try++!=4) {
sleep $try;next;
} else {
my @all_lines = $capture->read || ();
$capture->stop();
&Net::FullAuto::FA_Core::handle_error(
$@."\n $all_lines[$#all_lines]\n $m");
}
} else { last }
}
$capture->stop();
$try=0;my $child='';
my $cmd_err=join ' ',@{$cmd};
my $one=shift @{$cmd};
my $doslave=${$cmd}[$#{$cmd}] eq '_slave_' ? pop @{$cmd} : '';
my $two='';my $three='';
my $four='';my $five='';
if (-1<$#{$cmd}) {
$two=shift @{$cmd};
if (-1<$#{$cmd}) {
$three=shift @{$cmd};
if (-1<$#{$cmd}) {
$four=shift @{$cmd};
}
}
}
while (1) {
my $m="Hint: Try Rebooting the Local Host";
eval {
$child = fork;
};
if ($@) {
if ($@=~/temporarily unavailable/ && $try++!=4) {
sleep 5;next;
} else {
&Net::FullAuto::FA_Core::handle_error($@."\n $m");
}
} else { last }
}
return $pty,$child if $child; # Save Pound Sign
POSIX::setsid or &handle_error("setsid failed: ".($!)); # Save Pound Sign
my $tty = $pty->slave; # Save Pound Sign
$pty->make_slave_controlling_terminal
if ($^O eq 'cygwin') || ($doslave eq '_slave_'); # Save Pound Sign
CORE::close $pty; # Save Pound Sign
STDIN->fdopen($tty,"<") or &handle_error("STDIN: ".($!)); # Save Pound Sign
STDOUT->fdopen($tty,">") or &handle_error("STDOUT: ".($!)); # Save Pound Sign
STDERR->fdopen($tty,">") or &handle_error("STDERR: ".($!)); # Save Pound Sign
CORE::close $tty; # Save Pound Sign
$| = 1; # Save Pound Sign
#my $flag=''; # Save Pound Sign
#if (!$flag || lc($flag) ne '__use_parent_env__') {
if ($^O ne 'cygwin' && $Net::FullAuto::FA_Core::specialperms eq 'setgid') {
$ENV{PATH} = ''; # Save Pound Sign
$ENV{ENV} = ''; # Save Pound Sign
} else {
$ENV{PATH}=~/^(.*)$/; # Save Pound Sign
$ENV{PATH}=$1; # Save Pound Sign
$ENV{ENV}||=''; # Save Pound Sign
$ENV{ENV}=~/^(.*)$/; # Save Pound Sign
$ENV{ENV}=$1; # Save Pound Sign
}
$ENV{DISPLAY}=''; # Save Pound Sign
print "\n"; # Save Pound Sign
if ($four) {
exec $one, $two, $three, $four ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($three) {
exec $one, $two, $three ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($two) {
exec $one, $two ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} else {
exec $one ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
}
}
sub apache_login
{
print "APACHE_LOGINCALLER=",caller,"\n";
my ($ip,$hostlabel,$hostname,$info,$apache_handle,$ua)=@_;
my @info=@{$info};
my %apache_handle=%{$apache_handle};
my %ua=%{$ua};
my $node=substr(${$DeploySMB_Proxy[0]}{'HostName'},0,
(index ${$DeploySMB_Proxy[0]}{'HostName'},'.'));
my $an="${$DeploySMB_Proxy[0]}{'IP'}:80";
eval {
#$apache_handle{$info[2]} = new LWP::UserAgent;
my $un=$username;
#print "GP1\n";
$apache_handle{$info[2]}->credentials(
$an,'WebRSH',$un,&getpasswd($hostlabel,$un));
$apache_handle{$info[2]}->agent(
"$progname " . $ua->agent);
};
if ($@) {
return $@;
}
}
sub test_file
{
my ($cmd_handle,$tfile)=@_;my $test_result=0;
my $shell_cmd="if\n[[ -f $tfile ]]\nthen\nif\n[[ -w $tfile ]]"
."\nthen\necho WRITE\nelse\necho READ\nfi\n"
."else\necho NOFILE\nfi";
my ($stdout,$stderr)=('','');
($stdout,$stderr)=$cmd_handle->cmd($shell_cmd);
return $stdout;
}
sub test_dir
{
my ($cmd_handle,$tdir)=@_;my $test_result=0;
my $shell_cmd="if\n[[ -d $tdir ]]\nthen\nif\n[[ -w $tdir ]]"
."\nthen\necho WRITE\nelse\necho READ\nfi\n"
."else\necho NODIR\nfi;".
$Net::FullAuto::FA_Core::printfpath."printf \\\\055";
my $cnt=5;
while ($cnt--) {
$cmd_handle->print($shell_cmd);
my $leave=0;my $l='';
TD: while (1) {
while (my $line=$cmd_handle->get) {
$l.=$line;
if ($l=~/printf/s) {
if ($line=~/^WRITE|^(?:[>]\s)*WRITE/m) {
$test_result='WRITE';
$leave=1;
$l='';
} elsif ($line=~/^READ|^(?:[>]\s)*READ/m) {
$test_result='READ';
$leave=1;
$l='';
} elsif ($line=~/^NODIR|^(?:[>]\s)*NODIR/m) {
$test_result=0;
$leave=1;
$l='';
}
select(undef,undef,undef,0.02);
# sleep for 1/50th second;
$cmd_handle->print();
next;
}
if ($l=~/_funkyPrompt_$/s) {
last TD;
} else {
select(undef,undef,undef,0.02);
# sleep for 1/50th second;
$cmd_handle->print;
}
} last if $leave;
select(undef,undef,undef,0.02);
# sleep for 1/50th second;
$cmd_handle->print;
} last if $leave;
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
} return $test_result;
}
sub inc_oct
{
my $num=$_[0];
while (1) {
$num++;
return $num if (-1==index $num,'8') && (-1==index $num,'9')
}
}
sub get_prompt {
unless ($#ascii_que) {
@ascii_que=@ascii;
} return shift @ascii_que;
}
sub clean_filehandle
{
my $onemore=0;
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
&acquire_semaphore(7755,
"clean_filehandle() at Line: ".__LINE__,1);
my @topcaller=caller;
print "\nINFO: main::clean_filehandle() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::clean_filehandle() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $filehandle=$_[0];
my $cftimeout=$_[1]||0;
if (!defined $filehandle || -1==index $filehandle,'GLOB'
|| !defined fileno $filehandle) {
if (defined $filehandle && (-1==index $filehandle,'GLOB')) {
eval {
$filehandle=$filehandle->{_cmd_handle};
$filehandle=$filehandle->{_cmd_handle}->{_cmd_handle}
if -1==index $filehandle,'GLOB';
};
if (($@ && -1==index $filehandle,'GLOB') ||
!defined fileno $filehandle) {
if (wantarray) {
&release_semaphore(7755);
return '','Invalid filehandle';
} else {
&release_semaphore(7755);
&Net::FullAuto::FA_Core::handle_error($@.
"\n from &main::clean_filehandle(): Line ".__LINE__.
"\n Reminder: Return output to list (\$stdout,\$stderr)".
"\n if you don't want &clean_filehandle() to die",
'__cleanup__');
}
}
} else {
if (wantarray) {
if ($cftimeout) {
&release_semaphore(7755);
return '',"\n\n Command did not complete before timeout".
"\n => $timeout seconds. This is common if".
" the\n command takes more than $timeout".
"\n seconds to complete, and/or no".
"\n output is generated within $timeout".
"\n seconds.\n".
"\n Increase the timeout for the command, or".
"\n if it is a script or program you".
"\n authored, consider adding verbose output".
"\n that appears before the timeout of".
"\n $timeout seconds expires.";
} else {
&release_semaphore(7755);
return '','Invalid filehandle';
}
} else {
&release_semaphore(7755);
&Net::FullAuto::FA_Core::handle_error(
"$filehandle is NOT a valid filehandle".
"\n from &main::clean_filehandle(): Line ".__LINE__.
"\n Reminder: Return output to list (\$stdout,\$stderr)".
"\n if you don't want &clean_filehandle() to die",
'__cleanup__');
}
}
} my $loop=0;my $sec=0;my $ten=0;my $hun=5;my $closederror='';
while (1) {
$Net::FullAuto::FA_Core::uhray=&Net::FullAuto::FA_Core::get_prompt();
$filehandle->print('cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::printfpath.
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
if ($loop==100) {
my $die="100 attempts without indication that filehandle is clean";
if (wantarray) {
&release_semaphore(7755);
return '',$die;
} else {
&release_semaphore(7755);
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
}
}
my $wait=$sec.'.'.$ten.$hun;
if ($wait!=3.00) {
if ($hun==9) {
if ($ten==9) {
$sec++;$ten=0;$hun=0;
} else {
$ten++;$hun=0;
}
} else { $hun++ }
}
select(undef,undef,undef,$wait)
if $loop++!=1; # sleep;
eval {
my $all_lines='';my $loop2=0;
while (my $line=$filehandle->get(Timeout=>30)) {
#print "CLEAN_LINE=$line and ${$Net::FullAuto::FA_Core::uhray}[0]_-<==\n";
print $Net::FullAuto::FA_Core::MRLOG "\nclean_filehandle() (((((((CLEAN_LINE))))))):",
"\n CLEAN_LINE=$line AND LOOKINGFOR=${$Net::FullAuto::FA_Core::uhray}[0]_-<==\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
$all_lines.=$line;
if (-1<index $all_lines,"$Net::FullAuto::FA_Core::uhray->[0]_-") {
if ($all_lines=~/_funkyPrompt_$/s) {
return '','';
} else {
last;
}
} elsif (-1<index $all_lines,'Exit status 0') {
$closederror='Exit status 0';
last;
} elsif (
$all_lines=~/(Conn.*reset|Conn.*closed|filehandle.*isn)/s) {
$closederror=$1;
last;
} elsif ($loop2==100) {
my $die="100 attempts without indication ".
"that filehandle is clean";
if (wantarray) {
&release_semaphore(7755);
return '',$die;
} else {
&release_semaphore(7755);
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__')
}
}
$wait=$sec.'.'.$ten.$hun;
if ($wait!=3.00) {
if ($hun==9) {
if ($ten==9) {
$sec++;$ten=0;$hun=0;
} else {
$ten++;$hun=0;
}
} else { $hun++ }
}
select(undef,undef,undef,$wait)
if $loop2++!=1; # sleep;
}
};
if ($@) {
if (!$onemore) {
if (wantarray) {
&release_semaphore(7755);
return '',$@;
} else {
&release_semaphore(7755);
&Net::FullAuto::FA_Core::handle_error($@.
"\n from &main::clean_filehandle(): Line ".__LINE__.
"\n Reminder: Return output to list (\$stdout,\$stderr)".
"\n if you don't want &clean_filehandle() to die",
'__cleanup__');
}
} else {
$onemore=1;
}
} elsif ($closederror) {
if (wantarray) {
&release_semaphore(7755);
return '',$closederror;
} else {
&release_semaphore(7755);
&Net::FullAuto::FA_Core::handle_error($closederror.
"\n from &main::clean_filehandle(): Line ".__LINE__.
"\n Reminder: Return output to list (\$stdout,\$stderr)".
"\n if you don't want &clean_filehandle() to die",
'__cleanup__');
}
} else {
&release_semaphore(7755);
select(undef,undef,undef,0.02);
# sleep for 1/50th second;
return '',''
}
}
} ## END of &clean_filehandle
sub attempt_cmd_xtimes
{
my @topcaller=caller;
print "\nINFO: main::attempt_cmd_xtimes() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "\nmain::attempt_cmd_xtimes() (((((((CALLER))))))):",
"\n ",(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $cmd_handle=$_[0];
my $cmd=$_[1];
my $num_of_attempts=$_[2]||100;
my $stdout='';my $stderr='';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
if (-1==index $cmd_handle,'GLOB' || !defined fileno $cmd_handle) {
if (-1==index $cmd_handle,'GLOB') {
eval {
$cmd_handle=$cmd_handle->{_cmd_handle};
$cmd_handle=$cmd_handle->{_cmd_handle}->{_cmd_handle}
if -1==index $cmd_handle,'GLOB';
};
if (($@ && -1==index $cmd_handle,'GLOB') ||
!defined fileno $cmd_handle) {
if (wantarray) {
return '','Connection closed';
} else {
&Net::FullAuto::FA_Core::handle_error($@,'__cleanup__')
}
}
} else {
if (wantarray) {
return '','Connection closed';
} else {
&Net::FullAuto::FA_Core::handle_error(
"$cmd_handle is NOT a valid filehandle",'__cleanup__')
}
}
}
my $hostlabel=$_[2];
my $cou=100;
while ($cou--) {
($stdout,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
$cmd,'__live__');
print "\nOUTPUT FROM \" attempt_cmd_xtimes()\" (problamatic cmds that often need to be tried",
" more than once):\n ==>$stdout<== at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nOUTPUT FROM \" attempt_cmd_xtimes()\" (problamatic cmds that often need to be tried",
" more than once):\n ==>$stdout<== at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (!$stdout) {
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
$cfh_error||='Not a GLOB reference' if $cou==1;
&handle_error($cfh_error,'-1') if $cfh_error;
select(undef,undef,undef,0.02);
$cmd_handle->print(
$Net::FullAuto::FA_Core::printfpath.'printf \\\\041\\\\041;$cmd;'.
$Net::FullAuto::FA_Core::printfpath.'printf \\\\045\\\\045');
my $allins='';my $ct=0;
while (my $line=$cmd_handle->get) {
chomp($line=~tr/\0-\37\177-\377//d);
$allins.=$line;
#print "PUSH_CMD_LINE_QQQQQQQQQQQ=$allins<== AND LINE=$line<==\n";
print $Net::FullAuto::FA_Core::MRLOG "PUSH_CMD_LINE_QQQQQQQQQQQ=$allins<== AND LINE=$line<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($allins=~/!!(.*)%%/) {
$stdout=$1;
last;
} else {
$cmd_handle->
print($Net::FullAuto::FA_Core::printfpath.'printf \\\\055');
}
if ($ct++==10) {
$cmd_handle->print;
last;
}
}
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
} else { last }
}
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
return $stdout;
}
sub master_transfer_dir
{
my $localhost=$_[0];
my $tdir='';my $transfer_dir='';my $curdir='';
my $output='';my $stderr='';my $work_dirs={};my $endp=0;my $testd='';
while (1) {
if ($^O eq 'cygwin') {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
$cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w $curdir");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
$work_dirs->{_pre}=$curdir.'/' if $curdir ne '/';
$work_dirs->{_pre_mswin}=$cdr.'\\\\';
} else {
($curdir,$stderr)=$localhost->cmd('pwd');
$work_dirs->{_pre}=$curdir.'/' if $curdir ne '/';
}
if (!$curdir || $curdir=~/^\s*$/s ||
256<length $curdir || $curdir=~/\n/s) {
print "\nWARNING: PROBLEMS ACQUIRING CURRENT DIRECTORY ",
"(TRYING AGAIN):",
" ==>$curdir<== ".
" at Line ",__LINE__,"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nWARNING: PROBLEMS ACQUIRING CURRENT DIRECTORY (TRYING AGAIN):",
" ==>$curdir<== ".
" at Line ",__LINE__,"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
next;
}
last if $curdir;
}
if (exists $Hosts{"__Master_${$}__"}{'TransferDir'}) {
$master_transfer_dir=$tdir=$Hosts{"__Master_${$}__"}{'TransferDir'};
if ($^O eq 'cygwin' && $tdir=~/^[\\|\/]/
&& $tdir!~/$localhost->{_cygdrive_regex}/o) {
if (($work_dirs->{_tmp},$work_dirs->{_tmp_mswin})
=&File_Transfer::get_drive(
$tdir,'Target','',"__Master_${$}__")) {
$testd=&test_dir($localhost->{_cmd_handle},
$work_dirs->{_tmp});
if ($testd eq 'WRITE') {
if (lc($work_dirs->{_tmp_mswin}) ne lc($curdir)) {
($output,$stderr)=$localhost->cmd(
'cd '.${Net::FullAuto::FA_Core::work_dirs}{_tmp});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin};
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp};
} else {
&Net::FullAuto::FA_Core::handle_error(
'TransferDir not Writable');
}
}
} elsif ($tdir=~/^[a-zA-Z]:/) {
if ($^O eq 'cygwin') {
my ($drive,$path)=unpack('a1 x1 a*',$tdir);
$path=~tr/\\/\//;
${$work_dirs}{_cwd}=$localhost->{_cygdrive}
.'/'.lc($drive).$path.'/';
$testd=&test_dir($localhost->{_cmd_handle},
${$work_dirs}{_cwd});
if ($testd eq 'WRITE') {
if ($tdir ne $curdir) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_cwd});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$work_dirs->{_cwd_mswin}=$tdir.'\\';
} else {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin};
$work_dirs->{_cwd}=$work_dirs->{_pre};
}
$work_dirs->{'_tmp_mswin'}=$work_dirs->{'_cwd_mswin'};
$master_transfer_dir=$work_dirs->{'_tmp'}=$work_dirs->{'_cwd'};
return $work_dirs;
} else {
&Net::FullAuto::FA_Core::handle_error(
"TransferDir not Writable and TESTD=$testd<==".
" and work_dirs-_cwd=$work_dirs->{_cwd}<==");
}
}
my $warn="Cannot cd to $tdir\n\tOperating " .
"System is $^O - NOT cygwin!";
warn "$warn $!";
} $tdir=~tr/\\/\//;
$testd=&test_dir($localhost->{_cmd_handle},$tdir);
if ($testd eq 'WRITE') {
my $drive='';my $path='';
if ($^O eq 'cygwin') {
$tdir=~s/$localhost->{_cygdrive_regex}//;
($drive,$path)=unpack('a1 a*',$tdir);
$tdir=$drive.':'.$path;
$tdir=~tr/\//\\/;
$tdir=~s/\\/\\\\/g;
}
if ($tdir ne $curdir) {
if ($^O eq 'cygwin') {
$work_dirs->{_cwd}=$localhost->{_cygdrive}
.'/'.lc($drive).$path.'/';
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_cwd});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$work_dirs->{_cwd_mswin}=$tdir.'\\';
} else {
($output,$stderr)=$localhost->cmd("cd $tdir");
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$work_dirs->{_cwd}=$tdir.'/';
}
} else {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin}
if $^O eq 'cygwin';
$work_dirs->{_cwd}=$work_dirs->{_pre};
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin}
if $^O eq 'cygwin';
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};
return $work_dirs;
}
}
if ($^O eq 'cygwin') {
($output,$stderr)=$localhost->cmd("cd /tmp");
print $Net::FullAuto::FA_Core::MRLOG
"\nTTTTTTT cd /tmp TTTTTTT OUTPUT ==>$output<== ",
"and STDERR ==>$stderr<==",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nTTTTTTT cd /tmp TTTTTTT OUTPUT ==>$output<== ",
"and STDERR ==>$stderr<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
if (!$stderr || ($stderr=~/^.*cd \/tmp 2[>][&]1$/)) {
my $cnt=2;
while ($cnt--) {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
$cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w $curdir");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
$testd=&test_dir($localhost->{_cmd_handle},$curdir);
print $Net::FullAuto::FA_Core::MRLOG
"\nDDDDDDD &test_dir() of $curdir DDDDDDD OUTPUT ==>$testd<==",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nDDDDDDD &test_dir of $curdir DDDDDDD OUTPUT ==>$testd<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin}=$cdr.'\\\\';
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$curdir;
return $work_dirs;
} elsif ($testd eq 'READ' || $testd eq 'NOFILE') {
last;
} else {
($output,$stderr)=$localhost->cmd('cd -')
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
}
}
if ((${$work_dirs}{_tmp},${$work_dirs}{_tmp_mswin})
=&File_Transfer::get_drive(
'/tmp','Target','',"__Master_${$}__")) {
$testd=&test_dir($localhost->{_cmd_handle},
$work_dirs->{_tmp});
if ($testd eq 'WRITE') {
if (lc($work_dirs->{_tmp_mswin}) ne lc($curdir)) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_tmp});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin};
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};
return $work_dirs;
}
}
if (($work_dirs->{_tmp},$work_dirs->{_tmp_mswin})
=&File_Transfer::get_drive(
'/temp','Target','',"__Master_${$}__")) {
$testd=&test_dir($localhost->{_cmd_handle},
$work_dirs->{_tmp});
if ($testd eq 'WRITE') {
if (lc($work_dirs->{_tmp_mswin}) ne lc($curdir)) {
($output,$stderr)=$localhost->cmd(
'cd '.$work_dirs->{_tmp});
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
$work_dirs->{_tmp_mswin}=$work_dirs->{_cwd_mswin};
$master_transfer_dir=$work_dirs->{_tmp}
=$work_dirs->{_cwd};
return $work_dirs;
}
}
($output,$stderr)=$localhost->cmd("cd $home_dir");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
if (!$stderr) {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
$cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w $curdir");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\//\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
$testd=&test_dir($localhost->{_cmd_handle},$curdir);
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin}=$cdr.'\\';
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$curdir;
return $work_dirs;
} else {
($output,$stderr)=$localhost->cmd('cd -')
&handle_error($stderr,'-2','__cleanup__') if $stderr;
}
}
$testd=&test_dir($localhost->{_cmd_handle},$curdir);
if ($testd eq 'WRITE') {
$work_dirs->{_cwd_mswin}=$work_dirs->{_pre_mswin};
$work_dirs->{_tmp_mswin}=$work_dirs->{_pre_mswin};
$work_dirs->{_cwd}=$work_dirs->{_tmp}=$work_dirs->{_pre};
return $work_dirs;
} else {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!";
&handle_error($die,'__cleanup__');
}
} $testd=&test_dir($localhost->{_cmd_handle},'/tmp');
if ($testd eq 'WRITE') {
($output,$stderr)=$localhost->cmd('cd /tmp')
if '/tmp' ne $curdir;
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}='/tmp/';
return $work_dirs;
} $testd=&test_dir($localhost->{_cmd_handle},$home_dir);
if ($testd eq 'WRITE') {
($output,$stderr)=$localhost->cmd("cd $home_dir")
if $home_dir ne $curdir;
&handle_error($stderr,'-2','__cleanup__') if $stderr;
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}=$home_dir.'/';
return $work_dirs;
}
$testd=&test_dir($localhost->{_cmd_handle},$curdir);
print $Net::FullAuto::FA_Core::MRLOG
"\nDDDDDDD &test_dir() of $curdir DDDDDDD OUTPUT ==>$testd<==",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nDDDDDDD &test_dir of $curdir DDDDDDD OUTPUT ==>$testd<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if ($testd eq 'WRITE') {
$master_transfer_dir=$work_dirs->{_cwd}
=$work_dirs->{_tmp}=$curdir.'/';
return $work_dirs;
} else {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!";
&handle_error($die,'__cleanup__');
}
}
sub master_transfer_dir_no_telnet_login
{
#my $transfer_dir='';
my $curdir=Cwd::getcwd();
if (exists $Hosts{"__Master_${$}__"}{'TransferDir'}
&& -d $Hosts{"__Master_${$}__"}{'TransferDir'}
&& -w _) {
$master_transfer_dir=$Hosts{"__Master_${$}__"}{'TransferDir'};
if (unpack('x1 a1',"$master_transfer_dir") eq ':') {
my ($drive,$path)=unpack('a1 @2 a*',$master_transfer_dir);
$path=~tr/\\/\//;
$master_transfer_dir=$localhost->{_cygdrive}."/$drive$path/";
}
} elsif ($^O ne 'cygwin' &&
$^O ne 'MSWin32' &&
$^O ne 'MSWin64' &&
$ENV{OS} ne 'Windows_NT' &&
-d '/tmp' && -w _) {
$master_transfer_dir="/tmp/";
} elsif ($^O eq 'cygwin' &&
-d $localhost->{_cygdrive}.'/c/tmp' && -w _) {
$master_transfer_dir=$localhost->{_cygdrive}.'/c/tmp/';
} elsif ($^O eq 'cygwin' &&
-d $localhost->{_cygdrive}.'/c/temp' && -w _) {
$master_transfer_dir=$localhost->{_cygdrive}.'/c/temp/';
} elsif (-d $home_dir && -w _) {
$master_transfer_dir=$home_dir;
if (unpack('@1 a1',$master_transfer_dir) eq ':') {
my ($drive,$path)=unpack('a1 x1 a*',$master_transfer_dir);
$path=~tr/\\/\//;
$master_transfer_dir=$localhost->{_cygdrive}.'/'.lc($drive).$path.'/';
}
} elsif (!(-w $curdir)) {
my $die="\n FATAL ERROR - Cannot Write to "
."Local Host $Net::FullAuto::FA_Core::Local_HostName!\n";
print $die if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG $die if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} else {
print "GETTING CURDIR FOR TRANSFER=",cwd(),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "GETTING CURDIR FOR TRANSFER=",cwd(),"\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$master_transfer_dir=$curdir;
}
print "YEPPERSSSSSS\n";<STDIN>;
$localhost->{_cwd}{_cwd}=Cwd::getcwd();
return $master_transfer_dir;
}
sub getpasswd
{
my @topcaller=caller;
print "\nINFO: main::getpasswd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::getpasswd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $passlabel=$_[0];$passlabel||='';my $use='';
my $host='';
if (exists $Hosts{$passlabel}) {
if (exists $Hosts{$passlabel}{'HostName'}) {
if (exists $Hosts{$passlabel}{'IP'}) {
if (exists $Hosts{$passlabel}{'Use'}) {
if (lc($Hosts{$passlabel}{'Use'}) eq 'ip') {
if (ref $Hosts{$passlabel}{'IP'} eq 'CODE') {
$host=$Hosts{$passlabel}{'IP'}->();
} else {
$host=$Hosts{$passlabel}{'IP'};
}
$use='ip';
} else {
$host=$Hosts{$passlabel}{'HostName'};
$use='hostname';
}
} else {
$host=$Hosts{$passlabel}{'HostName'};
$use='hostname';
}
} else {
$host=$Hosts{$passlabel}{'HostName'};
$use='hostname';
}
} elsif (exists $Hosts{$passlabel}{'IP'}) {
if (ref $Hosts{$passlabel}{'IP'} eq 'CODE') {
$host=$Hosts{$passlabel}{'IP'}->();
} else {
$host=$Hosts{$passlabel}{'IP'};
}
$use='ip';
}
}
my $login_id=$_[1];
my $force=0;my $su_login=0;
my $ms_domain='';my $errmsg='';
my $track='';my $prox='';
my $pass='';my $save_passwd='';
my $cmd_type='';my $status='';
my $encrypted_passwd='';
my $bdb='';
if (defined $_[2] && $_[2]) {
if ($_[2] eq '__force__') {
$force=1;
} elsif ($_[2] eq '__su__') {
$su_login=1;
} else {
$ms_domain=$_[2];
}
}
if (defined $_[3] && $_[3]) {
if ($_[3] eq '__force__') {
$force=1;
} elsif ($_[3] eq '__su__') {
$su_login=1;
} else {
$errmsg=$_[3];
$errmsg=~s/\s+$//s;
$errmsg.="\n";
$force=1;
}
}
if (defined $_[4] && $_[4]) {
if ($_[4] eq '__force__') {
$force=1;
} elsif ($_[4] eq '__su__') {
$su_login=1;
} else {
$track=$_[4];
}
}
if (defined $_[5] && $_[5]) {
if ($_[5] eq '__force__') {
$force=1;
} elsif ($_[5] eq '__su__') {
$su_login=1;
} else {
$cmd_type=$_[5];
$prox='SMB_Proxy' if $cmd_type eq 'smb';
}
}
if (defined $_[6] && $_[6]) {
if ($_[6] eq '__force__') {
$force=1;
} elsif ($_[6] eq '__su__') {
$su_login=1;
}
}
if (defined $_[7] && $_[7]) {
if ($_[7] eq '__force__') {
$force=1;
} elsif ($_[7] eq '__su__') {
$su_login=1;
}
}
my $cipher='';
if ($Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
}
my $local_host_flag=0;my $href='';
if (exists $same_host_as_Master{$passlabel} ||
($passlabel eq "__Master_${$}__")) {
foreach my $hostlab (keys %same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";
$passlabel=$hostlab;
$local_host_flag=1;
last;
}
if (!$local_host_flag) {
$passlabel=$Net::FullAuto::FA_Core::local_hostname;
$local_host_flag=1;
}
}
if (!$passlabel) {
my $herr="HOSTLABEL or LABEL needed for first arguement to &getpasswd()"
."\n\n Called from ".(caller(0))[1]." line "
.(caller(0))[2]." :\n ";
&handle_error($herr.($!));
}
my $key='';
if ($Net::FullAuto::FA_Core::plan) {
#my $pl=$Net::FullAuto::FA_Core::plan->{Number};
#print "WHAT IS PL=$pl<==\n";<STDIN>;
if ($local_host_flag && $username eq $login_id) {
$key="${username}_X_${passlabel}_X_${$}_X_$invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${passlabel}_X_${cmd_type}";
} else {
$key="${username}_X_${login_id}_X_${passlabel}";
}
} else {
if ($local_host_flag && $username eq $login_id) {
$key="${username}_X_${passlabel}_X_${$}_X_$invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${passlabel}_X_${cmd_type}";
} else {
$key="${username}_X_${login_id}_X_${passlabel}";
}
}
if ($Net::FullAuto::FA_Core::scrub) {
if ($passlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";
unless ($Net::FullAuto::FA_Core::tosspass) {
&scrub_passwd_file($hostlab,$login_id);
} else {
delete $Net::FullAuto::FA_Core::tosspass{$key};
}
}
} else {
unless ($Net::FullAuto::FA_Core::tosspass) {
&scrub_passwd_file($passlabel,$login_id)
} else {
delete $Net::FullAuto::FA_Core::tosspass{$key};
}
} $force=1;
}
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;
my $tie_err="can't open tie to "
. $Hosts{"__Master_${$}__"}{'FA_Secure'}
."${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db";
unless ($Net::FullAuto::FA_Core::tosspass) {
print $MRLOG "PASSWDDB=",
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db","<==\n"
if -1<index $MRLOG,'*';
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path(
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
$status=$bdb->db_get($passlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
$href||={};
print $MRLOG "HREF=$href and KEY=$key and KEYS=",
(join "\n",keys %{$href}),"<==\n"
if -1<index $MRLOG,'*';
if (exists $href->{$key} && !$force) {
my $pspath=$Net::FullAuto::FA_Core::pspath;
if (exists $Hosts{"__Master_${$}__"}{'ps'}) {
$pspath=$Hosts{"__Master_${$}__"}{'ps'};
$pspath.='/' if $pspath!~/\/$/;
}
my $stdout='';my $stderr='';
($stdout,$stderr)=
&Net::FullAuto::FA_Core::cmd(
"${pspath}ps -e",'__escape__');
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__')
if $stderr;
my $encrypted_passwd=$href->{$key};
foreach my $ky (keys %{$href}) {
if ($ky=~/_X_(\d+)_X_\d+$/) {
my $one=$1;
delete $href->{$ky} if (-1==index $stdout,$one);
}
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($passlabel,$put_href);
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
$pass='';
eval {
$pass=$cipher->decrypt($encrypted_passwd);
chop $pass if $pass eq substr($pass,0,(rindex $pass,'.')).'X';
};
# --CONTINUE-- print "WHAT IS PASS=$pass<====\n";
return $pass if $pass && $pass!~tr/\0-\37\177-\377//;
if (!$pass && $oldpasswd) {
my $cipher = new Crypt::CBC($oldpasswd,
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
$save_passwd=$cipher->decrypt($encrypted_passwd);
}
} elsif (keys %{$href}) {
foreach my $ky (keys %{$href}) {
if ($ky=~/_X_(\d+)_X_\d+$/) {
unless (&Net::FullAuto::FA_Core::testpid($1)) {
delete $href->{$ky}
unless &Net::FullAuto::FA_Core::testpid($1);
}
}
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($passlabel,$put_href);
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
} else {
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
}
&scrub_passwd_file($passlabel,$login_id) if
$errmsg=~/Permission denied|Password:/s;
# SCRUB PROBLEM;
} elsif (!$force && (exists $Net::FullAuto::FA_Core::tosspass{$key})) {
$save_passwd=$Net::FullAuto::FA_Core::tosspass{$key};
}
if (!$save_passwd) {
if ($Net::FullAuto::FA_Core::cron) {
if ($Net::FullAuto::FA_Core::tosspass) {
my $die="\n\nBoth 'cron' and 'tosspass' Conditions"
." Active.\n\n Hostlabel: "
." $passlabel\n Login ID: $login_id\n "
." Needed For: $host\n\n "
." &getpasswd() Called from ".(caller(0))[1]." line "
.(caller(0))[2]."\n"
."\n - 'cron' and 'tossposs' are incompatible "
."conditions "
."\n and cannot be specified together for any "
."FullAuto "
."\n invocation.\n";
&handle_error($die,'',$track);
return '',$die;
} elsif ($host) {
my $die="Invalid Password Stored for\n\n Hostlabel: "
." $passlabel\n Login ID: $login_id\n "
." Needed For: $host\n\n "
." &getpasswd() Called from ".(caller(0))[1]." line "
.(caller(0))[2]."\n"
."\n - Run $Net::FullAuto::FA_Core::progname outside "
."of cron and enter "
."\n the correct Password when prompted.\n";
&handle_error($die,'',$track);
return '',$die;
} else {
my $die="Invalid Password Stored for\n\n Label:"
." $passlabel\n Login ID: $login_id"
."\n\n "
."&getpasswd() Called from ".(caller(0))[1]." line "
.(caller(0))[2]."\n"
."\n - Run $Net::FullAuto::FA_Core::progname "
."outside of cron and enter "
."\n the correct Password when prompted.\n";
&handle_error($die,'',$track);
return '',$die;
}
}
my $loop_count=0;
while (1) {
$loop_count++;
print $blanklines;
print "\n ERROR MESSAGE-> $errmsg" if $errmsg;
my $print1='';
if ($ms_domain) {
if ($local_host_flag) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (1) the MS Domain password for "
.$login_id
."\n (Needed for Local Host \'$passlabel\' - $host)"
."\n";
} else {
$print1="\n Please Enter the MS Domain password for "
.$login_id
."\n (Needed for Local Host \'$passlabel\' - $host)"
."\n";
}
} elsif ($host) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (2) the MS Domain password "
."for $login_id"
."\n (Needed for HostLabel \'$passlabel\' - $host)\n";
} else {
$print1="\n Please Enter the MS Domain password for "
.$login_id
."\n (Needed for HostLabel \'$passlabel\' - $host)\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (3) authentication password."
."\n (Needed for Label \'$passlabel\')\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for Label \'$passlabel\')\n";
}
}
} elsif ($login_id eq 'root') {
if ($local_host_flag) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (4) the \'root\' password "
."for $host."
."\n (Needed for Local Host, "
."HostLabel \'$passlabel\')\n";
} else {
$print1="\n Please Enter the \'root\' password for $host."
."\n (Needed for Local Host, "
."HostLabel \'$passlabel\')\n";
}
} elsif ($host) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (5) the \'root\' password "
."for $host."
."\n (Needed for HostLabel \'$passlabel\')\n";
} else {
$print1="\n Please Enter the \'root\' password for $host."
."\n (Needed for HostLabel \'$passlabel\')\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (6) authentication password."
."\n (Needed for Label \'$passlabel\')\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for Label \'$passlabel\')\n";
}
}
} else {
if ($local_host_flag && !$passlabel) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (7) $login_id\'s "
."password for $host."
."\n (WNeeded for ${prox}Local Host \'$host\')\n";
} else {
$print1="\n Please Enter $login_id\'s password for $host."
."\n (WNeeded for ${prox}Local Host \'$host\')\n";
}
} elsif ($host) {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (8) $login_id\'s password "
."for $host."
."\n (Needed for ${prox}HostLabel \'$passlabel\')\n";
} else {
$print1="\n Please Enter $login_id\'s password for $host."
."\n (Needed for ${prox}HostLabel \'$passlabel\')\n";
}
} else {
if ($Net::FullAuto::FA_Core::debug) {
$print1="\n Please Enter (9) authentication password."
."\n (Needed for ${prox}Label \'$passlabel\')\n";
} else {
$print1="\n Please Enter authentication password."
."\n (Needed for ${prox}Label \'$passlabel\')\n";
}
}
}
my $passwd_timeout=350;
my $te_time=time;
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);
&acquire_semaphore(9854,
"Password Input Prompt at Line: ".__LINE__,1);
print $print1;
print "\n PasswordX1: ";
ReadMode 2;
$save_passwd=<STDIN>;
&release_semaphore(9854);
alarm(0);
};
if ($@ eq "alarm\n") {
print "\n\n";
$errmsg.="\n\n ".
"Time Allowed for Password Input has Expired.\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq 'notify_on_error') {
my $body='';
$body="\n ERROR MESSAGE-> $errmsg" if $errmsg;
$body.=$print1;my $subject='';
if ($host) {
$subject="Login Failed for $login_id on $host";
} else {
$subject="Authentication Failed";
}
my %mail=(
'Body' => $body,
'Subject' => $subject
);
&Net::FullAuto::FA_Core::send_email(\%mail);
}
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');
}
my $te_time2=time;
if (10<$loop_count ||
(($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$save_passwd)) {
print "\n";
&handle_error(
"\n FATAL ERROR: Password Input Prompt appeared".
"\n in what appears to be an unattended".
"\n process/job - no password was entered".
"\n and one is ALWAYS required with".
"\n FullAuto. The Prompt does not appear".
"\n to have paused at all - which is".
"\n proper and expected when FullAuto".
"\n is invoked from cron, but no password".
"\n was previously saved".
"\n Remedy: Run FullAuto manually with the".
"\n --password option (with no actual".
"\n password following the option) and".
"\n choose an appropriate expiration time".
"\n with the resulting menus.",
'__cleanup__');
}
ReadMode 0;
chomp($save_passwd);
print "\n\n";
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq 'notify_on_error') {
my $body='';
$body="\n ERROR MESSAGE-> $errmsg" if $errmsg;
$body.=$print1;my $subject='';
if ($host) {
$subject="Login Failed for $login_id on $host";
} else {
$subject="Authentication Failed";
}
my %mail=(
'Body' => $body,
'Subject' => $subject
);
&Net::FullAuto::FA_Core::send_email(\%mail);
}
last if $save_passwd;
}
}
unless ($Net::FullAuto::FA_Core::tosspass) {
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path(
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB:".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
$status=$bdb->db_get($passlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
while (delete $href->{$key}) {}
$save_passwd.='X' if $save_passwd
eq substr($Net::FullAuto::FA_Core::progname,0,
(rindex $Net::FullAuto::FA_Core::progname,'.'));
my $cipher='';my $mr="__Master_${$}__";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
if (8<length $Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
#$cipher = new Crypt::CBC($Net::FullAuto::FA_Core::passwd[1],
#$cipher = new Crypt::CBC($Net::FullAuto::FA_Core::passetts->[1],
# $Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
my $new_encrypted=$cipher->encrypt($save_passwd);
$href->{$key}=$new_encrypted;
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($passlabel,$put_href);
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
} else {
$Net::FullAuto::FA_Core::tosspass{$key}=$save_passwd;
}
return $save_passwd;
}
sub chgdir
{
my $pwd='';my $destdir=$_[1];
my $cmd_handle=$_[0];
$cmd_handle->cmd("cd $destdir");
($pwd)=$cmd_handle->cmd('pwd');
$pwd=~s/^(.*)?{\n}.*$/$1/;
chomp($pwd);
#print "PWD=$pwd and DEST=$_[1]\n";<STDIN>;
if ($pwd eq $_[1] or "$pwd/" eq "$_[1]") { return 1 }
else {
print "FATAL ERROR! The directory \"$_[1]\" does NOT exist!";
return 0;
}
}
sub runcmd # USAGE: &runcmd(FileHandle, "command_to_run_string")
{
my @output=${$_[0]}->cmd($_[1]);
foreach (@output) {
if (/Execute permiss/) {
print "FATAL ERROR! Execute permission denied for command:";
print "--> $_[1]\n";
return 0;
}
} return \@output;
}
sub check_if_websphere_is_running
{
my ($cmd_handle,$applic)=@_;
return if $websphere_not_running==1;
my @ls=$cmd_handle->cmd("ls -C1 /usr/WebSphere/AppServer/bin");
my $wscp_UX||='';
@ls=grep { /^wscp/ } @ls;
print "--> Verifying that WebSphere is Offline ...\n";
my $wscp_sub = sub {
my $wscp_copy=$wscp_UX;
substr($wscp_copy,(index $wscp_UX,'__JVM__'),7)=$_[1];
#&chgdir($cmd_handle,"/usr/WebSphere/AppServer/bin")
# || handle_error(
# "Cannot &chgdir /usr/WebSphere/AppServer/bin");
my ($output,$stderr)=$cmd_handle->cwd(
"/usr/WebSphere/AppServer/bin");
&handle_error($stderr,'-1') if $stderr;
my $app='';
$output=&runcmd($_[0],$wscp_copy) ||
&handle_error("Cannot &runcmd $wscp_copy");
my @output=@{$output};
if ($applic eq 'member') { $app='Empire' }
elsif ($applic eq 'provider') { $app='Provider' }
foreach (@output) {
if (/Running|Initializing/ &&
(($app eq 'Empire' && /(EmpireServer.*)}/m) ||
($app eq 'Provider' && /(ProviderServer.*)}/m))) {
my $serv="";($serv=$1)=~s/}.*$//;
my $die="\n FATAL ERROR! - \"$serv\" is RUNNING!\n\n";
print $die if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
}
}
};
foreach (@ls) {
chomp;
my $num='';
($num=$_)=~s/^wscp(\d+)\.sh$/$1/;
$num='' if substr($num,0,4)=='wscp';
$wscp_sub->($cmd_handle,$num);
} $websphere_not_running=1;
}
sub apache_download
{
$| = 1; # autoflush
my $ua = new LWP::UserAgent;
my ($file,$host,$hostlabel)=@_;
my ($size,$start_t,$length,$flength,$last_dur)='';
$ua->agent("$progname " . $ua->agent);
my $un=$username;
#print "GP3\n";
$ua->credentials("$Hosts{\"__Master_${$}__\"}{'IP'}:80",'WebRSH',
"$un",&getpasswd($hostlabel,$un));
$ua->env_proxy;
my $url="http://${$ApacheNode[0]}[0]/download/$_[0]";
my $req = new HTTP::Request GET => $url;
my $shown = 0; # have we called the show() function yet
my $res = $ua->request($req,
sub {
my $res = $_[1];
open(FILE, ">$file") ||
&handle_error("Can't open $file: ");
binmode FILE;
$length = $res->content_length;
$flength = fbytes($length) if defined $length;
$start_t = time;
$last_dur = 0;
$size += length($_[0]);
print FILE $_[0];
if (defined $length) {
my $dur = time - $start_t;
if ($dur != $last_dur) { # don't update too often
$last_dur = $dur;
my $perc = $size / $length;
my $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
my $secs_left = fduration($dur/$perc - $dur);
$perc = int($perc*100);
my $show = "$perc% of $flength";
$show .= " (at $speed, $secs_left remaining)" if $speed;
show($show, 1);
}
} else {
show( fbytes($size) . " received");
}
}
);
if ($res->is_success || $res->message =~ /^Interrupted/) {
show("");
print "\r";
print fbytes($size);
print " of ", fbytes($length) if defined($length) && $length != $size;
print " received";
my $dur = time - $start_t;
if ($dur) {
my $speed = fbytes($size/$dur) . "/sec";
print " in ", fduration($dur), " ($speed)";
}
print "\n";
my $died = $res->header("X-Died");
if ($died || !$res->is_success) {
if (-t) {
print "Transfer aborted. Delete $file? [n] ";
my $ans = <STDIN>;
unlink($file) if defined($ans) && $ans =~ /^y\n/;
} else {
print "Transfer aborted, $file kept\n";
}
}
} else {
print "\n" if $shown;
print "${Net::FullAuto::FA_Core::progname}.pl: ", $res->status_line, "\n";
exit 1;
}
}
sub fbytes
{
my $n = int(shift);
if ($n >= 1024 * 1024) {
return sprintf "%.3g MB", $n / (1024.0 * 1024);
} elsif ($n >= 1024) {
return sprintf "%.3g KB", $n / 1024.0;
} else {
return "$n bytes";
}
}
sub fduration
{
use integer;
my $secs = int(shift);
my $hours = $secs / (60*60);
$secs -= $hours * 60*60;
my $mins = $secs / 60;
$secs %= 60;
if ($hours) {
return "$hours hours $mins minutes";
} elsif ($mins >= 2) {
return "$mins minutes";
} else {
$secs += $mins * 60;
return "$secs seconds";
}
}
BEGIN {
my @ani = qw(- \ | /);
my $ani = 0;
sub show
{
my($mess, $show_ani) = @_;
print "\r$mess" . (" " x (75 - length $mess));
print $show_ani ? "$ani[$ani++]\b" : " ";
$ani %= @ani;
$shown++;
}
}
sub Net::Telnet::select_dir
{
print "NetSELECTDIRCALLER=",caller,"\n";#<STDIN>;
return File_Transfer::select_dir(@_);
}
sub Net::Telnet::diff
{
return File_Transfer::diff(@_);
}
sub Net::Telnet::mirror
{
return File_Transfer::mirror(@_);
}
sub send_email
{
my @topcaller=caller;
print "\nINFO: main::send_email() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::send_email() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $usage='notify_on_error';my $mail_module='Mail::Sender';
my $mail_method='';my $mail_server='';my $mail_port='';
my $bcc='';my $cc='';my $content_type='';my $priority='';
my $content_transfer_encoding='';my $content_disposition='';
my $date='';my $from='';my $keywords='';my $message_id='';
my $mime_version='';my $organization='';my $received='';
my $references='';my $reply_to='';my $resent_from='';
my $return_path='';my $sender='';my $subject='';my $body='';
my $to='';my $sendemail=0;my $done_warning=0;my $transport='';
my $head='';my $mail_sender='';my %mail_sender_defaults=();
my $mail_info=$_[0];my $ent='';
my $warn=1 if grep { lc($_) eq '__warn__' } @_;
#tie *debug, "Net::FullAuto::MemoryHandle";
if (ref $mail_info eq 'HASH') {
if (exists ${$mail_info}{Usage}) {
$usage=${$mail_info}{Usage};
} elsif ($email_defaults &&
(exists $email_defaults{Usage})) {
$usage=$email_defaults{Usage};
}
if ($usage ne 'notify_on_error'
&& (caller(1))[3] eq 'FA_Core::handle_error') {
return 0;
}
if (exists ${$mail_info}{Mail_Method}) {
$mail_method=${$mail_info}{Mail_Method};
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Method})) {
$mail_method=$email_defaults{Mail_Method};
}
if (exists ${$mail_info}{Mail_Server}) {
$mail_server=${$mail_info}{Mail_Server};
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Server})) {
$mail_server=$email_defaults{Mail_Server};
}
if (exists ${$mail_info}{Mail_Port}) {
$mail_port=${$mail_info}{Mail_Port};
} elsif ($email_defaults &&
(exists $email_defaults{Mail_Port})) {
$mail_port=$email_defaults{Mail_Port};
}
if ($mail_method=~/smtp/i) {
if ($mail_server) {
if ($mail_port) {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server,
prot => $mail_port
});
} else {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server
});
}
}
}
$ent = MIME::Entity->build(Type => "multipart/mixed",
'X-Mailer' => undef);
if (exists ${$mail_info}{Bcc}) {
$ent->head->mime_attr(Bcc=>${$mail_info}{Bcc});
$sendemail=1;
} elsif ($email_defaults &&
(exists $email_defaults{Bcc})) {
$ent->head->mime_attr(Bcc=>${$email_defaults}{Bcc});
$sendemail=1;
}
if (exists ${$mail_info}{Cc}) {
$ent->head->mime_attr(Cc=>${$mail_info}{Cc});
$sendemail=1;
} elsif ($email_defaults &&
(exists $email_defaults{Cc})) {
$ent->head->mime_attr(Cc=>${$email_defaults}{Cc});
$sendemail=1;
}
if (exists ${$mail_info}{"Reply-To"}) {
$ent->head->mime_attr("Reply-To"=>${$mail_info}{"Reply-To"});
} elsif ($email_defaults &&
(exists $email_defaults{"Reply-To"})) {
$ent->head->mime_attr("Reply-To"=>${$email_defaults}{"Reply-To"});
}
if (exists ${$mail_info}{Priority}) {
$ent->head->mime_attr("Importance:"=>1);
}
if (exists ${$mail_info}{From}) {
$ent->head->mime_attr(From=>${$mail_info}{From});
} elsif ($email_defaults &&
(exists $email_defaults{From})) {
$ent->head->mime_attr(From=>${$email_defaults}{From});
} else {
if (!$Net::FullAuto::FA_Core::username) {
$Net::FullAuto::FA_Core::username=getlogin || getpwuid($<)
}
$ent->head->mime_attr(From=>
"$Net::FullAuto::FA_Core::progname".
"\@$Net::FullAuto::FA_Core::local_hostname");
}
if (exists ${$mail_info}{Subject}) {
$ent->head->mime_attr(Subject=>${$mail_info}{Subject});
} elsif ($email_defaults &&
(exists $email_defaults{Subject})) {
$ent->head->mime_attr(Subject=>${$email_defaults}{Subject});
} elsif ($usage eq 'notify_on_error') {
if ($warn) {
$subject="WARNING! from $Net::FullAuto::FA_Core::local_hostname";
} else {
$subject="FATAL ERROR! from ".
$Net::FullAuto::FA_Core::local_hostname;
}
$ent->head->mime_attr(Subject=>$subject);
$ent->head->mime_attr("Importance:"=>1) unless $warn;
}
if (exists ${$mail_info}{To}) {
if ($email_defaults &&
(exists $email_defaults{To})) {
$to=[];
push @{$to}, @{$email_defaults{To}};
}
if (exists ${$mail_info}{To} && ${$mail_info}{To}) {
if (ref ${$mail_info}{To} eq 'ARRAY') {
if ($to) {
push @{$to}, @{${$mail_info}{To}};
} else { $to=${$mail_info}{To} }
} else {
if ($to) {
push @{$to}, ${$mail_info}{To};
} else { $to=${$mail_info}{To} }
}
}
if (!$Net::FullAuto::FA_Core::username) {
$Net::FullAuto::FA_Core::username=getlogin || getpwuid($<)
}
if (ref $to eq 'ARRAY') {
my $going_to='';
foreach my $item (@{$to}) {
if ($item=~/(__|\])USERNAME(\[|__)/i) {
$going_to.="$email_addresses{
$Net::FullAuto::FA_Core::username}\,"
if exists $email_addresses{
$Net::FullAuto::FA_Core::username};
next;
} $going_to.="$item\,";
} $to=substr($going_to,0,-1);
} elsif ($to=~/(__|\])USERNAME(\[|__)/i) {
$to=$email_addresses{$Net::FullAuto::FA_Core::username}
if exists $email_addresses{$Net::FullAuto::FA_Core::username};
}
$ent->head->mime_attr(To=>$to);
$sendemail=1;
} elsif ($email_defaults &&
(exists $email_defaults{To})) {
$to=$email_defaults{To};
if (!$Net::FullAuto::FA_Core::username) {
$Net::FullAuto::FA_Core::username=getlogin || getpwuid($<)
}
if (ref $to eq 'ARRAY') {
my $going_to='';
foreach my $item (@{$to}) {
if ($item=~/(__|\])USERNAME(\[|__)/i) {
$going_to.="$email_addresses{
$Net::FullAuto::FA_Core::username}\,"
if exists $email_addresses{
$Net::FullAuto::FA_Core::username};
next;
} $going_to.="$item\,";
} $to=substr($going_to,0,-1);
} elsif ($to=~/(__|\])USERNAME(\[|__)/i) {
$to=$email_addresses{$Net::FullAuto::FA_Core::username}
if exists $email_addresses{$Net::FullAuto::FA_Core::username};
}
$ent->head->mime_attr(To=>$to);
$sendemail=1;
}
} elsif ($email_defaults) {
$usage=$email_defaults{Usage}
if (exists $email_defaults{Usage});
if ($usage ne 'notify_on_error'
&& (caller(1))[3] eq 'FA_Core::handle_error') {
return 0;
}
$mail_server=$email_defaults{Mail_Server}
if exists $email_defaults{Mail_Server};
$mail_port =$email_defaults{Mail_Port}
if exists $email_defaults{Mail_Port};
$mail_method=$email_defaults{Mail_Method}
if exists $email_defaults{Mail_Method};
if ($mail_method=~/smtp/i) {
if ($mail_server) {
if ($mail_port) {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server,
port => $mail_port
});
} else {
$transport=Email::Sender::Transport::SMTP->new({
host => $mail_server
});
}
}
}
$ent = MIME::Entity->build(Type => "multipart/mixed",
'X-Mailer' => undef);
if (exists $email_defaults{Bcc}) {
$ent->head->mime_attr(Bcc=>$email_defaults{Bcc});
$sendemail=1;
}
if (exists $email_defaults{Cc}) {
$ent->head->mime_attr(Cc=>$email_defaults{Cc});
$sendemail=1;
}
if (exists $email_defaults{From}) {
$ent->head->mime_attr(From=>$email_defaults{From});
}
if (exists $email_defaults{Subject}) {
$ent->head->mime_attr(Subject=>$email_defaults{Subject});
}
if (exists $email_defaults{To}) {
$ent->head->mime_attr(To=>$email_defaults{To});
$sendemail=1;
}
} else {
warn "EMAIL ERROR - no email information defined $!";
$done_warning=1;
}
if (!$sendemail && !$done_warning) {
warn "EMAIL ERROR - no recipients defined $!";
}
if ($sendemail) {
if (ref $mail_info eq 'HASH') {
if (exists ${$mail_info}{Body}) {
$body=${$mail_info}{Body};
} elsif ($email_defaults &&
(exists $email_defaults{Body})) {
$body=$email_defaults{Body};
} elsif (exists ${$mail_info}{Msg}) {
$body=${$mail_info}{Msg};
} elsif ($email_defaults &&
(exists $email_defaults{Msg})) {
$body=$email_defaults{Msg};
} elsif (exists ${$mail_info}{Message}) {
$body=${$mail_info}{Message};
} elsif ($email_defaults &&
(exists $email_defaults{Message})) {
$body=$email_defaults{Message};
}
} elsif ($email_defaults &&
(exists $email_defaults{Body})) {
$body=$email_defaults{Body};
} elsif ($email_defaults &&
(exists $email_defaults{Msg})) {
$body=$email_defaults{Msg};
}
$body=join '',@{$body} if ref $body eq 'ARRAY';
$ent->attach(Data => $body);
my $stdout_capture='';my $stderr_capture='';
while (1) {
my $eval_error='';
($stdout_capture,$stderr_capture)=Capture::Tiny::capture {
eval {
if ($transport) {
sendmail($ent,{transport=>$transport});
} else {
sendmail($ent);
}
};
$eval_error=$@;
};
if ($eval_error || $stdout_capture) {
if ($eval_error=~/^\s*$/ && $stdout_capture) {
$eval_error=$stdout_capture;
} elsif ($stdout_capture) {
$eval_error="$stdout_capture\n\n$eval_error";
}
print $Net::FullAuto::FA_Core::MRLOG $eval_error
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$eval_error,'';
} else {
die $eval_error;
}
} elsif (wantarray) {
return 'Mail sent OK.','','';
} elsif ((!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet) {
print "\nMail sent OK.\n";
last;
}
}
}
}
sub set_fa_modules
{
my $type=$_[0];
my $default_modules=$_[1];
my $track=$_[2];
my $defallt=$default_modules->{"fa_$type"};
my @items=();
if (-f $Hosts{"__Master_${$}__"}{'FA_Core'}.
"Custom/fa_$type.pm") {
push @items, "Custom/fa_$type.pm";
}
if (-f $Hosts{"__Master_${$}__"}{'FA_Core'}.
"Distro/fa_${type}_demo.pm") {
push @items, "Distro/fa_${type}_demo.pm";
}
if (-f $Hosts{"__Master_${$}__"}{'FA_Core'}.
"Distro/fa_$type.pm") {
push @items, "Distro/fa_$type.pm";
}
my %uc=(
code => 'Code',
conf => 'Conf',
host => 'Host',
maps => 'Maps',
menu => 'Menu',
);
if (-d $Hosts{"__Master_${$}__"}{'FA_Core'}.
"Custom/$username/$uc{$type}") {
my $path=$Hosts{"__Master_${$}__"}{'FA_Core'}.
"Custom/$username/$uc{$type}";
opendir(my $dh, $path) ||
&handle_error("can't opendir $path: $!");
my @useri=();
while (my $file=readdir($dh)) {
chomp($file);
push @useri, "Custom/$username/$uc{$type}/$file"
if $file!~/^[.]|README$/
}
close($dh);
unshift @items, @useri;
}
undef $Net::FullAuto::FA_Core::bdb_once;
$Net::FullAuto::FA_Core::dbenv_once->close();
undef $Net::FullAuto::FA_Core::dbenv_once;
my $def=$defallt;
substr($def,0,13)='';
my %show_default_type=(
Label => 'show_default_type',
Item_1 => {
Text => ']C[',
Convey => \@items,
Default => $def,
},
Banner => " Current FullAuto Default $uc{$type} for $username:\n\n".
" $def\n\n",
);
my $selection=Menu(\%show_default_type);
if ($selection ne $def && $selection ne ']quit[') {
$Net::FullAuto::FA_Core::dbenv_once = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Defaults',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',
$track);
$Net::FullAuto::FA_Core::bdb_once = BerkeleyDB::Btree->new(
-Filename => ${Net::FullAuto::FA_Core::progname}.
"_defaults.db",
-Flags => DB_CREATE,
-Env => $Net::FullAuto::FA_Core::dbenv_once
);
unless ($BerkeleyDB::Error=~/Successful/) {
$Net::FullAuto::FA_Core::bdb_once =
BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_defaults.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $Net::FullAuto::FA_Core::dbenv_once
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_defaults.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track) unless $BerkeleyDB::Error=~/Successful/;
$default_modules->{"fa_$type"}='Net/FullAuto/'.$selection;
my $defaultmodules=
Data::Dump::Streamer::Dump($default_modules)->Out();
my $status=$Net::FullAuto::FA_Core::bdb_once->db_put(
$username,$defaultmodules);
undef $Net::FullAuto::FA_Core::bdb_once;
$Net::FullAuto::FA_Core::dbenv_once->close();
undef $Net::FullAuto::FA_Core::dbenv_once;
}
&release_semaphore(9361);
&cleanup();
}
sub fa_login
{
if (defined $_[0] && $_[0]=~/^\d+$/) {
$timeout=$_[0];
} else {
my $time_out='$' . (caller)[0] . '::timeout';
$time_out= eval $time_out;
if ($@ || $time_out!~/^[1-9]+/) {
$timeout=30;
} else { $timeout=$time_out }
} $test=0;$prod=0;
###################################
# The following are being set if
# found defined in Term::Menus
my $log_='$' . (caller)[0] . '::log';
$log_= eval $log_;
$log_=0 if $@ || !$log_;
my $tosspass_='$' . (caller)[0] . '::tosspass';
$tosspass_= eval $tosspass_;
$tosspass_=0 if $@ || !$tosspass_;
## end Term::Menus defs ###########
my $fhtimeout='X';
my $fatimeout=$timeout;
my $tst='$' . (caller)[0] . '::test';
$tst=eval $tst;
$test=$tst if !$@ || $tst=~/^[1-9]+/;
my $_connect='connect_ssh_telnet';
if (exists $Hosts{"__Master_${$}__"}{'Local'}) {
my $loc=$Hosts{"__Master_${$}__"}{'Local'};
unless ($loc eq 'connect_ssh'
|| $loc eq 'connect_telnet'
|| $loc eq 'connect_ssh_telnet'
|| $loc eq 'connect_telnet_ssh') {
my $die="\n FATAL ERROR - \"Local\" has "
."*NOT* been Properly\n Defined in the "
."\"$Net::FullAuto::FA_Core::fa_host\" File."
."\n This "
."Element must have one of the following\n"
." Values:\n\n "
." 'connect_ssh'or 'connect_telnet'\n "
." 'connect_ssh_telnet' or\n "
." 'connect_telnet_ssh'\n\n"
." \'$loc\' is INCORRECT.\n\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} elsif ($loc eq 'connect_ssh') {
$_connect=$loc;
@RCM_Link=('ssh');
} elsif ($loc eq 'connect_telnet') {
$_connect=$loc;
@RCM_Link=('telnet');
} elsif ($loc eq 'connect_ssh_telnet') {
$_connect=$loc;
@RCM_Link=('ssh','telnet');
} else {
$_connect=$loc;
@RCM_Link=('telnet','ssh');
}
} else {
@RCM_Link=('ssh','telnet');
$Hosts{"__Master_${$}__"}{'Local'}=$_connect;
}
$email_defaults='%' . (caller)[0] . '::email_defaults';
%email_defaults=eval $email_defaults;
if ($@) {
$email_defaults=0;
%email_defaults=();
} else { $email_defaults=1 }
my $email_addresses='%' . (caller)[0] . '::email_addresses';
%email_addresses=eval $email_addresses;
%email_addresses=() if $@;
$custom_code_module_file='$' . (caller)[0] . '::fa_code';
$custom_code_module_file=eval $custom_code_module_file;
if ($@) {
my $die="Cannot Locate the \"FullAuto Custom Code\" "
."perl module (.pm) file\n < original "
."default name 'fa_code.pm' >\n\n $@";
&handle_error($die,'-3');
}
my $man=0;my $help=0;my $userflag=0;my $passerror=0;
my $test_arg=0;my $oldcipher='';my $password_from='user_input';
my @holdARGV=@ARGV;@menu_args=();my $username_from='';
my $cust_subnam_in_fa_code_module_file;my $sem='';
Getopt::Long::Configure ("bundling");
&GetOptions(
'authorize_connect' => \$authorize_connect,
'debug' => \$debug,
'scrub' => \$scrub,
'help|?' => \$help,
'h|?' => \$help,
'log:s' => \$log,
'l:s' => \$log,
man => \$man,
'password:s' => \$passwrd,
'quiet' => \$quiet,
'oldpassword=s' => \$oldpasswd,
'oldcipher=s' => \$oldcipher,
'updatepw' => \$updatepw,
'local-login-id=s' => \$usrname,
'login=s' => \$usrname,
'code=s' => \$cust_subnam_in_fa_code_module_file,
'subroutine' => \$cust_subnam_in_fa_code_module_file,
'subname' => \$cust_subnam_in_fa_code_module_file,
'sub' => \$cust_subnam_in_fa_code_module_file,
'sub-arg=s' => \@menu_args,
'sub_arg=s' => \@menu_args,
'arg=s' => \@menu_args,
'a=s' => \@menu_args,
'cron:s' => \$cron,
'unattended:s' => \$cron,
'batch:s' => \$cron,
'fullauto:s' => \$cron,
'defaults' => \$default,
'default' => \$default,
'fa_code:s' => \$facode,
'fa_conf:s' => \$faconf,
'fa_host:s' => \$fahost,
'fa_maps:s' => \$famaps,
'fa_menu:s' => \$famenu,
'm:s' => \$famenu,
'sets' => \$set,
'set:s' => \$set,
's:s' => \$set,
'random' => \$random,
'timeout=i' => \$cltimeout,
'prod' => \$prod,
'plan_ignore_error:s' => \$plan_ignore_error,
'plan:s' => \$plan,
'p:s' => \$plan,
'test' => \$test_arg,
'tosspass' => \$tosspass,
'daemon' => \$service,
'service' => \$service,
'edit:s' => \$edit,
'e:s' => \$edit,
'v' => \$version,
'version' => \$version,
'V' => \$VERSION,
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;
@ARGV=@holdARGV;undef @holdARGV;
$random='__random__' if $random;
if (defined $log) { $log=1 }
$log=$log_ if !$log;
$tosspass=$tosspass_ if !$tosspass;
if ($test_arg) {
$prod=0;$test=1;
} elsif ($prod) {
$test=0;
}
my $save_main_pass=0;my $track=0;
if (defined $passwrd) {
if ($passwrd) {
$passwd[0]=$passwrd;
$password_from='cmd_line_arg';
} else {
$save_main_pass=1;
} undef $passwrd;
}
if (defined $usrname) {
$username=$usrname;
$username_from='cmd_line_arg';
$userflag=1;
} else {
$username=getlogin || getpwuid($<);
}
if (-1<$#_ && $_[0] && $_[0]!~/^\d+$/) {
if ($#_ && $#_%2!=0) {
my $key='';my $margs=0;
foreach my $arg (@_) {
if (!$key) {
$key=$arg;next;
} else {
if ($key eq 'local-login-id') {
$username=$arg;
} elsif ($key eq 'login') {
$username=$arg;
} elsif ($key eq 'password') {
$password_from='fa_login_arg';
$arg=~/^(.*)$/;
$passwd[0]=$1;
} elsif ($key eq 'sub_arg' ||
$key eq 'sub-arg') {
@menu_args=() if !$margs;
$margs=1;
push @menu_args, $arg;
} elsif ($key ne 'test' || $prod==0) {
${$key}=$arg;
} $key='';
}
}
} else {
&handle_error("Wrong Number of Arguments to &fa_login");
}
} elsif (!$prod && defined $_[1] &&
(!defined $_[0] || !$_[0] || $_[0]=~/^\d+$/)) {
$test=$_[1];
}
#$passwd[1]=$passwd[0];
#if (exists $Hosts{"__Master_${$}__"}{'Cipher'} &&
# $Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
# && 7<length $passwd[0]) {
#$passwd[1]=unpack('a8',$passwd[0])
#}
if (defined $cron) {
if ($cron) {
$plan=$cron;
}
$batch=']Batch[';
$unattended=']Unattended[';
$fullauto=']FullAuto[';
$cron=']Cron[';
}
print "\n Starting $progname . . .\n"
if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
sleep 2 if $Net::FullAuto::FA_Core::debug;
my $su_scrub='';my $login_Mast_error='';my $id='';my $use='';
my $hostlabel='';my $mainuser='';my $retrys='';
my $su_err='';my $su_id='';my $stdout='';my $stderr='';
my $hostname='';my $fullhostname='';my $passline='';
my $host=''; my $cmd_type='';my $cmd_pid='';my $login_id;
my $password='';
if (exists $Hosts{"__Master_${$}__"}{'HostName'} &&
-1<index $Hosts{"__Master_${$}__"}{'HostName'},'.') {
$hostname=substr($Hosts{"__Master_${$}__"}{'HostName'},0
,(index $Hosts{"__Master_${$}__"}{'HostName'},'.'))||'';
$fullhostname=$Hosts{"__Master_${$}__"}{'HostName'};
} else {
$fullhostname=$hostname=$Hosts{"__Master_${$}__"}{'HostName'}||'';
}
my $ip=inet_ntoa((gethostbyname($hostname))[4])||'';
my $suroot='';
foreach my $host (keys %same_host_as_Master) {
next if $host eq "__Master_${$}__";
if (exists $Hosts{$host}{'LoginID'} &&
($Hosts{$host}{'LoginID'} eq $username)) {
$su_id='' if !$mainuser;
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};
$mainuser=1;
if (exists $Hosts{$host}{'SU_ID'}) {
$su_id=$Hosts{$host}{'SU_ID'};
$hostlabel=$host;
$suroot=(getgrnam('suroot'))[3];
last if $su_id eq 'root';
} next
} elsif (!$mainuser && exists $Hosts{$host}{'SU_ID'}) {
$su_id=$Hosts{$host}{'SU_ID'};
$suroot=(getgrnam('suroot'))[3];
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};
$hostlabel=$host;
} else {
$fhtimeout=$Hosts{$host}{'Timeout'}
if exists $Hosts{$host}{'Timeout'};
} $hostlabel=$host if !$hostlabel;
} $hostlabel="__Master_${$}__" if !$hostlabel;
$master_hostlabel=$hostlabel;$hostlabel="__Master_${$}__";
$Hosts{$hostlabel}{'Uname'}=$^O;
if ($cltimeout ne 'X') {
$fatimeout=$fhtimeout=$cltimeout;
} elsif ($fhtimeout ne 'X') {
$fatimeout=$fhtimeout;
} $retrys=0;
foreach my $key (keys %same_host_as_Master) {
if (exists $Hosts{$key}{'FA_Secure'}) {
$Hosts{$key}{'FA_Secure'}.='/' if
substr($Hosts{$key}{'FA_Secure'},-1) ne '/';
$Hosts{"__Master_${$}__"}{'FA_Secure'}=
$Hosts{$key}{'FA_Secure'};
last
}
} my $FA_Core_path='';
foreach my $key (keys %INC) {
if (-1<index $key,'FA_Core.pm') {
$FA_Core_path=substr($INC{$key},0,(rindex $INC{$key},'/')+1);
last;
}
} $Hosts{"__Master_${$}__"}{'FA_Core'}=$FA_Core_path;
if (!exists $Hosts{"__Master_${$}__"}{'FA_Secure'}) {
unless (-d '/var/db/Berkeley/FullAuto') {
File::Path::make_path('/var/db/Berkeley/FullAuto');
}
if (!(-d '/var/db/Berkeley/FullAuto' && -w _)) {
&handle_error("Cannot Write to Encrypted Passwd Directory :".
"\n\n ".
'/var/db/Berkeley/FullAuto');
}
$Hosts{"__Master_${$}__"}{'FA_Secure'}=
'/var/db/Berkeley/FullAuto/';
} elsif (!(-d $Hosts{"__Master_${$}__"}{'FA_Secure'} && -w _)) {
handle_error("Cannot Write to Encrypted Passwd Directory :".
"\n\n ".
$Hosts{"__Master_${$}__"}{'FA_Secure'});
} else {
$Hosts{"__Master_${$}__"}{'FA_Secure'}.='/' if
substr($Hosts{"__Master_${$}__"}{'FA_Secure'},-1) ne '/';
}
if ($updatepw) {
my $uid=$username;
while (1) {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "$blanklines\n";
}
if ($login_Mast_error) {
print "ERROR MESSAGE-> $login_Mast_error\n";
}
if ($test && !$prod) {
print "\n Running in TEST mode\n";
} else { print "\n Running in PRODUCTION mode\n" }
my $usrname_timeout=350;
my $usrname='';
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($usrname_timeout);
&acquire_semaphore(1234,
"Username Input Prompt at Line: ".__LINE__,1);
my $ikey='';
print "\n";
($usrname,$ikey)=rawInput(" $hostname Login <$uid> : ");
&release_semaphore(1234);
alarm(0);
};
if ($@ eq "alarm\n") {
print "\n\n";
&handle_error(
"Time Allowed for Username Input has Expired.",
'__cleanup__');
}
chomp $usrname;
$usrname=~s/^\s*//s;
$usrname=~s/\s*$//s;
next if $usrname=~/^\d/ || !$usrname && !$uid;
$username= ($usrname) ? $usrname : $uid;
$username_from='user_input';
$userflag=1;
last;
}
while (1) {
print "\n Enter Old Password: ";
ReadMode 2;
&release_semaphore(1234);
my $pas=<STDIN>;
$pas=~/^(.*)$/;
$passwd[0]=$1;
$sem=acquire_semaphore(1234,,1);
ReadMode 0;
chomp($passwd[0]);
print "\n\n";
$passwd[1]=$passwd[0];
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
&& 7<length $passwd[0]) {
$passwd[1]=unpack('a8',$passwd[0])
}
print " Please Enter Old Password Again: ";
ReadMode 2;
&release_semaphore(1234);
$pas=<STDIN>;
$pas=~/^(.*)$/;
$passwd[3]=$1;
$sem=acquire_semaphore(1234,,1);
ReadMode 0;
chomp($passwd[3]);
print "\n\n";
$passwd[4]=$passwd[3];
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
&& 7<length $passwd[3]) {
$passwd[4]=unpack('a8',$passwd[3])
}
if ($passwd[1] eq $passwd[4]) {
last;
} else {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "$blanklines\n";
} print "\n Passwords did not match!\n";
}
}
while (1) {
print "\n Enter New Password: ";
ReadMode 2;
&release_semaphore(1234);
$passwd[5]=<STDIN>;
$sem=acquire_semaphore(1234,,1);
ReadMode 0;
chomp($passwd[5]);
print "\n\n";
$passwd[6]=$passwd[5];
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
&& 7<length $passwd[5]) {
$passwd[6]=unpack('a8',$passwd[5])
}
print " Please Enter New Password Again: ";
ReadMode 2;
&release_semaphore(1234);
$passwd[7]=<STDIN>;
$sem=acquire_semaphore(1234,,1);
ReadMode 0;
chomp($passwd[7]);
print "\n\n";
$passwd[8]=$passwd[7];
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/
&& 7<length $passwd[7]) {
$passwd[8]=unpack('a8',$passwd[7])
}
if ($passwd[6] eq $passwd[8]) {
last;
} else {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "$blanklines\n";
} print "\n Passwords did not match!\n";
}
}
my $cipher_algorithm=($oldcipher)?$oldcipher:
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'};
my $cipher = new Crypt::CBC($passwd[8],
$cipher_algorithm);
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test
&& !$Net::FullAuto::FA_Core::prod;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB:".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
# print the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
my $href=eval $v;
foreach my $key (keys %{eval $v}) {
if ($key=~/\d+$/) {
while (delete $href->{$key}) {}
next
}
my $href_2='';
my $status=$bdb->db_get($k,$href_2);
my $encrypted_passwd=$href_2->{$key};
my $pass=$cipher->decrypt($encrypted_passwd);
if ($pass && $pass!~tr/\0-\37\177-\377//) {
print "Updated $key\n";
while (delete $href->{$key}) {}
my $cipher = new Crypt::CBC($passwd[8],
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
my $new_encrypted=$cipher->encrypt($pass);
$href->{$key}=$new_encrypted;
} else { print "Skipping $key\n" }
} my $put_href=Data::Dump::Streamer::Dump($href)->Out();
my $status=$bdb->db_put($k,$put_href);
}
undef $cursor ;
undef $bdb ;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
&cleanup();
}
&acquire_semaphore(9876,
"FullAuto Process Limit at Line: ".__LINE__,2);
my $loop_count=0;
while (1) {
$loop_count++;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
if (!$MRLOG) {
if (exists $Hosts{"__Master_${$}__"}{'LogFile'}
&& $Hosts{"__Master_${$}__"}{'LogFile'}) {
if (substr($Hosts{"__Master_${$}__"}{'LogFile'},0,1) eq '~') {
$Hosts{"__Master_${$}__"}{'LogFile'}=~s/^[~]/$home_dir/;
}
$MRLOG=*MRLOG;
my $die="Cannot Open LOGFILE - \"" .
$Hosts{"__Master_${$}__"}{'LogFile'} . "\"";
open ($MRLOG, ">$Hosts{\"__Master_${$}__\"}{'LogFile'}")
|| &handle_error($die);
print "\n LOGFILE ==> \"",
$Hosts{"__Master_${$}__"}{'LogFile'},"\"\n"
unless $quiet;
$MRLOG->autoflush(1);
print $MRLOG "\n\n#### NEW PROCESS - ",
scalar localtime(time)," #####\n\n";
} elsif ($log) {
$MRLOG=*MRLOG;
my $olog="$home_dir/FAlog${$}d".
$Net::FullAuto::FA_Core::invoked[2].
$Net::FullAuto::FA_Core::invoked[3].".txt";
$Hosts{"__Master_${$}__"}{'LogFile'}=$olog;
open ($MRLOG, ">$olog") || &handle_error($!);
$MRLOG->autoflush(1);
print "\n LOGFILE ==> \"$olog\"\n"
unless $quiet;
print $MRLOG "\n\n#### NEW PROCESS - ",
scalar localtime(time)," #####\n\n";
}
}
if (defined $default || (defined $facode && !$facode)
|| (defined $faconf && !$faconf)
|| (defined $fahost && !$fahost)
|| (defined $famaps && !$famaps)
|| (defined $famenu && !$famenu)
|| (defined $set && !$set)) {
if ($Net::FullAuto::cpu) {
my $idle=(split ',', $Net::FullAuto::cpu)[3];
$idle=~s/^\s*//;
$idle=~s/%.*$//;
my $cpyou=100-$idle;
if ($idle<20) {
my $die="FATAL ERROR - CPU Usage is too high\n"
." to run FullAuto safely.\n"
." CPU are Starttime ==> ${cpyou}%\n";
&handle_error($die);
}
}
unless (-f $Hosts{"__Master_${$}__"}{'FA_Core'}.'fa_defs.pm') {
my $fd=$Hosts{"__Master_${$}__"}{'FA_Core'}.'fa_defs.pm';
open (FD,">$fd") or &handle_error("Cannot open $fd: $!\n");
print FD "package fa_defs;\n\n",
"### OPEN SOURCE LICENSE - GNU PUBLIC LICENSE Version 3.0 #######\n",
"#\n",
"# Net::FullAuto - Powerful Network Process Automation Software\n",
"# Copyright (C) 2011 Brian M. Kelly\n",
"#\n",
"# This program is free software: you can redistribute it and/or modify\n",
"# it under the terms of the GNU General Public License as published by\n",
"# the Free Software Foundation, either version 3 of the License, or\n",
"# any later version.\n",
"#\n",
"# This program is distributed in the hope that it will be useful,\n",
"# but **WITHOUT ANY WARRANTY**; without even the implied warranty of\n",
"# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n",
"# GNU General Public License for more details.\n",
"#\n",
"# You should have received a copy of the GNU General Public License\n",
"# along with this program. If not, see <http://www.gnu.org/licenses/>.\n",
"#\n",
"################################################################\n\n",
"use strict;\n",
"use warnings;\n\n",
"#################################################################\n",
"## Do NOT alter code ABOVE this block.\n",
"#################################################################\n",
"## -------------------------------------------------------------\n",
"## ADD SETTINGS HERE:\n",
"## -------------------------------------------------------------\n\n",
"our \$FA_Secure = \"",$Hosts{"__Master_${$}__"}{'FA_Secure'},"\";\n\n",
"#################################################################\n",
"## Do NOT alter code BELOW this block.\n",
"#################################################################\n",
"1;";
close(FD);
}
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Defaults') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Defaults');
}
$Net::FullAuto::FA_Core::dbenv_once = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Defaults',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',
$track);
$Net::FullAuto::FA_Core::bdb_once = BerkeleyDB::Btree->new(
-Filename => ${Net::FullAuto::FA_Core::progname}.
"_defaults.db",
-Flags => DB_CREATE,
-Env => $Net::FullAuto::FA_Core::dbenv_once
);
unless ($BerkeleyDB::Error=~/Successful/) {
$Net::FullAuto::FA_Core::bdb_once =
BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_defaults.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $Net::FullAuto::FA_Core::dbenv_once
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_defaults.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track) unless $BerkeleyDB::Error=~/Successful/;
my $default_modules='';
my $status=$Net::FullAuto::FA_Core::bdb_once->db_get(
$username,$default_modules);
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';
$default_modules=eval $default_modules;
$default_modules||='';
undef $Net::FullAuto::FA_Core::bdb_once;
$Net::FullAuto::FA_Core::dbenv_once->close();
undef $Net::FullAuto::FA_Core::dbenv_once;
if ((-1<index $status,
'DB_NOTFOUND: No matching key/data pair found')
|| !($default_modules)
|| !exists $default_modules->{fa_code}
|| !exists $default_modules->{fa_conf}
|| !exists $default_modules->{fa_host}
|| !exists $default_modules->{fa_maps}
|| !exists $default_modules->{fa_menu}) {
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets') {
File::Path::make_path(
$Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets');
}
$Net::FullAuto::FA_Core::dbenv_once = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Sets',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',
$track);
$Net::FullAuto::FA_Core::bdb_once = BerkeleyDB::Btree->new(
-Filename => ${Net::FullAuto::FA_Core::progname}.
"_sets.db",
-Flags => DB_CREATE,
-Env => $Net::FullAuto::FA_Core::dbenv_once
);
unless ($BerkeleyDB::Error=~/Successful/) {
$Net::FullAuto::FA_Core::bdb_once =
BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_sets.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $Net::FullAuto::FA_Core::dbenv_once
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_sets.db".
" $BerkeleyDB::Error\n";
}
}
my $sref={
fa_demo => {
Label => 'fa_demo',
Description => 'FullAuto Demo Module Set',
fa_code => 'Net/FullAuto/Distro/fa_code_demo.pm',
fa_conf => 'Net/FullAuto/Distro/fa_conf.pm',
fa_host => 'Net/FullAuto/Distro/fa_host.pm',
fa_maps => 'Net/FullAuto/Distro/fa_maps.pm',
fa_menu => 'Net/FullAuto/Distro/fa_menu_demo.pm',
},
};
my $put_sref=
Data::Dump::Streamer::Dump($sref)->Out();
$status=$Net::FullAuto::FA_Core::bdb_once->db_put(
$username,$put_sref);
$default_modules={
set => 'none',
fa_code => 'Net/FullAuto/Distro/fa_code_demo.pm',
fa_conf => 'Net/FullAuto/Distro/fa_conf.pm',
fa_host => 'Net/FullAuto/Distro/fa_host.pm',
fa_maps => 'Net/FullAuto/Distro/fa_maps.pm',
fa_menu => 'Net/FullAuto/Distro/fa_menu_demo.pm',
};
undef $Net::FullAuto::FA_Core::bdb_once;
$Net::FullAuto::FA_Core::dbenv_once->close();
undef $Net::FullAuto::FA_Core::dbenv_once;
}
my $set_default_sub=sub {
package set_default_sub;
my $default_set=shift;
no strict "subs";
use BerkeleyDB;
use File::Path;
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);
my $progname=substr($0,(rindex $0,'/')+1,-3);
require "$loc/fa_defs.pm";
unless (-d $fa_defs::FA_Secure.'Sets') {
File::Path::make_path($fa_defs::FA_Secure.'Sets');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.'Sets',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_sets.db $BerkeleyDB::Error\n";
}
}
my $mysets='';
my $status=$bdb->db_get($username,$mysets);
$mysets=~s/\$HASH\d*\s*=\s*//s;
$mysets=eval $mysets;
undef $bdb;
$dbenv->close();
undef $dbenv;
my $desc='';
my @sets=();
foreach my $key (keys %{$mysets}) {
push @sets,"SET Label: $key\n ".
"Description: ".$mysets->{$key}{'Description'};
}
return [ sort @sets ];
};
my $get_modules=sub {
use File::Path;
use File::Copy;
my $type=$_[0]||'';
unless ($type) {
$type=']P[';
my $ind=rindex $type,'fa_';
$type=substr($type,$ind+3,$ind+7);
}
my $username=getlogin || getpwuid($<);
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);
unless (-d "$fadir/Custom/$username/$type") {
File::Path::make_path(
"$fadir/Custom/$username/$type");
copy("$fadir/Custom/fa_".lc($type).".pm",
"$fadir/Custom/$username/$type")
|| do{ die "copy failed: $!" };
}
opendir(DIR,"$fadir/Custom/$username/$type");
my @xfiles = readdir(DIR);
my @return=();
closedir(DIR);
foreach my $entry (@xfiles) {
next if $entry eq '.';
next if $entry eq '..';
next if -d $entry;
push @return, $entry;
}
return @return;
};
my $custmm=<<FIN;
__ __ __ __ _ _
| \\/ |___ _ _ _ _ | \\/ |___ __| |_ _| |___
| |\\/| / -_) ' \\ || | | |\\/| / _ \\/ _` | || | / -_)
|_| |_\\___|_||_\\_,_| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
my $custpm=<<FIN;
__ __ __ __ _ _
| \\/ |__ _ _ __ ___ | \\/ |___ __| |_ _| |___
| |\\/| / _` | '_ (_-< | |\\/| / _ \\/ _` | || | / -_)
|_| |_\\__,_| .__/__/ |_| |_\\___/\\__,_|\\_,_|_\\___|
|_|
FIN
my $custhm=<<FIN;
_ _ _ __ __ _ _
| || |___ __| |_ | \\/ |___ __| |_ _| |___
| __ / _ (_-< _| | |\\/| / _ \\/ _` | || | / -_)
|_||_\\___/__/\\__| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
my $custfm=<<FIN;
___ __ __ __ _ _
/ __|___ _ _ / _| | \\/ |___ __| |_ _| |___
| (__/ _ \\ ' \\| _| | |\\/| / _ \\/ _` | || | / -_)
\\___\\___/_||_|_| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
my $custcm=<<FIN;
___ _ __ __ _ _
/ __|___ __| |___ | \\/ |___ __| |_ _| |___
| (__/ _ \\/ _` / -_) | |\\/| / _ \\/ _` | || | / -_)
\\___\\___/\\__,_\\___| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
my $fabann=sub {
my $type=$_[0]||'';
unless ($type) {
$type=']P[';
my $ind=rindex $type,'fa_';
$type=substr($type,$ind+3,$ind+7);
}
my $caps='';
if ($type eq 'code') {
$caps=$custcm;
} elsif ($type eq 'conf') {
$caps=$custfm;
} elsif ($type eq 'host') {
$caps=$custhm;
} elsif ($type eq 'maps') {
$caps=$custpm;
} else {
$caps=$custmm;
}
my $set='';
if ($default_modules->{'set'} ne 'none') {
$set=" WARNING!: Set \'$default_modules->{'set'}\'".
" is currently the Default Set;\n ".
"it will be changed to \'none\' if you proceed.\n".
" Run \'fa --set\' to work with ".
"FullAuto Sets.\n\n";
}
return " CURRENT MODULE DEFAULTS when Default Set".
" is \'none\':\n\n Code => ".
$default_modules->{'fa_code'}."\n".
" Conf => ".
$default_modules->{'fa_conf'}."\n".
" Host => ".
$default_modules->{'fa_host'}."\n".
" Maps => ".
$default_modules->{'fa_maps'}."\n".
" Menu => ".
$default_modules->{'fa_menu'}."\n\n".
"$caps$set Please select the fa_".$type."[.*].pm ".
"module that will become the new\n ".
ucfirst($type)." Module Default (run \'fa --import\'".
" to add more choices):";
};
my $fasetdef=sub {
package fasetdef;
use BerkeleyDB;
use File::Path;
no strict "subs";
my $username=getlogin || getpwuid($<);
my $loc=substr($INC{'Net/FullAuto.pm'},
0,-3);
my $progname=substr($0,(rindex $0,'/')
+1,-3);
require "$loc/fa_defs.pm";
unless (-d
$fa_defs::FA_Secure.'Defaults') {
File::Path::make_path(
$fa_defs::FA_Secure.'Defaults');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.
'Defaults',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');
my $bdb = BerkeleyDB::Btree->new(
-Filename => $progname.
"_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
my $default_modules='';
my $status=$bdb->db_get(
$username,$default_modules);
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';
$default_modules=eval $default_modules;
$default_modules||={};
$default_modules->{'set'}='none';
if (-1<index ']S[','code') {
$default_modules->{'fa_code'}=
"Net/FullAuto/Custom/$username/".
"Code/]S[";
unless (exists $default_modules->{'fa_conf'}) {
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_maps.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
}
} elsif (-1<index ']S[','conf') {
$default_modules->{'fa_conf'}=
"Net/FullAuto/Custom/$username/".
"Conf/]S[";
unless (exists $default_modules->{'fa_host'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
$default_modules->{'fa_maps'}=
'Net/FullAuto/Distro/fa_maps.pm';
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
}
} elsif (-1<index ']S[','host') {
$default_modules->{'fa_host'}=
"Net/FullAuto/Custom/$username/".
"Host/]S[";
unless (exists $default_modules->{'fa_maps'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_maps'}=
'Net/FullAuto/Distro/fa_maps.pm';
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
}
} elsif (-1<index ']S[','maps') {
$default_modules->{'fa_maps'}=
"Net/FullAuto/Custom/$username/".
"Maps/]S[";
unless (exists $default_modules->{'fa_menu'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
$default_modules->{'fa_menu'}=
'Net/FullAuto/Distro/fa_menu_demo.pm';
}
} else {
$default_modules->{'fa_menu'}=
"Net/FullAuto/Custom/$username/".
"Menu/]S[";
unless (exists $default_modules->{'fa_menu'}) {
$default_modules->{'fa_code'}=
'Net/FullAuto/Distro/fa_code_demo.pm';
$default_modules->{'fa_conf'}=
'Net/FullAuto/Distro/fa_conf.pm';
$default_modules->{'fa_host'}=
'Net/FullAuto/Distro/fa_host.pm';
$default_modules->{'fa_maps'}=
'Net/FullAuto/Distro/fa_maps.pm';
}
}
my $put_dref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();
$status=$bdb->db_put(
$username,$put_dref);
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n New Default Modules ".
"now:\n\n Code => ".
$default_modules->{'fa_code'}.
"\n Conf => ".
$default_modules->{'fa_conf'}.
"\n Host => ".
$default_modules->{'fa_host'}.
"\n Maps => ".
$default_modules->{'fa_maps'}.
"\n Menu => ".
$default_modules->{'fa_menu'}.
"\n Set => \'none\'".
"\n\n";
return "Finished Default Module";
};
if (defined $facode) {
my %define_module_fa_menu=(
Label => 'define_module_fa_menu',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Code'),
Result => $fasetdef,
},
Banner => $fabann->('Code'),
);
my $selection=Menu(\%define_module_fa_menu);
&release_semaphore(9361);
&cleanup();
} elsif (defined $faconf) {
my %define_module_fa_conf=(
Label => 'define_module_fa_conf',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Conf'),
Result => $fasetdef,
},
Banner => $fabann->('Conf'),
);
my $selection=Menu(\%define_module_fa_conf);
&release_semaphore(9361);
&cleanup();
} elsif (defined $fahost) {
my %define_module_fa_host=(
Label => 'define_module_fa_host',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Host'),
Result => $fasetdef,
},
Banner => $fabann->('Host'),
);
my $selection=Menu(\%define_module_fa_host);
&release_semaphore(9361);
&cleanup();
} elsif (defined $famaps) {
my %define_module_fa_maps=(
Label => 'define_module_fa_maps',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Maps'),
Result => $fasetdef,
},
Banner => $fabann->('Maps'),
);
my $selection=Menu(\%define_module_fa_maps);
&release_semaphore(9361);
&cleanup();
} elsif (defined $famenu) {
my %define_module_fa_menu=(
Label => 'define_module_fa_menu',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Menu'),
Result => $fasetdef,
},
Banner => $fabann->('Menu'),
);
my $selection=Menu(\%define_module_fa_menu);
&release_semaphore(9361);
&cleanup();
} elsif (defined $set) {
$default_modules->{'set'}||='none';
my $current_default_set=$default_modules->{'set'};
my $dm_banner=" Please Select a Module Set Operation:\n\n";
if ($current_default_set eq 'none') {
$dm_banner.=" ** NO DEFAULT SET DEFINED **\n";
} else {
$dm_banner.=
" ** DEFAULT SET -> $current_default_set **\n";
}
my %define_modules_commit=(
Label => 'define_modules_commit',
Item_1 => {
Text => "YES",
Result => sub {
package set_default_sub;
no strict "subs";
use BerkeleyDB;
use File::Path;
use Data::Dump::Streamer;
my $loc=substr($INC{'Net/FullAuto.pm'},0,-3);
my $progname=substr($0,(rindex $0,'/')+1,-3);
require "$loc/fa_defs.pm";
unless (-d $fa_defs::FA_Secure.'Sets') {
File::Path::make_path($fa_defs::FA_Secure.'Sets');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.'Sets',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_sets.db $BerkeleyDB::Error\n";
}
}
my $mysets='';
my $status=$bdb->db_get($username,$mysets);
$mysets=~s/\$HASH\d*\s*=\s*//s;
$mysets=eval $mysets;
my $ph="Net/FullAuto/Custom/$username/";
$mysets->{$main::setname}={
Label => $main::setname,
Description => $main::desc,
fa_code =>
$ph."Code/]P[{define_modules_menu_fa_code}",
fa_conf =>
$ph."Conf/]P[{define_modules_menu_fa_conf}",
fa_host =>
$ph."Host/]P[{define_modules_menu_fa_host}",
fa_maps =>
$ph."Maps/]P[{define_modules_menu_fa_maps}",
fa_menu =>
$ph."Menu/]P[{define_modules_menu_fa_menu}"
};
my $put_mref=
Data::Dump::Streamer::Dump($mysets)->Out();
$status=$bdb->db_put($username,$put_mref);
undef $bdb;
$dbenv->close();
undef $dbenv;
return "Finished Defining Set";
},
},
Item_2 => {
Text => "No ( FullAuto [fa --set] will EXIT )",
},
Banner => sub {
my $custns=<<FIN;
_ _ ___ _
| \\| |_____ __ __ / __| ___| |_
| .` / -_) V V / \\__ \\/ -_) _| o
|_|\\_\\___|\\_/\\_/ |___/\\___|\\__| o
FIN
my $spc=length $main::setname;
$spc=pack("A$spc",'');
return "$custns \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n".
" $spc Conf => ".
"]P[{define_modules_menu_fa_conf}\n".
" $spc Host => ".
"]P[{define_modules_menu_fa_host}\n".
" $spc Maps => ".
"]P[{define_modules_menu_fa_maps}\n".
" $spc Menu => ".
"]P[{define_modules_menu_fa_menu}\n".
" ${spc}Description => $main::desc\n\n\n".
" Would you like to COMMIT the New Set ".
"( $main::setname )?:";
},
);
my %define_modules_menu_fa_menu=(
Label => 'define_modules_menu_fa_menu',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Menu'),
Result => \%define_modules_commit,
},
Banner => sub {
my $spc=length $main::setname;
$spc=pack("A$spc",'');
return " New Set: \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n".
" $spc Conf => ".
"]P[{define_modules_menu_fa_conf}\n".
" $spc Host => ".
"]P[{define_modules_menu_fa_host}\n".
" $spc Maps => ".
"]P[{define_modules_menu_fa_maps}\n\n".
"$custmm Please select a fa_menu[.*].pm ".
"module:";
},
);
my %define_modules_menu_fa_maps=(
Label => 'define_modules_menu_fa_maps',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Maps'),
Result => \%define_modules_menu_fa_menu,
},
Banner => sub {
my $spc=length $main::setname;
$spc=pack("A$spc",'');
return " New Set: \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n".
" $spc Conf => ".
"]P[{define_modules_menu_fa_conf}\n".
" $spc Host => ".
"]P[{define_modules_menu_fa_host}\n\n".
"$custpm Please select a fa_maps[.*].pm ".
"module:";
},
);
my %define_modules_menu_fa_host=(
Label => 'define_modules_menu_fa_host',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Host'),
Result => \%define_modules_menu_fa_maps,
},
Banner => sub {
my $spc=length $main::setname;
$spc=pack("A$spc",'');
return " New Set: \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n".
" $spc Conf => ".
"]P[{define_modules_menu_fa_conf}\n\n".
"$custhm Please select a fa_host[.*].pm ".
"module:";
},
);
my %define_modules_menu_fa_conf=(
Label => 'define_modules_menu_fa_conf',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Conf'),
Result => \%define_modules_menu_fa_host,
},
Banner => sub {
return " New Set: \'$main::setname\' --> Code => ".
"]P[{define_modules_menu_fa_code}\n\n".
"$custfm Please select a fa_conf[.*].pm ".
"module:";
},
);
my %define_modules_menu_fa_code=(
Label => 'define_modules_menu_fa_code',
Item_1 => {
Text => ']C[',
Convey => sub {
use File::Path;
use File::Copy;
while (1) {
print "\n\n\n Please type the name\n".
" for the new Set: ";
$main::setname=<STDIN>;
chomp($main::setname);
my $sets=$set_default_sub->();
my %sets=();
foreach my $set (@{$sets}) {
$set=~s/^.*Label:\s+(.*?)\s+.*$/$1/s;
$sets{$set}='';
}
if (exists $sets{$main::setname}) {
my $bann=" The set name you typed: ".
"$main::setname\n already ".
"is in use. Would\n you ".
"like to replace it?";
my $ans=Term::Menus::pick(['yes','no'],$bann);
if ($ans eq 'no') {
next;
} else { last }
} elsif ($main::setname=~/^\s*$/) {
next;
} else { last }
}
print "\n\n\n Please type the Description\n".
" for the new Set: ";
$main::desc=<STDIN>;
chomp($main::desc);
my $username=getlogin || getpwuid($<);
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);
unless (-d "$fadir/Custom/$username/Code") {
File::Path::make_path(
"$fadir/Custom/$username/Code");
copy("$fadir/Custom/fa_code.pm",
"$fadir/Custom/$username/Code")
|| do{ die "copy failed: $!" };
}
opendir(DIR,"$fadir/Custom/$username/Code");
my @xfiles = readdir(DIR);
my @return=();
closedir(DIR);
foreach my $entry (@xfiles) {
next if $entry eq '.';
next if $entry eq '..';
next if -d $entry;
push @return, $entry;
}
return @return;
},
Result => \%define_modules_menu_fa_conf,
},
Banner => sub {
my $custcm=<<FIN;
___ _ __ __ _ _
/ __|___ __| |___ | \\/ |___ __| |_ _| |___
| (__/ _ \\/ _` / -_) | |\\/| / _ \\/ _` | || | / -_)
\\___\\___/\\__,_\\___| |_| |_\\___/\\__,_|\\_,_|_\\___|
FIN
return " New Set: \'$main::setname\'\n\n".
"$custcm Please select a fa_code[.*].pm ".
"module:".
"\n\n (Hint: Use the 'Manage Module Sets'".
" feature to import and export modules".
"\n owned by other users, or that are".
" components of third party distributions.)\n";
},
);
my $mm_banner=" Please Select a Module Set Operation:\n\n";
if ($current_default_set eq 'none') {
$mm_banner.=" ** NO DEFAULT SET DEFINED **\n";
} else {
$mm_banner.=
" ** DEFAULT SET -> $current_default_set **\n";
}
my %delete_sets_menu=(
Label => 'delete_sets_menu',
Item_1 => {
Text => "]C[",
Convey => sub {
my $arr=$set_default_sub->();
my @ret=();
foreach my $ar (@{$arr}) {
push @ret,"$ar\n\n";
}
return @ret;
},
Result => sub {
package del_sets;
use BerkeleyDB;
use File::Path;
no strict "subs";
my $res='';
if ("]S[") {
$res="]S[";
if (substr($res,0,1) eq '[') {
$res=eval $res;
}
}
my $username=getlogin || getpwuid($<);
my $loc=substr($INC{'Net/FullAuto.pm'},
0,-3);
my $progname=substr($0,(rindex $0,'/')
+1,-3);
require "$loc/fa_defs.pm";
unless (-d
$fa_defs::FA_Secure.'Defaults') {
File::Path::make_path(
$fa_defs::FA_Secure.'Defaults');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.
'Defaults',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');
my $bdb = BerkeleyDB::Btree->new(
-Filename => $progname.
"_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless (
$BerkeleyDB::Error=~/Successful/
) {
$bdb = BerkeleyDB::Btree->new(
-Filename => $progname.
"_defaults.db",
-Flags =>
DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless (
$BerkeleyDB::Error=~/
Successful/) {
die "Cannot Open DB: ".
"${progname}_defaults.db ".
$BerkeleyDB::Error."\n";
}
}
my $default_modules='';
my $status=$bdb->db_get(
$username,$default_modules);
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,
'$HASH';
$default_modules=eval $default_modules;
$default_modules||='';
unless (-d
$fa_defs::FA_Secure.'Sets') {
File::Path::make_path(
$fa_defs::FA_Secure.'Sets');
}
my $sdbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.'Sets',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');
my $sbdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $sdbenv
);
unless (
$BerkeleyDB::Error=~/Successful/
) {
$sbdb = BerkeleyDB::Btree->new(
-Filename => $progname."_sets.db",
-Flags =>
DB_CREATE|DB_RECOVER_FATAL,
-Env => $sdbenv
);
unless (
$BerkeleyDB::Error=~/
Successful/) {
die "Cannot Open DB: ".
"${progname}_sets.db ".
$BerkeleyDB::Error."\n";
}
}
my $mysets='';
$status=$sbdb->db_get(
$username,$mysets);
$mysets=~s/\$HASH\d*\s*=\s*//s;
$mysets=eval $mysets;
foreach my $set (@{$res}) {
$set=~
s/^.*Label:\s+(.*?)\s+.*$/$1/s;
if ($default_modules->{'set'}
eq $set) {
my $ban=
"\n\n WARNING!: You are ".
"about to delete the default".
" set\n\n -> \'$set\'; ".
" Do you still wish to ".
"proceed?\n\n (The ".
"Default Set will be set to".
" \'none\' if \'yes\')";
my $ans=Term::Menus::pick(
['yes','no'],$ban);
if ($ans eq 'no') {
next;
} else {
$default_modules->{'set'}=
'none';
}
}
delete $mysets->{$set};
}
my $put_dref=
Data::Dump::Streamer::Dump(
$mysets)->Out();
$status=
$sbdb->db_put($username,$put_dref);
my $put_fref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();
$status=
$bdb->db_put($username,$put_fref);
undef $bdb;
$dbenv->close();
undef $dbenv;
undef $sbdb;
$sdbenv->close();
undef $sdbenv;
return 'Finished Deleting Set';
},
},
Select => 'Many',
Banner => sub {
my $custds=<<FIN;
___ _ _ ___ _
| \\ ___| |___| |_ ___ / __| ___| |_ ___
| |) / -_) / -_) _/ -_) \\__ \\/ -_) _(_-<
|___/\\___|_\\___|\\__\\___| |___/\\___|\\__/__/
FIN
return "$custds ".
"Please Select one or more Sets to Delete:"
},
);
my %manage_modules_menu=(
Label => 'manage_modules_menu',
Item_1 => {
Text => 'Examine Module Set(s)',
},
Item_2 => {
Text => 'Modify Module Set',
},
Item_3 => {
Text => 'Delete Module Set(s)',
Result => \%delete_sets_menu,
},
Item_4 => {
Text => 'Export Module Set/Components',
},
Item_5 => {
Text => 'Import Module Set/Components',
},
Banner => $mm_banner
);
my $sdf_banner=" Please Select a Default Module Set:\n\n";
my $clearoption='';
if ($current_default_set eq 'none') {
$sdf_banner.=" ** NO DEFAULT SET DEFINED **\n";
$clearoption="Keep as 'none'\n\n";
} else {
$sdf_banner.=
" ** DEFAULT SET -> $current_default_set **\n";
$clearoption="Set to 'none'\n\n";
}
my %set_default_menu=(
Label => 'set_default_menu',
Item_1 => {
Text => $clearoption,
},
Item_2 => {
Text => "]C[\n ".
"Username: $username\n\n",
Default => "SET Label: $current_default_set",
Convey => $set_default_sub->($current_default_set),
},
Banner => $sdf_banner
);
my $sm_banner=" Please Select a Module Set Operation:\n\n";
if ($current_default_set eq 'none') {
$sm_banner.=" ** NO DEFAULT SET DEFINED **\n";
$clearoption="Keep as 'none'\n\n";
} else {
$sm_banner.=
" ** DEFAULT SET -> $current_default_set **\n";
$clearoption="Set to 'none'\n\n";
}
my %set_menu=(
Label => 'set_menu',
Item_1 => {
Text => 'Select Default Module Set',
Result => \%set_default_menu,
},
Item_2 => {
Text =>
"Keep Default Module Set: $current_default_set",
},
Item_3 => {
Text => 'Clear Default Module Set',
},
Item_4 => {
Text => 'Define New Module Set',
Result => \%define_modules_menu_fa_code,
},
Item_5 => {
Text => 'Manage Module Sets',
Result => \%manage_modules_menu,
},
Banner => $sm_banner
);
my $selection=Menu(\%set_menu);
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Set') ||
($selection eq 'Finished Deleting Set')) {
&release_semaphore(9361);
&cleanup();
}
unless (((-1<index $selection,'none') ||
(-1<index $selection,'Clear') ||
(-1<index $selection,'Keep'))) {
$selection=~s/^.*Label:\s+(.*?)\s+.*$/$1/s;
$default_modules->{'set'}=$selection;
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.'Defaults',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_defaults.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_defaults.db $BerkeleyDB::Error\n";
}
}
my $put_dref=
Data::Dump::Streamer::Dump($default_modules)->Out();
$status=$bdb->db_put($username,$put_dref);
undef $bdb;
$dbenv->close();
undef $dbenv;
} elsif ((-1<index $selection,'Set to \'none') ||
(-1<index $selection,'Clear')) {
$selection='none';
$default_modules->{'set'}='none';
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.'Defaults',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error."\n",'','');
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_defaults.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${progname}_defaults.db $BerkeleyDB::Error\n";
}
} else { $selection='none' }
my $put_dref=
Data::Dump::Streamer::Dump($default_modules)->Out();
$status=$bdb->db_put($username,$put_dref);
undef $bdb;
$dbenv->close();
undef $dbenv;
} elsif (-1<index $selection,'Keep') {
$selection=$current_default_set;
} else { $selection='none' }
print "\n\n Default Module Set is now -> \'$selection\'.\n";
&release_semaphore(9361);
&cleanup();
}
if (defined $famenu) {
set_fa_modules('menu',$default_modules);
} elsif (defined $facode) {
set_fa_modules('code',$default_modules);
} elsif (defined $fahost) {
set_fa_modules('host',$default_modules);
} elsif (defined $faconf) {
set_fa_modules('conf',$default_modules);
} elsif (defined $famaps) {
set_fa_modules('maps',$default_modules);
} elsif (defined $default) {
my $dfbann=<<FIN;
___ _ _ _ _ ___ __ _ _
| __| _| | | /_\\ _ _| |_ ___ | \\ ___ / _|__ _ _ _| | |_ ___
| _| || | | |/ _ \\ || | _/ _ \\ | |) / -_) _/ _` | || | | _(_-<
|_| \\_,_|_|_/_/ \\_\\_,_|\\__\\___/ |___/\\___|_| \\__,_|\\_,_|_|\\__/__/
FIN
my $banner=$dfbann;
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
$banner.=" ** NO DEFAULT SET DEFINED **\n\n";
}
my $ca_sub=sub {
use File::Path;
use File::Copy;
my $type=$_[0];
my $username=getlogin || getpwuid($<);
my $fadir=substr($INC{'Net/FullAuto.pm'},0,-3);
unless (-d "$fadir/Custom/$username/$type") {
File::Path::make_path(
"$fadir/Custom/$username/$type");
copy("$fadir/Custom/fa_".lc($type).".pm",
"$fadir/Custom/$username/$type")
|| do{ die "copy failed: $!" };
}
opendir(DIR,"$fadir/Custom/$username/$type");
my @xfiles = readdir(DIR);
my @return=();
closedir(DIR);
foreach my $entry (@xfiles) {
next if $entry eq '.';
next if $entry eq '..';
next if -d $entry;
push @return, $entry;
}
return @return;
};
my %cacomm=(
Label => 'cacomm',
Item_1 => {
Text => "YES",
Result => sub {
package del_sets;
use BerkeleyDB;
use File::Path;
no strict "subs";
my $username=getlogin || getpwuid($<);
my $loc=substr($INC{'Net/FullAuto.pm'},
0,-3);
my $progname=substr($0,(rindex $0,'/')
+1,-3);
require "$loc/fa_defs.pm";
unless (-d
$fa_defs::FA_Secure.'Defaults') {
File::Path::make_path(
$fa_defs::FA_Secure.'Defaults');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.
'Defaults',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');
my $bdb = BerkeleyDB::Btree->new(
-Filename => $progname.
"_defaults.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
my $default_modules='';
my $status=$bdb->db_get(
$username,$default_modules);
$default_modules||='';
$default_modules=~s/\$HASH\d*\s*=\s*//s
if -1<index $default_modules,'$HASH';
$default_modules=eval $default_modules;
$default_modules||={};
$default_modules->{'set'}='none';
$default_modules->{'fa_code'}=
"Net/FullAuto/Custom/$username/".
"Code/]P[{cacode}";
$default_modules->{'fa_conf'}=
"Net/FullAuto/Custom/$username/".
"Conf/]P[{caconf}";
$default_modules->{'fa_host'}=
"Net/FullAuto/Custom/$username/".
"Host/]P[{cahost}";
$default_modules->{'fa_maps'}=
"Net/FullAuto/Custom/$username/".
"Maps/]P[{camaps}";
$default_modules->{'fa_menu'}=
"Net/FullAuto/Custom/$username/".
"Menu/]P[{camenu}";
my $put_dref=
Data::Dump::Streamer::Dump(
$default_modules)->Out();
$status=$bdb->db_put(
$username,$put_dref);
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n New Default Modules ".
"now:\n\n Code => ".
"Net/FullAuto/Custom/$username/".
"]P[{cacode}\n Conf => ".
"Net/FullAuto/Custom/$username/".
"]P[{caconf}\n Host => ".
"Net/FullAuto/Custom/$username/".
"]P[{cahost}\n Maps => ".
"Net/FullAuto/Custom/$username/".
"]P[{camaps}\n Menu => ".
"Net/FullAuto/Custom/$username/".
"]P[{camenu}\n Set => ".
"\'none\'\n\n";
return "Finished Defining Defaults";
},
},
Item_2 => {
Text => "No ( FullAuto [fa --defaults] will EXIT )",
},
Banner => sub {
my $custnd=<<FIN;
_ _ ___ __ _ _
| \\| |_____ __ __ | \\ ___ / _|__ _ _ _| | |_ ___
| .` / -_) V V / | |) / -_) _/ _` | || | | _(_-< o
|_|\\_\\___|\\_/\\_/ |___/\\___|_| \\__,_|\\_,_|_|\\__/__/ o
FIN
my $username=getlogin || getpwuid($<);
return "$custnd Code => ".
"Net/FullAuto/Custom/$username/".
"]P[{cacode}\n".
" Conf => Net/FullAuto/Custom/$username/".
"]P[{caconf}\n".
" Host => Net/FullAuto/Custom/$username/".
"]P[{cahost}\n".
" Maps => Net/FullAuto/Custom/$username/".
"]P[{camaps}\n".
" Menu => Net/FullAuto/Custom/$username/".
"]P[{camenu}\n Set => none\n\n ".
"Would you like to COMMIT the New Defaults?:";
},
);
my %camenu=(
Label => 'camenu',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Menu'),
Result => \%cacomm,
},
Banner => sub {
my $username=getlogin || getpwuid($<);
return " Code => Net/FullAuto/Custom/$username/".
"]P[{cacode}\n".
" Conf => Net/FullAuto/Custom/$username/".
"]P[{caconf}\n".
" Host => Net/FullAuto/Custom/$username/".
"]P[{cahost}\n".
" Maps => Net/FullAuto/Custom/$username/".
"]P[{camaps}\n\n".
"$custmm Please select a fa_menu[.*].pm ".
"module:";
},
);
my %camaps=(
Label => 'camaps',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Maps'),
Result => \%camenu,
},
Banner => sub {
my $username=getlogin || getpwuid($<);
return " Code => Net/FullAuto/Custom/$username/".
"]P[{cacode}\n".
" Conf => Net/FullAuto/Custom/$username/".
"]P[{caconf}\n".
" Host => Net/FullAuto/Custom/$username/".
"]P[{cahost}\n\n".
"$custpm Please select a fa_maps[.*].pm ".
"module:";
},
);
my %cahost=(
Label => 'cahost',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Host'),
Result => \%camaps,
},
Banner => sub {
my $username=getlogin || getpwuid($<);
return " Code => Net/FullAuto/Custom/$username/".
"]P[{cacode}\n".
" Conf => Net/FullAuto/Custom/$username/".
"]P[{caconf}\n\n".
"$custhm Please select a fa_host[.*].pm ".
"module:";
},
);
my %caconf=(
Label => 'caconf',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Conf'),
Result => \%cahost,
},
Banner => sub {
my $username=getlogin || getpwuid($<);
return " Code => Net/FullAuto/Custom/$username/".
"]P[{cacode}\n\n".
"$custfm Please select a fa_conf[.*].pm ".
"module:";
},
);
my %cacode=(
Label => 'cacode',
Item_1 => {
Text => ']C[',
Convey => $get_modules->('Code'),
Result => \%caconf,
},
Banner => "$custcm Please select a fa_code[.*].pm ".
"module:",
);
my %define_module_from_viewdef=(
Label => 'define_module_from_viewdef',
Item_1 => {
Text => ']C[',
Convey => $get_modules,
Result => $fasetdef,
},
Banner => $fabann,
);
my $vdbanner=$banner." Code => "
.$default_modules->{'fa_code'}
."\n Conf => "
.$default_modules->{'fa_conf'}
."\n Host => "
.$default_modules->{'fa_host'}
."\n Maps => "
.$default_modules->{'fa_maps'}
."\n Menu => "
.$default_modules->{'fa_menu'}
."\n";
my %viewdefaults=(
Label => 'viewdefaults',
Item_1 => {
Text => "Change ALL Defaults",
Result => \%cacode,
},
Item_2 => {
Text => "Change Default ]C[",
Convey => ['fa_code','fa_conf','fa_host',
'fa_maps','fa_menu'],
Result => \%define_module_from_viewdef,
},
Banner => $vdbanner,
);
if (!exists $default_modules->{'set'} ||
$default_modules->{'set'} eq 'none') {
my $selection=Menu(\%viewdefaults);
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults') ||
($selection eq 'Finished Default Module')) {
&release_semaphore(9361);
&cleanup();
}
#print "SELECTION=$selection\n";sleep 5;
} else {
my $sdbenv = BerkeleyDB::Env->new(
-Home => $fa_defs::FA_Secure.'Sets',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or die(
"cannot open environment for DB: ".
$BerkeleyDB::Error,"\n",'','');
my $sbdb = BerkeleyDB::Btree->new(
-Filename => "${progname}_sets.db",
-Flags => DB_CREATE,
-Env => $sdbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$sbdb = BerkeleyDB::Btree->new(
-Filename => $progname."_sets.db",
-Flags =>
DB_CREATE|DB_RECOVER_FATAL,
-Env => $sdbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ${progname}_sets.db ".
$BerkeleyDB::Error."\n";
}
}
my $mysets='';
my $status=$sbdb->db_get($username,$mysets);
$mysets=~s/\$HASH\d*\s*=\s*//s;
$mysets=eval $mysets;
undef $sbdb;
$sdbenv->close();
undef $sdbenv;
my $set=$default_modules->{'set'};
my $spc=length $set;
$spc=pack("A$spc",'');
$banner.=" ** DEFAULT SET -> $set **\n\n"
." \'$set\' --> Code => "
.$mysets->{$set}->{'fa_code'}."\n"
." $spc Conf => "
.$mysets->{$set}->{'fa_conf'}."\n"
." $spc Host => "
.$mysets->{$set}->{'fa_host'}."\n"
." $spc Maps => "
.$mysets->{$set}->{'fa_maps'}."\n"
." $spc Menu => "
.$mysets->{$set}->{'fa_menu'}."\n"
." ${spc}Description => "
.$mysets->{$set}->{'Description'}."\n\n"
." NOTE: Any action in this Menu"
." will change the Default Set to 'none'.\n"
." To work with FullAuto Sets, "
."run \'fa --set\' instead.\n";
my %defaultsettings=(
Label => 'defaultsettings',
Item_1 => {
Text =>
"View Defaults when Default Set equals \'none\'",
Result => \%viewdefaults,
},
Item_2 => {
Text => "Change ALL Defaults",
Result => \%cacode,
},
Item_3 => {
Text => "Change Default ]C[",
Convey => ['fa_code','fa_conf','fa_host',
'fa_maps','fa_menu'],
},
Banner => $banner,
);
my $selection=Menu(\%defaultsettings);
if (($selection eq ']quit[') ||
(-1<index $selection,'will EXIT') ||
($selection eq 'Finished Defining Defaults')) {
&release_semaphore(9361);
&cleanup();
}
}
}
}
if ($plan || $plan_ignore_error) {
if ($Net::FullAuto::cpu) {
my $idle=(split ',', $Net::FullAuto::cpu)[3];
$idle=~s/^\s*//;
$idle=~s/%.*$//;
my $cpyou=100-$idle;
if ($idle<20) {
my $die="FATAL ERROR - CPU Usage is too high\n"
." to run FullAuto safely.\n"
." CPU are Starttime ==> ${cpyou}%\n";
&handle_error($die);
}
}
$plan||=$plan_ignore_error;
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',
$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => ${Net::FullAuto::FA_Core::progname}.
"_plans.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_plans.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_plans.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track) unless $BerkeleyDB::Error=~/Successful/;
my $pref='';
my $status=$bdb->db_get($plan,$pref);
$pref=~s/\$HASH\d*\s*=\s*//s;
my $pla_n=eval $pref;
unless (ref $pla_n eq 'HASH' and exists $pla_n->{Plan}) {
my $die="\n FATAL ERROR! - Plan $plan is *NOT* a"
."\n Valid FullAuto Plan. Please indicate\,"
."\n a Valid Plan, or Create one using the"
."\n --plan argument without a number.\n"
."\n $status\n";
print $MRLOG $die
if $log && -1<index $MRLOG,'*';
&handle_error($die,'__cleanup__');
}
undef $bdb;
$dbenv->close();
undef $dbenv;
}
if ($localhost && -1<index $login_Mast_error,'invalid log'
&& -1<index $login_Mast_error,'ogin incor'
&& -1<index $login_Mast_error,'sion den') {
if ($cmd_type eq 'telnet' &&
defined fileno $localhost->{_cmd_handle}) {
$localhost->{_cmd_handle}->print("\003");
$localhost->{_cmd_handle}->print('exit');
while (defined fileno $localhost->{_cmd_handle}) {
while (my $line=$localhost->{_cmd_handle}->get) {
print $MRLOG "FA_LOGINTRYINGTOKILL=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$line=~s/\s//g;
my $allout.=$line;
last if $allout=~/logout|closed/s;
} $localhost->{_cmd_handle}->close;
}
} elsif ($cmd_type eq 'ssh') {
$localhost->{_cmd_handle}->print("\003");
$localhost->{_cmd_handle}->print("\003");
$localhost->{_cmd_handle}->close;
} else { $localhost->{_cmd_handle}->close }
}
if ($login_Mast_error) {
if ($login_Mast_error=~/[Ll]ogin|sion den|Passwo/) {
$userflag=0;@passwd=();#$username='';
chomp($login_Mast_error);
} else {
chomp($login_Mast_error);
#print "ERROR MESSAGE-> $login_Mast_error\n";<STDIN>;
}
}
if (!$userflag && !$cron || !$username) {
my $uid=$username;
if (!$Net::FullAuto::FA_Core::cron) {
while (1) {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "$blanklines\n";
}
if ($login_Mast_error) {
print "ERROR MESSAGE-> $login_Mast_error\n";
}
if ($test && !$prod) {
print "\n Running in TEST mode\n";
} else { print "\n Running in PRODUCTION mode\n" }
my $usrname_timeout=350;
my $usrname='';
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($usrname_timeout);
&acquire_semaphore(1234,
"Username Input Prompt at Line: ".__LINE__,1);
my $ikey='';
print "\n";
($usrname,$ikey)=rawInput(" $hostname Login <$uid> : ");
&release_semaphore(1234);
alarm(0);
};
if ($@ eq "alarm\n") {
print "\n\n";
&handle_error(
"Time Allowed for Username Input has Expired.",
'__cleanup__');
}
chomp $usrname;
$usrname=~s/^\s*//s;
$usrname=~s/\s*$//s;
next if $usrname=~/^\d/ || !$usrname && !$uid;
$username= ($usrname) ? $usrname : $uid;
$username_from='user_input';
$userflag=1;
last;
}
} else {
&handle_error($login_Mast_error);
}
}
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",
'',$track);
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
my $href={};
if ($save_main_pass || $password_from ne 'user_input' ||
($login_Mast_error &&
-1<index $login_Mast_error,'Not a GLOB reference')) {
my $status=$bdb->db_get('localhost',$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
#delete ${$href}{"gatekeep_$username"};
if (exists $href->{"gatekeep_$username"}) {
my $zyxarray=$href->{"passetts_$username"};
$zyxarray=~s/\$ARRAY\d*\s*=\s*//s;
$passetts=eval $zyxarray;
undef $zyxarray;
my $ignore_expiration=$passetts->[1]||0;
my $now=time;
#print "WHAT IS IGNORED EXP=$ignore_expiration and PASSWORD FROM=$password_from\n";
if ($now<$ignore_expiration) {
$passetts->[9]=$dcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
my $tpess=$dcipher->decrypt($passetts->[0]);
my $skipflag=0;
if ($password_from ne 'user_input') {
if ($passwd[0] ne $tpess) {
undef $tpess;
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[9]=$dcipher=$ecipher;
$skipflag=1;
undef $passwd[0];
} else {
print "\n Saved Password matches outside input!\n";
}
}
unless ($skipflag) {
undef $tpess;
print "\n Saved Password will Expire: ".
scalar localtime($ignore_expiration)."\n"
if !$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet;
$tpess=$ecipher->encrypt(
$dcipher->decrypt($passetts->[0]));
my $arr=[$tpess,$ignore_expiration];
undef $tpess;
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump($arr)->Out();
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put('localhost',$put_href);
}
$save_main_pass=0;
} elsif ($password_from ne 'user_input') {
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[9]=$dcipher=$ecipher;
$save_main_pass=1;
undef $passwd[0];
} else {
print "\n NOTICE!: Saved Password --EXPIRED-- on ".
scalar localtime($ignore_expiration)."\n";
my $passwd_timeout=350;
my $pas='';
my $te_time=time;
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);
&acquire_semaphore(9854,
"Password Input Prompt at Line: ".__LINE__,1);
print "\n PasswordX2: ";
ReadMode 2;
$pas=<STDIN>;
&release_semaphore(9854);
alarm(0);
};
if ($@ eq "alarm\n") {
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n";
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');
}
my $te_time2=time;
if (10<$loop_count
|| (($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n";
&handle_error(
"\n FATAL ERROR: Password Input Prompt appeared".
"\n in what appears to be an unattended".
"\n process/job - no password was entered".
"\n and one is ALWAYS required with".
"\n FullAuto. The Prompt does not appear".
"\n to have paused at all - which is".
"\n proper and expected when FullAuto".
"\n is invoked from cron, but no password".
"\n was previously saved".
"\n Remedy: Run FullAuto manually with the".
"\n --password option (with no actual".
"\n password following the option) and".
"\n choose an appropriate expiration time".
"\n with the resulting menus.",
'__cleanup__');
}
$pas=~/^(.*)$/;
$passwd[0]=$1;
chomp($passwd[0]);
print "\n\n";
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[9]=$dcipher=$ecipher;
$save_main_pass=1;
undef $passwd[0];
}
} elsif ($passwd[0]) {
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[9]=$dcipher=$ecipher;
undef $passwd[0];
#print "WHAT IS GATEKEEP=",$href->{"gatekeep_$username"},"\n";
} else {
#print "LOGIN_MAST_ERROR2=$login_Mast_error and BDB=$bdb<==\n";
my $passwd_timeout=350;
my $pas='';
my $te_time=time;
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);
&acquire_semaphore(9854,
"Password Input Prompt at Line: ".__LINE__,1);
print "\n\n Password: ";
ReadMode 2;
$pas=<STDIN>;
&release_semaphore(9854);
alarm(0);
};
my $te_time2=time;
if ($@ eq "alarm\n") {
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n";
&handle_error(
"Time Allowed for Password Input has Expired.",
'__cleanup__');
}
if (10<$loop_count ||
(($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n";
&handle_error(
"\n FATAL ERROR: Password Input Prompt appeared".
"\n in what appears to be an unattended".
"\n process/job - no password was entered".
"\n and one is ALWAYS required with".
"\n FullAuto. The Prompt does not appear".
"\n to have paused at all - which is".
"\n proper and expected when FullAuto".
"\n is invoked from cron, but no password".
"\n was previously saved".
"\n Remedy: Run FullAuto manually with the".
"\n --password option (with no actual".
"\n password following the option) and".
"\n choose an appropriate expiration time".
"\n with the resulting menus.",
'__cleanup__');
}
$pas||='';
$pas=~/^(.*)$/;
$passwd[0]=$1;
chomp($passwd[0]);
print "\n\n";
my $rstr=new String::Random;
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
#print "WHAT IS GATEKEEP2=",$href->{"gatekeep_$username"},"\n";
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[9]=$dcipher=$ecipher;
undef $passwd[0];
}
} elsif ((!$Net::FullAuto::FA_Core::dcipher ||
!$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]))
&& !$Net::FullAuto::FA_Core::cron) {
my $passwd_timeout=350;
my $pas='';
my $te_time=time;
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # \n required
alarm($passwd_timeout);
&acquire_semaphore(9854,
"Password Input Prompt at Line: ".__LINE__,1);
print "\n\n Password: ";
ReadMode 2;
$pas=<STDIN>;
&release_semaphore(9854);
alarm(0);
};
my $te_time2=time;
if ($@ eq "alarm\n") {
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n\n";
&handle_error(
"Input Time Limit for Password Prompt:\n\n".
" Password: Expired");
}
if (10<$loop_count ||
(($te_time==$te_time2 || $te_time==$te_time2-1) &&
!$pas)) {
undef $bdb;
$dbenv->close();
undef $dbenv;
print "\n<---";
&handle_error(
"\n FATAL ERROR: Password Input Prompt appeared".
"\n in what appears to be an unattended".
"\n process/job - no password was entered".
"\n and one is ALWAYS required with".
"\n FullAuto. The Prompt does not appear".
"\n to have paused at all - which is".
"\n proper and expected when FullAuto".
"\n is invoked from cron, but no password".
"\n was previously saved".
"\n Remedy: Run FullAuto manually with the".
"\n --password option (with no actual".
"\n password following the option) and".
"\n choose an appropriate expiration time".
"\n with the resulting menus.",
'__cleanup__');
}
#print "LOGIN_MAST_ERROR=$login_Mast_error<== AND NO BDB\n";
$pas=~/^(.*)$/;
$passwd[0]=$1;
chomp($passwd[0]);
my $status=$bdb->db_get('localhost',$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $pselection='';
my $ignore_expiration=0;
if (exists $href->{"gatekeep_$username"}) {
my $zyxarray=$href->{"passetts_$username"};
$zyxarray=~s/\$ARRAY\d*\s*=\s*//s;
$passetts=eval $zyxarray;
undef $zyxarray;
$ignore_expiration=$passetts->[1]||0;
my $now=time;
my $tdcipher='';
#print "WHAT IS IGNORED EXP=$ignore_expiration and PASSWORD FROM=$password_from\n";
if ($now<$ignore_expiration) {
$tdcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
if ($passwd[0] eq $tdcipher->decrypt($passetts->[0])) {
my %askaboutpass=(
Label => 'askaboutpass',
Item_1 => {
Text => 'Keep the Saved Password',
},
Item_2 => {
Text => 'Discard the Saved Password',
},
Banner => " FullAuto has detected a Saved Password\n".
" from previous invocations that has NOT\n".
" yet expired. Please select how FullAuto\n".
" should proceed . . .\n\n".
" To avoid this screen when using a Saved\n".
" Password (Saved Passwords are NEVER\n".
" recommended and are ALWAYS an increased\n".
" security risk - but are allowed for\n".
" unattended mode and for making interactive\n".
" use easier and more efficient - like\n".
" during custom code development.)\n".
" always be sure to start FullAuto with the\n".
" --password argument (with *NO* password\n".
" actually entered with the argument.\n".
" FullAuto *DOES NOT* support command line\n".
" argument passing of passwords. It is\n".
" a VERY insecure and highly discouraged\n".
" practice!)."
);
$pselection=&Menu(\%askaboutpass);
cleanup() if $pselection eq ']quit[';
}
}
}
my $rstr=new String::Random;
if (exists $Hosts{"__Master_${$}__"}{'Cipher'}
&& $Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[9]=$dcipher=$ecipher;
undef $passwd[0];
if ($pselection ne 'Keep the Saved Password') {
delete $href->{"gatekeep_$username"};
} else {
print "\n Saved Password will Expire: ".
scalar localtime($ignore_expiration)."\n"
if !$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet;
my $tpess=$ecipher->encrypt(
$dcipher->decrypt($passetts->[0]));
my $arr=[$tpess,$ignore_expiration];
undef $tpess;
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump($arr)->Out();
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put('localhost',$put_href);
print "\n\n";
} else {
my $rstr=new String::Random;
if (exists $Hosts{"__Master_${$}__"}{'Cipher'}
&& $Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
$href->{"gatekeep_$username"}=
$rstr->randpattern("........");
} else {
$href->{"gatekeep_$username"}=
$rstr->randpattern("..............");
}
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[9]=$dcipher=$ecipher;
undef $passwd[0];
}
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
$login_id=$username;
$passwd[2]='';
$passetts->[2]='';
$host='localhost';
my $lc_cnt=-1;
$localhost={};my $local_host='';
$localhost=bless $localhost, 'Rem_Command';
bless $localhost, substr($custom_code_module_file,0,-3);
&acquire_semaphore(6543,
"Local Host Login at Line: ".__LINE__,1);
foreach my $connect_method (@RCM_Link) {
$lc_cnt++;
if (lc($connect_method) eq 'telnet') {
$cmd_type='telnet';
my $telnetpath='';
if (exists $Hosts{"__Master_${$}__"}{'telnet'}) {
$telnetpath=$Hosts{"__Master_${$}__"}{'telnet'};
$telnetpath.='/' if $telnetpath!~/\/$/;
}
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
["${telnetpath}telnet",'localhost'])
or (&release_semaphore(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch telnet subprocess"));
#print "CMD_PID=$cmd_pid<======\n";
$localhost->{_cmd_pid}=$cmd_pid;
$localhost->{_cmd_type}=$cmd_type;
$localhost->{_connect}=$_connect;
$localhost->{_uname}=$^O;
$localhost->{_hostlabel}=[ "__Master_${$}__",'' ];
$local_host=Net::Telnet->new(Fhopen => $localhost,
Timeout => $fatimeout);
$local_host->telnetmode(0);
$local_host->binmode(1);
$local_host->output_record_separator("\r");
$localhost->{_cmd_handle}->close()
if exists $localhost->{_cmd_handle};
delete $localhost->{_cmd_handle}
if exists $localhost->{_cmd_handle};
$localhost->{_cmd_handle}=$local_host;
while (my $line=$local_host->get) {
chomp($line=~tr/\0-\37\177-\377//d);
#print "OUTPUT FROM NEW::TELNET=$line<==\n";
#print $Net::FullAuto::FA_Core::MRLOG "OUTPUT FROM NEW::TELNET=$line<==\n";
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (7<length $line && unpack('a8',$line) eq 'Insecure') {
$line=~s/^Insecure/INSECURE/s;
if (wantarray) {
&release_semaphore(6543);
return '',$line;
} else { &release_semaphore(6543);die $line }
}
last if $line=~
/(?<!Last )login[: ]*$|username[: ]*$/i;
}
$local_host->print($login_id);
if ($local_host->errmsg) {
&release_semaphore(6543);
&handle_error($local_host->errmsg,'-1')
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
$localhost,$timeout);
if ($stderr) {
if ($lc_cnt==$#RCM_Link) {
&release_semaphore(6543);
die $stderr;
} else { next }
} last
} elsif (lc($connect_method) eq 'ssh') {
$cmd_type='ssh';
my $sshpath=$Net::FullAuto::FA_Core::sshpath;
if (exists $Hosts{"__Master_${$}__"}{'ssh'}) {
$sshpath=$Hosts{"__Master_${$}__"}{'ssh'};
$sshpath.='/' if $sshpath!~/\/$/;
}
my $sshport='';
if (exists $Hosts{"__Master_${$}__"}{'sshport'}) {
$sshport=$Hosts{"__Master_${$}__"}{'sshport'};
}
my $try_count=0;
while (1) {
if ($sshport) {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
#["${sshpath}ssh","-caes128-ctr","-p$sshport",
["${sshpath}ssh","-p$sshport",
"$login_id\@localhost",'',
$Net::FullAuto::FA_Core::slave])
or (&release_semaphore(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
} else {
($local_host,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
#["${sshpath}ssh","-caes128-ctr","$login_id\@localhost",
["${sshpath}ssh","$login_id\@localhost",
'',$Net::FullAuto::FA_Core::slave])
or (&release_semaphore(6543) &&
&Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess"));
}
$localhost->{_cmd_pid}=$cmd_pid;
print $Net::FullAuto::FA_Core::MRLOG
"SSH_Pid=$cmd_pid at Line ", __LINE__,"<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$localhost->{_cmd_type}=$cmd_type;
$localhost->{_connect}=$_connect;
$localhost->{_uname}=$^O;
$localhost->{_hostlabel}=[ "__Master_${$}__",'' ];
$local_host=Net::Telnet->new(Fhopen => $local_host,
Timeout => $fatimeout);
$local_host->telnetmode(0);
$local_host->binmode(1);
$local_host->output_record_separator("\r");
$localhost->{_cmd_handle}->close()
if exists $localhost->{_cmd_handle};
$localhost->{_cmd_handle}=$local_host;
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$local_host,
_hostlabel=>[ "__Master_${$}__",'' ],
_cmd_type=>'ssh',
_connect=>$_connect },$timeout);
if ($stderr) {
if ($lc_cnt==$#RCM_Link) {
&release_semaphore(6543);
die $stderr;
} elsif (-1<index $stderr,'read timed-out:do_slave') {
my $kill_arg=($^O eq 'cygwin')?'f':9;
($stdout,$stderr)=&kill($cmd_pid,$kill_arg)
if &testpid($cmd_pid);
$Net::FullAuto::FA_Core::slave='_slave_';next
} elsif (3<$try_count++) {
&release_semaphore(6543);
&Net::FullAuto::FA_Core::handle_error($stderr)
} else { sleep 1;next }
} last
} last
}
}
## Send password.
print $Net::FullAuto::FA_Core::MRLOG "PRINTING PASSWORD NOW<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$local_host->print($dcipher->decrypt($passetts->[0]));
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
if ($^O ne 'cygwin') {
print $blanklines;
} else {
print "\n\n" unless $login_Mast_error;
}
# Logging (1)
print "--> Logging into $host via $cmd_type",
" . . .\n\n" unless $login_Mast_error;
} elsif ($Net::FullAuto::FA_Core::debug) {
print "LOGIN MASTER HOST ERROR: ",
"$login_Mast_error\n" if $login_Mast_error;
print "--> Logging (1) into $host via $cmd_type",
" . . .\n\n";
}
my $newpw='';$passline=__LINE__+1;
while (my $line=$local_host->get) {
print "WAITING FOR CMDPROMPT=$line<== at Line ",__LINE__,"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"WAITING FOR CMDPROMPT=$line<== at Line: ",__LINE__,"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $output='';
($output=$line)=~s/login:.*//s;
if ($^O eq 'cygwin') {
my $pass_test=$dcipher->decrypt($passetts->[0]);
if ($line=~/^$pass_test\n/) {
undef $pass_test;
$local_host->print("\032");
$local_host->close;
$passerror=1;&release_semaphore(6543);
return;
} else {
undef $pass_test;
}
}
if ($line=~/Permission denied|Password:/s) {
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
);
unless ($BerkeleyDB::Error=~/Successful/) {
&release_semaphore(6543);
&handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track);
}
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".${Net::FullAuto::FA_Core::progname}.
"_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
unless ($BerkeleyDB::Error=~/Successful/) {
&release_semaphore(6543);
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track);
}
my $href={};
my $status=$bdb->db_get('localhost',$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
if (exists $href->{"gatekeep_$username"}) {
my $tdcipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
if ($dcipher->decrypt($passetts->[0]) eq
$tdcipher->decrypt($passetts->[0])) {
delete $href->{"gatekeep_$username"};
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put('localhost',$put_href);
}
}
undef $bdb;
$dbenv->close();
undef $dbenv;
## ADD - TELL USER ABOUT MISSING CRON CREDS ON CMD LINE
&release_semaphore(9361);
&release_semaphore(6543);
die $line;
#die "Permission denied";
}
if ($line=~/Connection reset by peer|node or service name/s) {
&release_semaphore(6543);
die $line;
}
if ($line=~/(?<!Last )login[: ]*$/m ||
(-1<index $line,' sync_with_child: ')) {
&release_semaphore(6543);
&handle_error($output,'__cleanup__');
}
if ($line=~/new password: ?$/is) {
$newpw=$line;
print $Net::FullAuto::FA_Core::MRLOG "GOING LAST ONE<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last;
}
if ($^O eq 'cygwin') {
if ($line=~/[:\$%>#-] ?$/m &&
unpack('a10',$line) ne 'Last Login') {
print $Net::FullAuto::FA_Core::MRLOG "GOING LAST TWO<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last;
}
} elsif ($line=~/[:\$%>#-] ?/m) {
print $Net::FullAuto::FA_Core::MRLOG "<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last
}
print $Net::FullAuto::FA_Core::MRLOG "BOTTOM OF WHILE<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
print $Net::FullAuto::FA_Core::MRLOG "GOT OUT OF COMMANDPROMPT<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&release_semaphore(6543);
&change_pw($localhost) if $newpw;
## Make sure prompt won't match anything in send data.
$local_host->prompt("/_funkyPrompt_\$/");
$local_host->print("export PS1=_funkyPrompt_;unset PROMPT_COMMAND");
$localhost->{_ftm_type}='';
$localhost->{_cwd}='';
$localhost->{_hostlabel}=[ "__Master_${$}__",'' ];
$localhost->{_hostname}=$hostname;
$localhost->{_ip}=$ip;
$localhost->{_connect}=$_connect;
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);
&handle_error($cfh_error,'-1') if $cfh_error;
my $wloop=0;
foreach my $host (keys %same_host_as_Master) {
if (exists $Hosts{$host}{'LoginID'} &&
($Hosts{$host}{'LoginID'} ne $username)) {
$Hosts{$host}{'LoginID'}=$username;
}
}
if (exists $Hosts{"__Master_${$}__"}{'SU_ID'}) {
my $ignore='';my $su_err='';
my $su_id=$Hosts{"__Master_${$}__"}{'SU_ID'};
&release_semaphore(6543);
($ignore,$su_err)=&su($localhost->{_cmd_handle},$hostlabel,
$username,$su_id,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);
&handle_error($su_err,'-1') if $su_err;
&acquire_semaphore(6543,
"Local Host Login at Line: ".__LINE__,1);
}
while (1) {
my $_sh_pid='';
($_sh_pid,$stderr)=Rem_Command::cmd(
$localhost,'echo $$');
# --CONTINUE-- print "LOCAL_sh_pid=$_sh_pid<==\n";
print $Net::FullAuto::FA_Core::MRLOG "LOCAL_sh_pid=$_sh_pid<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$_sh_pid||=0;
$_sh_pid=~/^(.*)$/;
$_sh_pid=$1||'';
chomp($_sh_pid=~tr/\0-\11\13-\37\177-\377//d);
$localhost->{_sh_pid}=$_sh_pid;
print $Net::FullAuto::FA_Core::MRLOG "ERROR LOCALLLLLLLLLLLLLLLLLLLL_sh_pid=$localhost->{_sh_pid}<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (!$localhost->{_sh_pid}) {
$localhost->print;
$localhost->print(
$Net::FullAuto::FA_Core::printfpath.
'printf \\\\041\\\\041;echo $$;'.
$Net::FullAuto::FA_Core::printfpath.
'printf \\\\045\\\\045');
my $allins='';my $ct=0;
while (1) {
eval {
while (my $line=$localhost->get(
Timeout=>5)) {
chomp($line=~tr/\0-\37\177-\377//d);
$allins.=$line;
print $Net::FullAuto::FA_Core::MRLOG "PID_line_sh_pid_1=$allins<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($allins=~/!!(.*)%%/) {
$localhost->{_sh_pid}=$1;
print $Net::FullAuto::FA_Core::MRLOG
"PID_line_sh_pid_2=$localhost->{_sh_pid}<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last;
}
}
};
print $Net::FullAuto::FA_Core::MRLOG "FORCING_sh_pid=$localhost->{_sh_pid}<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($@) {
$localhost->print;
} elsif (!$localhost->{_sh_pid} && $ct++<50) {
$localhost->print;
} else { last }
}
print $Net::FullAuto::FA_Core::MRLOG
"PID_out_of_WHILE_sh_pid=$localhost->{_sh_pid}<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
} else { last }
last if $localhost->{_sh_pid} && $localhost->{_sh_pid}=~/^\d+$/;
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);
&handle_error($cfh_error,'-1') if $cfh_error;
if ($stderr || $wloop++==10) {
&handle_error($stderr);
}
}
&su_scrub($hostlabel) if $su_scrub;
my $switch_user='';
if (!$mainuser && (exists $Hosts{$hostlabel}{'LoginID'}) &&
($Hosts{$hostlabel}{'LoginID'} ne $login_id)) {
$switch_user=$Hosts{$hostlabel}{'LoginID'};
#$passwd[0]=$passwd[2]=$password=
# &Net::FullAuto::FA_Core::getpasswd($hostlabel,
# $switch_user,'',$stderr,'__su__');
my $ecipher = new Crypt::CBC(
$href->{"gatekeep_$username"},
$Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'Cipher'});
#$passetts->[0]=$ecipher->encrypt($passwd[0]);
$passetts->[0]=$ecipher->encrypt(
&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$switch_user,'',$stderr,
'__su__'));
$passetts->[9]=$dcipher=$ecipher;
#$passwd[1]=$passwd[0];
#$passwd[1]=unpack('a8',$passwd[0])
# if 7<length $passwd[0];
$login_id=$username=$switch_user;
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($local_host);
&handle_error($cfh_error,'-1') if $cfh_error;
}
$kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Passwds');
}
$dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
print $Net::FullAuto::FA_Core::MRLOG
"FA_SUCURE7=",$Hosts{"__Master_${$}__"}{'FA_Secure'},"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print $Net::FullAuto::FA_Core::MRLOG
"PAST THE TIE TO PASSWD DB\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $local_host_flag=0;
my $host__label='';
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %same_host_as_Master) {
# --CONTINUE-- print "WHAT ARE HOSTLAB that are SAME AS MASTER=$hostlab<==\n";
next if $hostlab eq "__Master_${$}__";
$host__label=$hostlab;
$local_host_flag=1;
last;
}
if (!$local_host_flag) {
$host__label=$Net::FullAuto::FA_Core::local_hostname;
$local_host_flag=1;
}
} elsif (exists $same_host_as_Master{$hostlabel}) {
$local_host_flag=1;
$host__label=$hostlabel;
} else { $host__label=$hostlabel }
my $key='';
if ($local_host_flag) {
$key="${login_id}_X_"
."${host__label}_X_${$}_X_$invoked[0]";
} else {
$key="${username}_X_${login_id}_X_${host__label}";
}
my $lref={};
my $status=$bdb->db_get($host__label,$lref);
$lref=~s/\$HASH\d*\s*=\s*//s;
print $Net::FullAuto::FA_Core::MRLOG "LREF=$lref<==\n if ref $lref eq 'HASH"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$lref=eval $lref;
foreach my $ky (keys %{$lref}) {
if ($ky eq $key) {
while (delete $lref->{$key}) {}
} elsif ($ky=~/_X_\d+_X_(\d+)$/ && $1+604800<$invoked[0]) {
while (delete $lref->{$ky}) {}
}
}
unless ($tosspass) {
my $cipher='';my $mr="__Master_${$}__";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
if (8<length $dcipher->decrypt($passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC($dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC($dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
my $new_encrypted=$cipher->encrypt(
$dcipher->decrypt($passetts->[0]));
print $Net::FullAuto::FA_Core::MRLOG "\nFA_LOGIN__NEWKEY=$key<== and HOST__LABEL=$host__label\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$lref->{$key}=$new_encrypted;
my $put_lref=Data::Dump::Streamer::Dump($lref)->Out();
my $status=$bdb->db_put($host__label,$put_lref);
print $Net::FullAuto::FA_Core::MRLOG "BDB STATUS=$status<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
} else {
#$tosspass{$key}=$passwd[0];
$tosspass{$key}=$dcipher->decrypt($passetts->[0]);
}
if ($save_main_pass) {
$passetts->[1]=&choose_pass_expiration();
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet) {
print "\n Saved Password will Expire: ".
scalar localtime($passetts->[1])."\n";
sleep 2;
}
my @tpass=@{$passetts}[0..1];
$href->{"passetts_$username"}=
Data::Dump::Streamer::Dump(\@tpass)->Out();
my $put_href=
Data::Dump::Streamer::Dump($href)->Out();
my $status=$bdb->db_put('localhost',$put_href);
}
undef $bdb;
$dbenv->close();
undef $dbenv;
if ($switch_user) {
my $ignore='';
($ignore,$su_err)=&su($local_host,$hostlabel,
$username,$switch_user,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);
&handle_error($su_err,'-1') if $su_err;
}
if (($^O ne 'cygwin') && $su_id) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle(
$local_host);
&handle_error($cfh_error,'-1')
if $cfh_error;
my $ignore='';
($ignore,$su_err)=&su($local_host,$hostlabel,
$login_id,$su_id,$hostname,
$ip,$use,$^O,$_connect,$cmd_type,
[],$login_Mast_error);
&handle_error($su_err,'-1') if $su_err;
}
if ($^O eq 'cygwin') {
my $wloop=0;
while (1) {
&Net::FullAuto::FA_Core::acquire_semaphore(8712,
"mount -p at Line: ".__LINE__,1);
($localhost->{_cygdrive},$stderr)=
Rem_Command::cmd(
$localhost,
"${Net::FullAuto::FA_Core::mountpath}mount -p");
&Net::FullAuto::FA_Core::release_semaphore(8712);
$localhost->{_cygdrive}=~s/^.*(\/\S+).*$/$1/s;
last if $localhost->{_cygdrive} && unpack('a1',
$localhost->{_cygdrive}) eq '/';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle(
$local_host);
&handle_error($cfh_error,'-1')
} $localhost->{_cygdrive_regex}=
qr/^$localhost->{_cygdrive}\//;
}
$localhost->{_work_dirs}=&master_transfer_dir(
$localhost);
if ($^O eq 'cygwin') {
$localhost->{_cwd}=$localhost->{_work_dirs}->{_pre_mswin};
} else {
$localhost->{_cwd}=$localhost->{_work_dirs}->{_pre};
}
if ($su_id) {
$Connections{"__Master_${$}____%-$su_id"}
=$localhost;
} else {
$Connections{"__Master_${$}____%-$login_id"}
=$localhost;
}
};
if ($passerror) {
$passerror=0;next;
} elsif ($@) {
if (7<length $@) {
if (unpack('a8',$@) eq 'Insecure') {
print $@;cleanup();
} elsif (unpack('a8',$@) eq 'INSECURE') {
$@=~s/INSECURE/Insecure/s;
}
}
$username=getlogin() || (getpwuid($<))[0]
|| "Intruder!!" if !$username;
$login_id=$username if !$login_id;
$login_Mast_error=$@;
$localhost->{_sh_pid}||='';
$localhost->{_cmd_pid}||='';
my $kill_arg=($^O eq 'cygwin')?'f':9;
if ((-1<index $@,'Not a GLOB reference') ||
(-1<index $@,'Connection reset by peer')) {
print $Net::FullAuto::FA_Core::MRLOG
"\nERROR: main::fa_login() CONNECTION ERROR:\n ",
"$@\n and SH_PID=$localhost->{_sh_pid}",
" and CMD_PID=$localhost->{_cmd_pid}\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
unless ($localhost->{_sh_pid}) {
my $ps_out=`${Net::FullAuto::FA_Core::pspath}ps -el`;
print $Net::FullAuto::FA_Core::MRLOG
"\nHERE IS THE PS CMD OUTPUT:\n ",
"$ps_out\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
foreach my $line (reverse split "\n", $ps_out) {
if (substr($line,-4) eq 'bash') {
my $pid=$line;
($pid=$line)=~s/^(\d+) .*$/$1/;
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$pid,$kill_arg);
last;
}
}
} else {
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$localhost->{_sh_pid},$kill_arg)
if exists $localhost->{_sh_pid} &&
&Net::FullAuto::FA_Core::testpid(
$localhost->{_sh_pid});
}
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
$localhost->{_cmd_pid},$kill_arg)
if &Net::FullAuto::FA_Core::testpid(
$localhost->{_cmd_pid});
#print "AWESOME\n";<STDIN>;
#$login_Mast_error='';
#$login_Mast_error=$@ if -1<index $@,
# 'Write failed: Connection reset by peer';
$retrys++;next;
} elsif ((-1<index $@,'Address already in use' ||
-1<index $@,'Connection refused')
&& $retrys<2) {
my $warn="$@\n Waiting ".int $fatimeout/3
." seconds for re-attempt . . .\n "
.($!);
warn $warn if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet;
print $MRLOG $warn
if $log && -1<index $MRLOG,'*';
sleep int $fatimeout/3;$retrys++;next;
} elsif (!$Net::FullAuto::FA_Core::cron ||
(unpack('a3',$@) eq 'pid') ||
(-1<index $login_Mast_error,$passline)) {
if ($retrys<2 && -1<index $login_Mast_error,'timed-out') {
#print $Net::FullAuto::FA_Core::MRLOG "WE ARE RETRYING LOGINMASTERERROR=$login_Mast_error\n";
my $psoutput=`${Net::FullAuto::FA_Core::pspath}ps`;
#print $Net::FullAuto::FA_Core::MRLOG "PSOUTPUTTTTTTTTTTTT=$psoutput<==\n";
$retrys++;
if (-1<index $login_Mast_error,'read') {
next;
} else {
$login_Mast_error.="\n $host - is visible on the "
."network,\n but the Telnet Server is NOT "
."RESPONDING.\n Check the availability of Telnet "
."Service on\n $host before continuing"
." ...\n\n";
}
}
#LOGINMASTERERROR=Can't locate object method "cmd" via package "fa_code_demo"
# at /usr/lib/perl5/site_perl/5.10/Net/FullAuto/FA_Core.pm line 4759.
#
# THIS ERROR OCCURS WHEN THE FILENAME AND PACKAGE NAME DIFFER
#print "LOGINMASTERERROR=$login_Mast_error\n";sleep 5;
$Net::FullAuto::FA_Core::dcipher='';
if ($login_Mast_error=~/invalid log|ogin incor|sion den|Passwo/) {
if (($^O eq 'cygwin')
&& 2<=$retrys) {
$login_Mast_error.="\n WARNING! - You may be in"
." Danger of locking out MS Domain "
."ID - $login_id!\n\n";
if ($retrys==3) {
$su_scrub=&scrub_passwd_file(
$hostlabel,$login_id);
} else { $retrys++;next }
} elsif (2<=$retrys) {
$login_Mast_error.="\n WARNING! - You may be in"
." Danger of locking out $^O "
."localhost ID - $login_id!\n\n";
if ($retrys==3) {
$su_scrub=&scrub_passwd_file(
$hostlabel,$login_id);
} else { $retrys++;next }
} else { $retrys++;next }
} elsif ($login_Mast_error=~/Input Time Limit/) {
#print $login_Mast_error if (!$Net::FullAuto::FA_Core::cron ||
# $Net::FullAuto::FA_Core::debug) &&
# !$Net::FullAuto::FA_Core::quiet;
#print $MRLOG $login_Mast_error
# if $log && -1<index $MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error(
$login_Mast_error,'__cleanup__');
} elsif ($su_id &&
-1<index($login_Mast_error,'ation is d')) {
$su_scrub=&scrub_passwd_file($hostlabel,$su_id);
next;
} elsif (defined $Net::FullAuto::FA_Core::dcipher &&
$Net::FullAuto::FA_Core::dcipher) {
#print "DOING PASSWD UPDATE\n";
&passwd_db_update($hostlabel,$login_id,$password,$cmd_type);
}
}
my $c_t=$cmd_type;$c_t=~s/^(.)/uc($1)/e;
my $die="\n FATAL ERROR! - The Host $host Returned"
."\n the Following Unrecoverable Error Condition\,"
."\n Rejecting the $c_t Login Attempt of the ID"
."\n -> $login_id :\n\n "
."$login_Mast_error\n";
#print $MRLOG $die if -1<index $MRLOG,'*';
print $die if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet;
print $MRLOG $die
if $log && -1<index $MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} last;
}
if (defined $plan_ignore_error && !$plan_ignore_error) {
$Net::FullAuto::FA_Core::makeplan=&plan();
cleanup() if $Net::FullAuto::FA_Core::makeplan eq ']quit[';
} elsif (defined $plan && !$plan) {
$Net::FullAuto::FA_Core::makeplan=&plan();
cleanup() if $Net::FullAuto::FA_Core::makeplan eq ']quit[';
} elsif ($plan || $plan_ignore_error) {
$plan||=$plan_ignore_error||='';
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Plans',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${Net::FullAuto::FA_Core::progname}_plans.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'',$track);
my $pref='';
my $status=$bdb->db_get($plan,$pref);
$pref=~s/\$HASH\d*\s*=\s*//s;
$plan=eval $pref;
$plan=$plan->{Plan};
}
return $cust_subnam_in_fa_code_module_file, \@menu_args, $fatimeout;
} ## END of &fa_login
sub choose_pass_expiration
{
my $notice=$_[0]||'';
#$curmonth='04';
my %show_mins=(
Label => 'show_mins',
Item_1=> {
Text => "]C[",
Convey => $showmins,
Result => sub{ my $previous_selection='"]P[{select_cal_days}"';
return substr($previous_selection,1,-1)." ".']S[' }
},
Banner=> " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Password Expiration Time :",
);
my %select_hour=(
Label => 'select_hour',
Item_1=> {
Text => "Show Minutes",
Result => \%show_mins,
},
Item_2=> {
Text => "]C[",
Convey => $hours,
Result => sub{ my $previous_selection=']P[';
return $previous_selection." ".']S[' }
},
Banner=> " (The current time is ".&get_now_am_pm." ".
POSIX::strftime("%Z", localtime()).")\n\n".
" Please Select a Password Expiration Time :",
);
my %select_cal_days=(
Label => 'select_cal_days',
Item_1=> {
Text => "]C[",
Convey => $fulldays,
Result => \%select_hour,
},
Banner=> ' Please Select a Password Expiration Date :'
);
my %select_cal_months=(
Label => 'select_cal_months',
Item_1=> {
Text => "]C[",
Convey => $cal_months,
Result => \%select_cal_days,
},
Banner=> ' Please Select a Month :'
);
my %calendar_years=(
Label => 'calendar_years',
Item_1=> {
Text => "]C[",
Convey => [$curyear..$endyear],
Result => \%select_cal_months,
},
Banner=> ' Please Select a Year :'
);
my %select_minutes=(
Label => 'select_minutes',
Item_1=> {
Text => "1 Minute",
},
Item_2=> {
Text => "]C[ Minutes",
Convey => [2,3,4,5,6,7,8,9],
},
Item_3=> {
Text => "]C[ Minutes",
Convey => [10..60],
},
Banner => ' Choose Time :',
);
my %select_hours=(
Label => 'select_hours',
Item_1=> {
Text => "1 Hour",
},
Item_2=> {
Text => "]C[ Hours",
Convey => [2,3,4,5,6,7,8,9],
},
Item_3=> {
Text => "]C[ Hours",
Convey => [10..24],
},
Banner => ' Choose Time :',
);
my %select_days=(
Label => 'select_days',
Item_1=> {
Text => "1 Day",
},
Item_2=> {
Text => "]C[ Days",
Convey => [2,3,4,5,6,7,8,9],
},
Item_3=> {
Text => "]C[ Days",
Convey => [10..365],
},
Banner => ' Choose Time :',
);
my %select_weeks=(
Label => 'select_weeks',
Item_1=> {
Text => "1 Week",
},
Item_2=> {
Text => "]C[ Weeks",
Convey => [2,3,4,5,6,7,8,9],
},
Item_3=> {
Text => "]C[ Weeks",
Convey => [10..53],
},
Banner => ' Choose Time :',
);
my %select_months=(
Label => 'select_time',
Item_1=> {
Text => "1 Month",
},
Item_2=> {
Text => "]C[ Months",
Convey => [2,3,4,5,6,7,8,9],
},
Item_3=> {
Text => "]C[ Months",
Convey => [10..12],
},
Banner => " Choose Time in Months (A Month is 30 Days)\n\n".
" [Hint: Use FULL CALENDAR for more precision]:",
);
my %pass_ask_exp=(
Label => 'pass_ask_exp',
Item_1=> {
Text => "FULL CALENDAR",
Result => \%calendar_years,
},
Item_2=> {
Text => "Number of MINUTES",
Result => \%select_minutes,
},
Item_3=> {
Text => "Number of HOURS",
Result => \%select_hours,
},
Item_4=> {
Text => "Number of DAYS",
Result => \%select_days,
},
Item_5=> {
Text => "Number of WEEKS",
Result => \%select_weeks,
},
Item_6=> {
Text => "Number of MONTHS",
Result => \%select_months,
},
Banner => $notice.
" Choose the Expiration Time of the local saving\n".
" of ${username}\'s Password via one of the following\n".
" selection methods (Password is Saved with Encryption):",
);
my $selection=&Menu(\%pass_ask_exp);
#print "SELECTION=$selection\n";
&cleanup if $selection eq ']quit[';
my ($num,$type)=('','');
($num,$type)=split /\s+/, $selection;
if ($num!~/^\d/) {
my @d=split /,* +/, $selection;
$mn=unpack('a3',$d[0]);
#print "MN=$mn and D=$d[0]\n";
if (defined $d[3] && $d[3]) {
my $ap=substr($d[3],-2);
my ($h,$m)=('','');
($h,$m)=split ':',substr($d[3],0,-2);
$h+=12 if $ap eq 'pm' && $h!=12;
return &Net::FullAuto::FA_Core::timelocal(
0,$m,$h,$d[1],$Net::FullAuto::FA_Core::month{$mn}-1,$d[2]);
}
return &Net::FullAuto::FA_Core::timelocal(
0,0,0,$d[1],$Net::FullAuto::FA_Core::month{$mn}-1,$d[2]);
} elsif ($type=~/Min/) {
return time + $num * 60;
} elsif ($type=~/Hour/) {
return time + $num * 3600;
} elsif ($type=~/Day/) {
return time + $num * 86400;
} elsif ($type=~/Week/) {
return time + $num * 604800;
} elsif ($type=~/Month/) {
return time + $num * 2592000;
}
}
sub passwd_db_update
{
my @topcaller=caller;
print "main::passwd_db_update() CALLER="
,(join ' ',@topcaller),"\n";# if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "main::passwd_db_update() CALLER=",
(join ' ',@topcaller),"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $hostlabel=$_[0];my $login_id=$_[1];my $passwd=$_[2];
my $cmd_type=$_[3];
my $kind='prod';
my $local_host_flag=0;
my $track='';
$kind='test' if
$Net::FullAuto::FA_Core::test && !$Net::FullAuto::FA_Core::prod;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
print $Net::FullAuto::FA_Core::MRLOG
"FA_SUCURE8=",$Hosts{"__Master_${$}__"}{'FA_Secure'},"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($hostlabel eq "__Master_${$}__") {
# print the contents of the file
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
next if $k eq "__Master_${$}__";
$hostlabel=$k;
$local_host_flag=1;
last;
}
undef $cursor ;
if (!$local_host_flag) {
$hostlabel=$Net::FullAuto::FA_Core::local_hostname;
$local_host_flag=1;
}
} elsif (exists $Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel}) {
$local_host_flag=1;
} my $key='';
if ($local_host_flag) {
$key="${username}_X_"
."${hostlabel}_X_${$}_X_$Net::FullAuto::FA_Core::invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_"
."${hostlabel}_X_$cmd_type";
} else {
$key="${username}_X_${login_id}_X_"
.$hostlabel;
}
my $href='';
my $status=$bdb->db_get($hostlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
foreach my $ky (keys %{$href}) {
if ($ky eq $key) {
while (delete $href->{"$key"}) {}
} elsif ($ky=~/_X_\d+_X_(\d+)$/ && $1+604800<$invoked[0]) {
while (delete $href->{"$ky"}) {}
}
}
my $cipher='';my $mr="__Master_${$}__";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
if ($Net::FullAuto::FA_Core::dcipher &&
8<length $Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
#my $cipher = new Crypt::CBC($Net::FullAuto::FA_Core::passwd[1],
#my $cipher = new Crypt::CBC($Net::FullAuto::FA_Core::passetts->[1],
# $Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
my $new_encrypted=$cipher->encrypt($passwd);
$href->{$key}=$new_encrypted;
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($hostlabel,$put_href);
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
}
sub su_scrub
{
my $hostlabel=$_[0];my $login_id='';my $cmd_type=$_[1];
my $kind='prod';my $track='';
$kind='test' if
$Net::FullAuto::FA_Core::test && !$Net::FullAuto::FA_Core::prod;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
print $Net::FullAuto::FA_Core::MRLOG "FA_SUCURE9=",$Hosts{"__Master_${$}__"}{'FA_Secure'},"\n";
my $local_host_flag=0;
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %Net::FullAuto::FA_Core::same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";
$local_host_flag=1;
}
if (!$local_host_flag) {
$local_host_flag=1;
}
} elsif (exists $Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel}) {
$local_host_flag=1;
}
my $href='';
my $status=$bdb->db_get($hostlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $key='';
if ($local_host_flag) {
$key="${username}_X_"
."${hostlabel}_X_${$}_X_$Net::FullAuto::FA_Core::invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_"
."${hostlabel}_X_$cmd_type";
} else {
$key="${username}_X_${login_id}_X_"
.$hostlabel;
}
foreach my $ky (keys %{$href}) {
if ($ky eq $key) {
while (delete $href->{$key}) {}
} elsif ($ky=~/_X_\d+_X_(\d+)$/ && $1+604800<$invoked[0]) {
while (delete $href->{$ky}) {}
}
}
my $cipher='';my $mr="__Master_${$}__";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
if (8<length $Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
#my $cipher = new Crypt::CBC($Net::FullAuto::FA_Core::passwd[1],
#my $cipher = new Crypt::CBC($Net::FullAuto::FA_Core::passetts->[1],
# $Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Cipher'});
#my $new_encrypted=$cipher->encrypt($Net::FullAuto::FA_Core::passwd[0]);
my $new_encrypted=$cipher->encrypt(
$Net::FullAuto::FA_Core::dcipher->decrypt($passetts->[0]));
#my $new_encrypted=$cipher->encrypt($Net::FullAuto::FA_Core::passetts->[0]);
$href->{$key}=$new_encrypted;
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($hostlabel,$put_href);
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
}
sub su
{
my @topcaller=caller;
print "su() CALLER=", (join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "su() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $fh=$_[0];
my $hostlabel=$_[1];
my $username=$_[2];
my $su_id=$_[3];
my $hostname=$_[4];
my $ip=$_[5];
my $use=$_[6];
my $uname=$_[7];
my $_connect=$_[8];
my $cmd_type=$_[9];
my @connect_method=@{$_[10]};
my $errmsg=$_[11];
my $pass_flag=0;
my $id='';my $stderr='';my $track='';
my $cfh_ignore='';my $cfh_error='';
if ($su_id eq 'root') {
my $gids='';
#$fh->print('groups');
#while (my $line=$fh->get) {
# chomp($line=~tr/\0-\37\177-\377//d);
# $gids.=$line;
#print $Net::FullAuto::FA_Core::MRLOG "su() GIDS=$gids<==\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
# last if $gids=~s/_funkyPrompt_//gs;
# }
# --CONTINUE-- print "GOING FOR GIDS\n";
my $ctt=2;
while ($ctt--) {
($gids,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ] },'groups');
if (!$gids && !$stderr) {
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$fh);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
} last if $gids;
}
die 'no-gids' if !$gids || $stderr;
print $Net::FullAuto::FA_Core::MRLOG "su() DONEGID=$gids<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#$gids=unpack('x6 a*',$gids);
if (lc($uname) eq 'aix' && (-1==index $gids,'suroot')) {
my $hostlb=$hostlabel;
if ($hostlabel eq "__Master_${$}__") {
foreach my $hostlab (keys %same_host_as_Master) {
next if $hostlab eq "__Master_${$}__";
$hostlb=$hostlab;
last;
}
}
my $die="\"$username\" does NOT have authorization to "
."run this\n script on Host : $hostlb\n"
." \"$username\" is not a member of the \"suroot\""
." UNIX group.\n Contact your system administrator.\n";
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test &&
!$Net::FullAuto::FA_Core::prod;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.
'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",
'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
print $Net::FullAuto::FA_Core::MRLOG "FA_SUCURE10=",$Hosts{"__Master_${$}__"}{'FA_Secure'},"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $href='';
my $status=$bdb->db_get($hostlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $key="${username}_X_${su_id}_X_${hostlabel}";
while (delete $href->{$key}) {}
$status=$bdb->db_put($hostlabel,$href);
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
print $Net::FullAuto::FA_Core::MRLOG "DYING HERE WITH LOCK PROB" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return '',"$die $!";
}
}
#if ($su_id eq 'root') {
$fh->print("su $su_id");
#} else {
# $fh->print("login $su_id");
#}
return '', $fh->errmsg if $fh->errmsg;
# Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
_connect=>$_connect });
if ($stderr) {
return '',$stderr if $stderr;
}
## Send password.
$fh->print(&getpasswd(
$hostlabel,$su_id,'',
$errmsg,'__su__'));
$fh=&Rem_Command::wait_for_prompt(
$fh,$timeout,\@connect_method,$hostlabel,'__su__');
my $cnt=2;
while (1) {
($id,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$fh,
_hostlabel=>[ $hostlabel,'' ] },
'id -unr');
if ($id eq $su_id || $id eq 'root') {
last;
} elsif ($cnt--==0) {
die "Cannot discover user id at ".__LINE__;
}
}
#($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
#&handle_error($cfh_error,'-1') if $cfh_error;
return '',$fh->errmsg if $fh->errmsg;
if ($id ne $su_id && $id ne 'root') {
$fh->print("su $su_id");
return '',$fh->errmsg if $fh->errmsg;
## Wait for password prompt.
while (my $line=$fh->get) {
chomp($line=~tr/\0-\37\177-\377//d);
if ($line=~/password[: ]*$/i) {
$pass_flag=1;last;
} elsif (!$Net::FullAuto::FA_Core::cron &&
$line=~/\[YOU HAVE NEW MAIL\]/m) {
my $hostlab=$hostlabel;
$hostlab=(keys %same_host_as_Master)[1]
if $hostlabel eq "__Master_${$}__";
print "\nAttn: $su_id on $hostlab --> [YOU HAVE NEW MAIL]\n\n";
sleep 1;
} last if $line=~/[$|%|>|#|-|:] ?$/m;
}
## Send password.
if ($pass_flag) {
$fh->print(&getpasswd(
$hostlabel,$su_id,'',$errmsg,
'__force__','__su__'));
}
($id,$stderr)=&unix_id($fh,$su_id,$hostlabel,$errmsg);
if (defined $stderr) {
return '',$stderr;
} elsif ($id ne $su_id) {
return '', "Cannot Login as Alternate User -> $su_id";
}
}
## Make sure prompt won't match anything in send data.
my $prompt = '_funkyPrompt_';
$fh->prompt("/$prompt\$/");
$fh->print("export PS1=$prompt;unset PROMPT_COMMAND");
while (my $line=$fh->get) {
last if $line=~/$prompt$/s;
}
}
sub change_pw {
my $cmd_handle=$_[0];
print $blanklines;
## Send new passwd.
ReadMode 2;
my $npw=<STDIN>;
ReadMode 0;
PW: while (1) {
chomp($npw);
$cmd_handle->print("$npw");
my ($output,$line)='';
while ($line=$_[0]->get) {
if ($line=~/changed/) {
print $blanklines;
last PW;
}
$output.=$line;
if ($line=~/: ?$/i) {
print $output;
ReadMode 2;
$npw=<STDIN>;
ReadMode 0;
$output='';
print $blanklines;
last;
}
}
}
}
sub unix_id {
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;
print "unix_id() CALLER=", (join ' ',@topcaller),"\n";
#if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"unix_id() CALLER=", (join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $localhost=$_[0];
my $su_id=$_[1];
my $hostlabel=$_[2];
my $die='';my $id='';
my $prompt='';my $dieline='';
eval {
my $next=0;
while (my $line=$localhost->get) {
print $Net::FullAuto::FA_Core::MRLOG "GETMAILLINE=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "GETMAILLINE=$line\n" if $Net::FullAuto::FA_Core::debug;
next if $line=~/^\s+$/s;
if (!$Net::FullAuto::FA_Core::cron && $line=~/\[YOU/s) {
my $hostlab=$hostlabel;
$hostlab=(keys %same_host_as_Master)[1]
if $hostlabel eq "__Master_${$}__";
print "\nAttn: $su_id on $hostlab --> [YOU HAVE NEW MAIL]\n\n";
$localhost->print;
sleep 1;
} elsif ($line=~/\d\d\d\d-\d\d\d /s) {
$dieline=__LINE__;
$die.=$line;
$localhost->print;next;
} else { $localhost->print }
last
} $localhost->print;
print $Net::FullAuto::FA_Core::MRLOG "OUTOFGETMAIL\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "OUTOFGETMAIL\n" if $Net::FullAuto::FA_Core::debug;
while (my $line=$localhost->get) {
print $Net::FullAuto::FA_Core::MRLOG "GETPROMPTLINE=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "GETPROMPTLINE=$line\n"; #if $Net::FullAuto::FA_Core::debug;
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
next if $line=~/^\s*$/s;
($prompt=$line)=~s/^.*\n(.*)$/$1/s;
$prompt=~s/^\^C//;
print "WHAT IS PROMPT=$prompt<===\n";
return if $prompt;
}
};
my $cmd_prompt=quotemeta $prompt;
print $Net::FullAuto::FA_Core::MRLOG "PROMPT=$prompt<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "PROMPT=$prompt<==\n" if $Net::FullAuto::FA_Core::debug;
if ($die) {
$die=~s/$cmd_prompt$//s;
$die=~s/^/ /m;
$die=" $hostlabel Login ERROR! :\n$die";
$die.=" ".($!)." at Line $dieline";
}
if ($@) {
if ($die) {
return '',$die
} else {
return '',$@
}
}
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
eval {
$localhost->print('id -unr');
select(undef,undef,undef,0.02); # sleep for 1/50th second;
while (my $line=$localhost->get) {
print $Net::FullAuto::FA_Core::MRLOG "ID_PROMPTLINE=$line<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$line=~tr/\0-\11\13-\37\177-\377//d;
$id.=$line;
$id=~s/id -unr\s*//s;
next if $id!~s/\s*$cmd_prompt$//s;
$id=~s/^\s*//;
last
}
};
if ($@) {
if ($die) {
return '',$die
} else {
return '',$@
}
} elsif ($die) {
if (!$id) {
return '',$die
} else {
&Net::FullAuto::FA_Core::handle_error($die,'__return__','__warn__');
return $id
}
}
#$Net::FullAuto::FA_Core::log=0 if $logreset;
return $id,''
}
sub ping
{
my @topcaller=caller;
print "ping() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "ping() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $cmd='';my $stdout='';my $stderr='';my $didping=10;
if ($specialperms eq 'setuid') {
if ($^O eq 'cygwin') {
$cmd=[ "${Net::FullAuto::FA_Core::pingpath}ping",'-n','1',$_[0],"2>&1" ];
} else {
my $bashpath=$Net::FullAuto::FA_Core::bashpath;
if (exists $Hosts{"__Master_${$}__"}{'bash'}) {
$bashpath=$Hosts{"__Master_${$}__"}{'bash'};
$bashpath.='/' if $bashpath!~/\/$/;
}
my $pth=$Hosts{"__Master_${$}__"}{'FA_Core'}."ping$$.sh";
open(TP,">$pth") || die "CANNOT OPEN $pth $!";
print TP "${Net::FullAuto::FA_Core::pingpath}ping -c1 $_[0] 2>&1";
CORE::close(TP);
$cmd=[ "${bashpath}bash",$pth,"2>&1" ];
}
} else {
if ($^O eq 'cygwin') {
$cmd=[ "${Net::FullAuto::FA_Core::pingpath}ping -n 1 $_[0]" ];
} else {
$cmd=[ "${Net::FullAuto::FA_Core::pingpath}ping -c1 $_[0]" ];
}
}
eval {
unless ($specialperms eq 'setuid') {
($stdout,$stderr)=$localhost->cmd($cmd->[0],5);
} else {
$didping=7;
($stdout,$stderr)=&setuid_cmd($cmd,5);
}
};
my $ev_err=$@||'';
if ($specialperms eq 'setuid' && $^O ne 'cygwin') {
unlink $Hosts{"__Master_${$}__"}{'FA_Core'}."ping$$.sh";
}
if ($ev_err) {
if (wantarray) {
return 0,
${Net::FullAuto::FA_Core::pingpath}.
"ping timed-out: $ev_err";
} else {
&Net::FullAuto::FA_Core::handle_error(
${Net::FullAuto::FA_Core::pingpath}.
"ping timed-out: $ev_err","-$didping");
}
}
if (-1<index $stderr,'is alive') {
$stdout=$stderr;
$stderr='';
}
$stdout=~s/^\s*//s;
foreach my $line (split /^/, $stdout) {
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
if (-1<index $line,' from ' || -1<index $line,'is alive') {
if (wantarray) {
return $stdout,'';
} else {
return $stdout;
}
}
$stderr=$stdout if (-1<index $line,'NOT FOUND')
|| (-1<index $line,'Request Timed Out')
|| (-1<index $line,'Bad IP')
|| (-1<index $line,'100% packet loss');
}
$stderr=~s/^(.*)$/ $1/mg if $stderr;
if (wantarray) {
return 0,$stderr;
} elsif (defined $_[1] && $_[1] eq '__return__') {
print $Net::FullAuto::FA_Core::MRLOG
"\nPING ERROR for CMD=",(join " ",@{$cmd})," AND STDERR=$stderr\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return 0;
} else {
$didping+=30;
&Net::FullAuto::FA_Core::handle_error($stderr,"-$didping");
}
}
sub work_dirs
{
my @topcaller=caller;
print "work_dirs() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "work_dirs() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $transfer_dir=$_[0];
$transfer_dir||='';
my $hostlabel=$_[1];
my $cmd_handle=$_[2];
bless $cmd_handle;
my $cmd_type=$_[3];
my $cygdrive=$_[4];
$cygdrive||='';
my $_connect=$_[5];
my ($output,$stderr,$regex)=('','','');
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transferdir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
if (-1<index $cmd_handle,'HASH') {
$regex=$cmd_handle->{_cygdrive_regex};
$cygdrive=$cmd_handle->{_cygdrive}
if exists $cmd_handle->{_cygdrive};
} elsif ($cygdrive) {
$regex=qr/^$cygdrive\//;
}
my $work_dirs={};
if ($transfer_dir) {
if (unpack('x1 a1',$transfer_dir) eq ':') {
my ($drive,$path)=unpack('a1 x1 a*',$transfer_dir);
$path=~tr/\\/\//;
${$work_dirs}{_tmp_mswin}=$transfer_dir.'\\';
${$work_dirs}{_tmp}=$cygdrive
.'/'.lc($drive).$path.'/';
} elsif ($cygdrive && $transfer_dir=~/$regex/) {
${$work_dirs}{_tmp}=$transfer_dir.'/';
(${$work_dirs}{_tmp_mswin}=$transfer_dir)
=~s/$regex//;
${$work_dirs}{_tmp_mswin}=~s/^(.)/$1:/;
${$work_dirs}{_tmp_mswin}=~tr/\//\\/;
${$work_dirs}{_tmp_mswin}=~s/\\/\\\\/g;
${$work_dirs}{_tmp_mswin}.='\\';
} elsif ($cygdrive && unpack('a1',$transfer_dir) eq '/' ||
unpack('a1',$transfer_dir) eq '\\') {
(${$work_dirs}{_tmp},${$work_dirs}{_tmp_mswin})
=&File_Transfer::get_drive(
$transfer_dir,'Transfer',
{ _cmd_handle=>$cmd_handle,_cmd_type=>$cmd_type },$hostlabel);
} elsif (unpack('a1',$transfer_dir) eq '/') {
${$work_dirs}{_tmp}=$transfer_dir.'/';
${$work_dirs}{_tmp_mswin}='';
} else {
my $die="Cannot Locate Transfer Directory - $transfer_dir";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
} ${$work_dirs}{_lcd}=${$work_dirs}{_tmp_lcd}
=$localhost->{_work_dirs}->{_tmp};
${$work_dirs}{_pre_lcd}='';
return $work_dirs;
}
if (&Net::FullAuto::FA_Core::test_dir($cmd_handle->{_cmd_handle},'/tmp')
eq 'WRITE') {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($cmd_handle);
&handle_error($cfh_error,'-1') if $cfh_error;
${$work_dirs}{_tmp}='/tmp/';
if ($cmd_handle->{_uname} eq 'cygwin') {
my $pwd='';my $curdir='';my $cnt=5;
while ($cnt--) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&clean_filehandle($cmd_handle->{_cmd_handle});
&handle_error($cfh_error,'-1') if $cfh_error;
($pwd,$stderr)=$cmd_handle->cmd('pwd');
next if $stderr;
if ($pwd=~/\n/s) {
my @split_on_newline=split "\n", $pwd;
$pwd=pop @split_on_newline;
} next if $pwd!~/^[\/]/;
last;
}
&handle_error($stderr,'-2','__cleanup__') if $stderr;
($output,$stderr)=$cmd_handle->cmd(
"cd \"".${$work_dirs}{_tmp}."\"");
#&handle_error($stderr,'-2','__cleanup__') if $stderr;
#$curdir=&attempt_cmd_xtimes($cmd_handle->{_cmd_handle},
# 'cmd /c chdir',$cmd_handle->{'hostlabel'}[0]);
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
if ($^O eq 'cygwin') {
my $cdr='';
if (exists $localhost->{_cygdrive} &&
-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
my $cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w $curdir");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
${$work_dirs}{_tmp_mswin}=$cdr.'\\\\';
}
($output,$stderr)=$cmd_handle->cmd(
'cd '."\"$pwd\"");
&handle_error($stderr,'-2','__cleanup__') if $stderr;
} ${$work_dirs}{_lcd}=${$work_dirs}{_tmp_lcd}
=$localhost->{_work_dirs}->{_tmp};
${$work_dirs}{_pre_lcd}='';
return $work_dirs;
}
if ($cmd_handle->{_uname} eq 'cygwin') {
(${$work_dirs}{_tmp},${$work_dirs}{_tmp_mswin})
=&File_Transfer::get_drive(
'temp','Temp',
$cmd_handle,$hostlabel);
if ($ms_share) {
my $host=($use eq 'ip')?$ip:$hostname;
${$work_dirs}{_cwd_mswin}="\\\\$host\\$ms_share\\";
}
return $work_dirs if ${$work_dirs}{_tmp};
} ${$work_dirs}{_tmp}=${$work_dirs}{_tmp_mswin}='';
${$work_dirs}{_lcd}=$localhost->{_work_dirs}->{_tmp};
${$work_dirs}{_pre_lcd}='';
return $work_dirs
}
sub close
{
return &File_Transfer::close(@_);
}
sub cwd
{
my @topcaller=caller;
print "\nINFO: main::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $stdout='';my $stderr='';
print "WHAT IS CALLER=",caller,"<==\n";
if (!defined $_[1]) {
return Cwd::getcwd();
} else {
($stdout,$stderr)=File_Transfer::cwd(@_);
if (wantarray) {
return $stdout,$stderr;
} elsif ($stderr) {
&handle_error($stderr,'-4');
} return $stdout;
}
}
sub setuid_cmd
{
my @topcaller=caller;
#print "setuid_cmd() CALLER=",(join ' ',@topcaller),"\n";
# if $Net::FullAuto::FA_Core::debug;
# NOTE: the CALLER line is commmented because it breaks
# this routine when set. Anything printing to
# stdout from this routine will clash with
# output from the cmd and confuse IO::CaptureOutput
# which wraps this routine.
print $Net::FullAuto::FA_Core::MRLOG "setuid_cmd() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $cmd=[];
$cmd = (ref $_[0] eq 'ARRAY') ? $_[0] : [ $_[0] ];
my $timeout=$_[1]||0;
my $regex='';
if ($timeout) {
alarm($timeout+10);
if (7<length $timeout &&
unpack('a8',$timeout) eq '(?-xism:') {
$regex=$timeout;
$timeout=shift;
$timeout||='';
}
if ($timeout!~/^\d+$/) {
undef $timeout;
}
} else { alarm($Net::FullAuto::FA_Core::timeout) }
my $flag=shift;
$flag||='';
my $cmd_err='';
$cmd_err=join ' ',@{$cmd} if ref $cmd eq 'ARRAY';
my $one=${$cmd}[0]||'';my $two='';
$two=${$cmd}[1] if 0<$#{$cmd};
my $three='';
$three=${$cmd}[2] if 1<$#{$cmd};
my $four='';
$four=${$cmd}[3] if 2<$#{$cmd};
my $five='';
$five=${$cmd}[4] if 3<$#{$cmd};
my $six='';
$six=${$cmd}[5] if 4<$#{$cmd};
my $seven='';
$seven=${$cmd}[6] if 5<$#{$cmd};
my $eight='';
$eight=${$cmd}[7] if 6<$#{$cmd};
if (!$one && ref $cmd ne 'ARRAY') {
$one=$cmd;$cmd_err=$cmd;
}
$regex||='';my $pid='';my $output='';
my $stdout='';my $stderr='';
&handle_error("Can't fork: $!")
unless defined($pid=open(KID, "-|")); # Save Pound Sign
if ($pid) { # parent
while (my $line=<KID>) {
$output.=$line; # Save Pound Sign
}
CORE::close(KID); # Save Pound Sign
} else { # child
my @temp = ($EUID, $EGID); # Save Pound Sign
my $orig_uid = $UID; # Save Pound Sign
my $orig_gid = $GID; # Save Pound Sign
$EUID = $UID; # Save Pound Sign
$EGID = $GID; # Save Pound Sign
# Drop privileges
$UID = $orig_uid; # Save Pound Sign
$GID = $orig_gid; # Save Pound Sign
# Make sure privs are really gone
($EUID, $EGID) = @temp; # Save Pound Sign
if (!$flag || lc($flag) ne '__use_parent_env__') {
$ENV{PATH} = ''; # Save Pound Sign
$ENV{ENV} = ''; # Save Pound Sign
}
if ($eight) {
exec $one, $two, $three, $four, $five, $six, $seven, $eight ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($seven) {
exec $one, $two, $three, $four, $five, $six, $seven ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($six) {
exec $one, $two, $three, $four, $five, $six ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($five) {
exec $one, $two, $three, $four, $five ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($four) {
exec $one, $two, $three, $four ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($three) {
exec $one, $two, $three ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($two) {
exec $one, $two ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} elsif ($one) {
exec $one ||
&handle_error("Couldn't exec: $cmd_err".($!),'-1'); # Save Pound Sign
} else { alarm(0);return }
}
if ($regex && $output!~/$regex/s) {
if (wantarray) {
alarm(0);return '',"Cmd $cmd_err returned tainted data";
} else {
&Net::FullAuto::FA_Core::handle_error(
"Cmd $cmd_err returned tainted data");
}
} $output=~s/^\s*//s;
if ($one!~/^[^ ]*clear$/) {
my @outlines=();my @errlines=();
foreach my $line (split /^/,$output) {
if ($line=~s/^[\t ]*stdout: //) {
push @outlines, $line;
} else { push @errlines, $line }
} $stdout=join '', @outlines;$stderr=join '',@errlines;
} else { $stdout=$output }
chomp $stdout;chomp $stderr;
alarm(0);
if (wantarray) {
return $stdout,$stderr;
} else { return $stdout }
}
sub cmd
{
my $self=$_[0];
my @topcaller=caller;
my $hlab='';
if ((-1<index $self,'HASH') && (exists $self->{_hostlabel})) {
$hlab=$self->{_hostlabel}->[0] || "localhost - ".hostname;
} else { $hlab="localhost - ".hostname }
print "\nINFO: main::cmd() (((((((CALLER))))))) ".
"for HostLabel $hlab:\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nmain::cmd() (((((((CALLER))))))) ".
"for HostLabel $hlab:\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $escape=0;
my $cmd='';my $cmtimeout=$timeout;my $delay=0;
if (defined $_[1] && $_[1]) {
if ($_[1]=~/^[0-9]+$/) {
$cmtimeout=$_[1];
if (-1<index $self,'HASH') {
$_[1]=$cmtimeout=$Hosts{$self->{_hostlabel}->[0]}{'Timeout'}
if exists $Hosts{$self->{_hostlabel}->[0]}{'Timeout'};
}
} elsif ($_[1] eq '__escape__') {
$escape=1;
} elsif ($_[1] eq '__delay__') {
$delay=1;
} else {
$cmd=$_[1];
}
}
if (defined $_[2] && $_[2]) {
if ($_[2]=~/^[0-9]+$/) {
$cmtimeout=$_[2];
$_[1]=$cmtimeout=$Hosts{$self->{_hostlabel}->[0]}{'Timeout'}
if exists $Hosts{$self->{_hostlabel}->[0]}{'Timeout'};
} elsif ($_[2] eq '__escape__') {
$escape=1;
} elsif ($_[2] eq '__delay__') {
$delay=1;
} else {
if ($_[2]!~/^__[a-z]+__$/) {
if (wantarray) {
return 0,'Third Argument for Timeout Value is not Whole Number';
} else {
&Net::FullAuto::FA_Core::handle_error(
'Third Argument for Timeout Value is not Whole Number')
}
}
}
}
if (defined $_[3] && $_[3]) {
if ($_[3] eq '__escape__') {
$escape=1;
} elsif ($_[3] eq '__delay__') {
$delay=1;
}
}
my $stderr='';my $stdout='';my $pid_ts='';
my $all='';my @outlines=();my @errlines=();
if (!$escape) {
if ((-1<index $self,'HASH')
&& exists $self->{_cmd_handle}
&& defined fileno $self->{_cmd_handle}) {
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
print $Net::FullAuto::FA_Core::MRLOG "main::cmd() CMD to Rem_Command=",
(join ' ',@_),"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($self->{_cmd_handle});
&handle_error($cfh_error,'__cleanup__') if $cfh_error;
sleep 1 if $delay;
#print "READY FOR CMD=@_\n";
eval {
($stdout,$stderr)=Rem_Command::cmd(@_);
};
if ($@) {
if ($stderr) {
$stderr.="\n $@";
} else {
$stderr=$@;
}
}
#print "WHAT IS STDERR FOR READY=$stderr<==\n";
if (wantarray) {
return $stdout,$stderr;
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} else {
&handle_error($stderr,'-16');
}
} return $stdout;
#$Net::FullAuto::FA_Core::log=0 if $logreset;
}
if (defined $localhost &&
$localhost &&
(-1<index $localhost,'HASH')
&& exists $localhost->{_cmd_handle}
&& defined fileno $localhost->{_cmd_handle}) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=&clean_filehandle($localhost);
&handle_error($cfh_error,'-1') if $cfh_error;
($stdout,$stderr)=$localhost->cmd(@_);
if (wantarray) {
return $stdout,$stderr;
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} else {
&handle_error($stderr,'-16');
}
} return $stdout;
}
}
if ($^O eq 'cygwin') {
if ($self!~/^cd[\t ]/) {
$cmd="$self|perl -e \'\$o=join \"\",<STDIN>;\$o=~s/^/stdout: /mg;".
"print \$o,\"__STOP--\"\' 2>&1";
}
my $cmd_handle='';my $cmd_pid='';my $next=10;
while (1) {
($cmd_handle,$cmd_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
[$cmd,'','','',$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch cmd subprocess");
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cmtimeout);
$cmd_handle->telnetmode(0);
$cmd_handle->binmode(1);
my $first=0;
eval {
while (my $line=$cmd_handle->get(Timeout=>10)) {
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
next if $line=~/^\s*$/ && !$first;
$first=1;
$all.=$line;
last if $all=~s/\n*_\s*_\s*S\s*T\s*O\s*P\s*-\s*-\s*$//s;
}
};
if ($@) {
my $kill_arg=($^O eq 'cygwin')?'f':9;
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($cmd_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($cmd_pid);
$cmd_handle->close;
if ($next--) {
$all='';next;
} else { &cleanup }
} else { $cmd_handle->print("\004");last }
} $cmd_handle->close;
} else {
if ($self!~/^cd[\t ]/) {
my $sedpath=$Net::FullAuto::FA_Core::sedpath;
if (exists $Hosts{"__Master_${$}__"}{'sed'}) {
$sedpath=$Hosts{"__Master_${$}__"}{'sed'};
$sedpath.='/' if $sedpath!~/\/$/;
}
$cmd="$self | ${sedpath}sed -e \'s/^/stdout: /\' 2>&1";
}
($stdout,$stderr)=&setuid_cmd($cmd,$cmtimeout);
&handle_error($stderr,'-1') if $stderr;
}
if ($all) {
foreach my $line (split /^/, $all) {
if ($line=~s/^[\t ]*stdout: //) {
push @outlines, $line;
} else { push @errlines, $line }
} $stdout=join '', @outlines;$stderr=join '',@errlines;
}
$stderr=~s/^\s*$//s;
if (wantarray) {
return $stdout,$stderr;
} elsif ($stderr) {
if (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} elsif (-1<index $self,'HASH') {
&handle_error($stderr,'-19');
} else {
&handle_error($stderr,'-16');
}
} return $stdout;
}
sub print
{
my @topcaller=caller;
print "PARENTPRINTCALLER=",(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "PARENTPRINTCALLER=",(join ' ',@topcaller),
"\nand ARGS=@_\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return Net::Telnet::print(@_);
}
sub scrub_passwd_file
{
my @topcaller=caller;
my $track='';
print "scrub_passwd_file() CALLER=",(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "scrub_passwd_file() CALLER=",
(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $passlabel=$_[0];my $login_id=$_[1];
my $cmd_type=$_[2];
my @passlabels=();
my $local_host_flag=0;
if ($passlabel eq "__Master_${$}__") {
my $local_host_flag=0;
foreach my $passlab (keys %same_host_as_Master) {
next if $passlab eq "__Master_${$}__";
push @passlabels, $passlab;
$local_host_flag=1;
}
if (!$local_host_flag) {
$passlabels[0]=$Net::FullAuto::FA_Core::local_hostname;
$local_host_flag=1;
}
} else {
$passlabels[0]=$passlabel;
}
foreach my $passlabel (@passlabels) {
my $key='';
if ($local_host_flag) {
$key="${username}_X_${passlabel}_X_${$}_X_$invoked[0]";
} elsif ($cmd_type) {
$key="${username}_X_${login_id}_X_${passlabel}_X_${cmd_type}";
} else {
$key="${username}_X_${login_id}_X_${passlabel}";
}
print $Net::FullAuto::FA_Core::MRLOG "SCRUBBINGTHISKEY=$key<==\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $kind='prod';
$kind='test' if $Net::FullAuto::FA_Core::test && !$Net::FullAuto::FA_Core::prod;
return unless exists $Hosts{"__Master_${$}__"}{'FA_Secure'};
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Passwds',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n",'',$track);
print $Net::FullAuto::FA_Core::MRLOG "PAST THE DBENV INITIALIZATION<==\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${Net::FullAuto::FA_Core::progname}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n",'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
my $href='';
my $status=$bdb->db_get($passlabel,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $flag=0;my $successflag=0;
foreach my $ky (keys %{$href}) {
if ($ky eq $key) {
while (delete $href->{$key}) {}
$successflag=1;$flag=1;
} elsif ($ky=~/_X_\d+_X_(\d+)$/ && $1+604800<$invoked[0]) {
while (delete $href->{$ky}) {}
$flag=1
}
}
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($passlabel,$put_href);
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
return $successflag;
}
}
1;
package File_Transfer;
use Time::Local;
use BerkeleyDB;
sub new {
my @topcaller=caller;
print "\nINFO: File_Transfer::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nFile_Transfer::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
our $timeout=$Net::FullAuto::FA_Core::timeout;
our $test=$Net::FullAuto::FA_Core::test;
my $class = ref($_[0]) || $_[0];
my $hostlabel=$_[1];
my $new_master=$_[2]||'';
my $_connect=$_[3]||'';
my $self = { };
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my $host=($use eq 'ip') ? $ip : $hostname;
my $chk_id='';
if ($su_id) { $chk_id=$su_id }
elsif ($login_id) { $chk_id=$login_id }
else { $chk_id=$Net::FullAuto::FA_Core::username }
if (!$new_master &&
exists $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"}) {
if ($ping) {
if (&Net::FullAuto::FA_Core::ping($host,'__return__')) {
return $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"},'';
} else {
delete $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"};
}
} else {
return $Net::FullAuto::FA_Core::Connections{
"${hostlabel}__%-$chk_id"},'';
}
}
my ($ftp_handle,$ftp_pid,$work_dirs,$ftr_cmd,$ftm_type,
$cmd_type,$smb,$fpx_handle,$fpx_pid,$stderr)=
ftm_login($hostlabel,$new_master,$_connect);
if ($stderr) {
$stderr=~s/(at .*)$/\n\n $1/s;
my $die="\n FATAL ERROR! - $stderr";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $ftp_handle,$die;
}
if ($smb) {
$self->{_hostlabel}=[ $hostlabel,
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0] ];
$self->{_smb}=1;
} else {
$self->{_hostlabel}=[ $hostlabel,'' ];
}
if ($ftr_cmd) {
$self->{_cmd_handle}=$ftr_cmd->{_cmd_handle};
$self->{_sh_pid}=$ftr_cmd->{_sh_pid};
$self->{_cmd_pid}=$ftr_cmd->{_cmd_pid};
$self->{_uname}=$ftr_cmd->{_uname};
$self->{_luname}=$ftr_cmd->{_luname};
$self->{_cmd_type}=$cmd_type;
if ($ftr_cmd->{_cygdrive}) {
$self->{_cygdrive}=$ftr_cmd->{_cygdrive};
$self->{_cygdrive_regex}=$ftr_cmd->{_cygdrive_regex};
}
} else {
$self->{_uname}=$uname;
$self->{_luname}=$^O;
if (-1==$#{$cmd_cnct}) {
$self->{_cmd_handle}=$ftp_handle;
$self->{_cmd_type}=$ftm_type;
} else {
$self->{_cmd_handle}='';
$self->{_cmd_type}='';
}
}
$self->{_ftp_handle}=$ftp_handle;
$self->{_fpx_handle}=$fpx_handle
if $self->{_fpx_handle};
$self->{_hostname}=$hostname;
$self->{_ip}=$ip;
$self->{_connect}=$_connect;
$self->{_ftm_type}=$ftm_type;
$self->{_work_dirs}=$work_dirs;
$self->{_ftp_pid}=$ftp_pid if $ftp_pid;
$self->{_fpx_pid}=$fpx_pid if $fpx_pid;
bless($self,$class);
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$chk_id"}=$self;
return $self,'';
}
sub handle_error
{
my @topcaller=caller;
print "File_Transfer::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::handle_error() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return &Net::FullAuto::FA_Core::handle_error(@_);
}
sub close
{
my $self=$_[0];
if (exists $self->{_ftp_handle} &&
defined fileno $self->{_ftp_handle}) {
my $ftp_handle=$self->{_ftp_handle};
my $count=0;
eval {
SC: while (defined fileno $self->{_ftp_handle}) {
$self->{_ftp_handle}->print("\004");
while (my $line=$self->{_ftp_handle}->get) {
last if $line=~/_funkyPrompt_$|
Connection.*closed|logout|221\sGoodbye/sx;
if ($line=~/^\s*$/s) {
last SC if $count++==20;
} else { $count=0 }
$self->{_ftp_handle}->print("\004");
}
}
};
eval { $self->{_ftp_handle}->close };
my $kill_arg=($^O eq 'cygwin')?'f':9;
my ($stdout,$stderr)=('','');
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$self->{_ftp_pid},$kill_arg)
if &Net::FullAuto::FA_Core::testpid($self->{_ftp_pid});
foreach my $h_id (keys %Net::FullAuto::FA_Core::Connections) {
if ($self eq $Net::FullAuto::FA_Core::Connections{$h_id}) {
delete $Net::FullAuto::FA_Core::Connections{$h_id};
last;
}
}
}
}
sub get_vlabel
{
print "GET_VLABEL_CALLER=",caller,"\n";<STDIN>;
my ($self,$deploy_type,$dest_hostlabel,
$base_hostlabel,$archivedir) = @_;
my ($archive_hostlabel,$version_label,$label1,$label2)='';
my @output=();
if ($deploy_type eq 'get') {
$archive_hostlabel=$dest_hostlabel;
} else {
$archive_hostlabel=$base_hostlabel;
}
while ($Net::FullAuto::FA_Core::version_label eq '') {
print $Net::FullAuto::FA_Core::blanklines;
print "\n\n Please Type the Version Number of the\n";
print " Build being Deployed TO Host \"$dest_hostlabel\"\n";
print " FROM Host \"$base_hostlabel\" : ";
$label1=<STDIN>;chomp($label1);
next if $label1 eq '';
if ($label1 ne uc($label1)) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n\n ERROR! - Use Only Upper Case Letters for Version Labels!";
next;
}
print "\n Please Re-Enter the Version Number : ";
$label2=<STDIN>;chomp($label2);
if ($label1 eq "") {
print $Net::FullAuto::FA_Core::blanklines;
next;
}
if ($label1 eq $label2) {
if (($deploy_type eq 'get' || ($deploy_type eq 'put' &&
($dest_hostlabel ne "__Master_${$}__" &&
$base_hostlabel ne "__Master_${$}__")))
&& $archivedir) {
my $chmod='';my $own='';my $grp='';
my %settings=();
if (($archive_hostlabel eq "__Master_${$}__"
&& $Net::FullAuto::FA_Core::local_hostname eq substr(
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'HostName'},
0,index
$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'HostName'},
'.')) || $deploy_type eq 'put') {
if (defined $archivedir && $archivedir ne '') {
if (-1<index $archivedir,'__VLABEL__') {
$archivedir=~s/__VLABEL__/$label1/g;
}
if (-d "$archivedir") {
if (-f "$archivedir/mving.flg") {
$version_label=$label1;last;
} else {
my $target=$archive_hostlabel;
my $die="\n\nFATAL ERROR!!!\n\nThis Version "
."- $label1 - already exists on $target"
."!\n\nIf this is the right Version, "
."move or delete the\ndirectory on $target "
."before running this script\n\n";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
}
} elsif ($^O ne 'cygwin' && $^O ne 'MSWin32' && $^O ne 'MSWin64'
&& $ENV{OS} ne 'Windows_NT') {
#### DO ERROR TRAPPING!!!!!!!!!!!!
print "MKDIR1=$archivedir\n";
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"mkdir \'/$archivedir\'");
my $chmod=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Chmod'};
my $own=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Owner'};
my $grp=$Net::FullAuto::FA_Core::Hosts{"__Master_${$}__"}{'Group'};
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chmod \"$chmod\" \'/$archivedir\'")
if $chmod;
@output=$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chown \"$own\" \'/$archivedir\'")
if $own;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chgrp \"$grp\" \'/$archivedir\'")
if $grp;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"touch \"/$archivedir/mving.flg\"");
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chmod \"$chmod\" \"/$archivedir/mving.flg\"")
if $chmod;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chown \"$own\" \"/$archivedir/mving.flg\"")
if $own;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"chgrp \"$grp\" \"/$archivedir/mving.flg\"")
if $grp;
$version_label=$label1;last;
} elsif ($^O eq 'cygwin' || $^O eq 'MSWin32' || $^O eq 'MSWin64'
|| $ENV{OS} eq 'Windows_NT') {
print "DO MORE WORK ON MSWIN!\n";<STDIN>;
$Net::FullAuto::FA_Core::localhost->{_cmd_handle}->SUPER::cmd(
"mkdir $label1");
$version_label=$label1;last;
}
}
} else { $version_label=$label1;last }
} else { $version_label=$label1;last }
} else {
print $Net::FullAuto::FA_Core::blanklines;
print "\n\n Version Numbers Do NOT Match!";
}
} print "\n\n";
$Net::FullAuto::FA_Core::version_label=$version_label;
return $version_label;
}
sub select_dir
{
#print "SELECT_DIRCALLER=",caller,"\n";
my $self=$_[0];
my $dir='.';my $random=0;
my $dots=0;my $dot=0;my $dotdot=0;
if (defined $_[1] && $_[1]) {
if ($_[1] eq '__random__') {
$random=1;
} elsif ($_[1] eq '__dots__') {
$dots=1;
} elsif ($_[1] eq '__dot__') {
$dot=1;
} elsif ($_[1] eq '__dotdot__') {
$dotdot=1;
} else {
$dir=$_[1];
}
}
if (defined $_[2] && $_[2]) {
if ($_[2] eq '__random__') {
$random=1;
} elsif ($_[2] eq '__dots__') {
$dots=1;
} elsif ($_[2] eq '__dot__') {
$dot=1;
} elsif ($_[2] eq '__dotdot__') {
$dotdot=1;
}
}
if (defined $_[3] && $_[3]) {
if ($_[3] eq '__random__') {
$random=1;
} elsif ($_[1] eq '__dots__') {
$dots=1;
} elsif ($_[1] eq '__dot__') {
$dot=1;
} elsif ($_[1] eq '__dotdot__') {
$dotdot=1;
}
}
my $caller=(caller)[2];
my $hostlabel=$self->{_hostlabel}->[0];
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,'');
my $host= ($use eq 'ip') ? $ip : $hostname;
$ms_share||='';my %output=();my $nt5=0;
my $output='';my $stderr='';my $i=0;my @output=();
if ($ms_share || $self->{_uname} eq 'cygwin') {
my $test_chr1='';my $test_chr2='';
if ($dir) {
$test_chr1=unpack('a1',$dir);
if (1<length $dir) {
$test_chr2=unpack('a2',$dir);
}
if ($test_chr2) {
if (($test_chr1 eq '/' && $test_chr2 ne '//')
|| ($test_chr1 eq '\\' &&
$test_chr2 ne '\\\\')) {
if ($dir=~s/^$self->{_cygdrive_regex}//) {
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
$dir=~s/\\/\\\\/g;
} elsif ($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') {
$dir=&File_Transfer::get_drive($dir,'Target',
'',$hostlabel);
$dir=~s/^$self->{_cygdrive_regex}//;
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
$dir=~s/\\/\\\\/g;
} else {
$dir=~tr/\//\\/;
$dir="\\\\$host\\$ms_share\\"
. unpack('x1 a*',$dir);
}
} elsif ($test_chr2 eq '//' ||
$test_chr2 eq '\\\\' || $test_chr2=~/^[a-zA-Z]:$/) {
} elsif ($test_chr1!~/\W/) {
if ($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') {
#my $curdir=&attempt_cmd_xtimes($self,
# 'cmd /c chdir',$hostlabel);
my $curdir='';
($curdir,$stderr)=
&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
my $cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w $curdir");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
$dir="$cdr\\$dir";
} else {
$dir="\\\\$host\\$ms_share\\$dir";
}
} else {
&Net::FullAuto::FA_Core::handle_error(
"Target Directory - $dir CANNOT Be Located");
}
} elsif ($test_chr1 eq '/' || $test_chr1 eq '\\') {
if (($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') ||
$self->{_work_dirs}->{_cwd}=~/$self->{_cygdrive_regex}/) {
$dir=&File_Transfer::get_drive('/','Target',
'',$hostlabel);
$dir=~s/^$self->{_cygdrive_regex}//;
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
$dir=~s/\\/\\\\/g;
} else {
$dir="\\\\$host\\$ms_share";
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
$dir=$test_chr1 . ':/';
} else {
&Net::FullAuto::FA_Core::handle_error(
"Target Directory - $dir CANNOT Be Located");
} $dir=~tr/\\/\//;$dir=~tr/\//\\/;$dir=~s/\\/\\\\/g;my $cnt=0;
} else {
if (($hostlabel eq "__Master_${$}__"
&& $^O eq 'cygwin') ||
$self->{_work_dirs}->{_cwd}=~/^$self->{_cygdrive_regex}/) {
$dir=&File_Transfer::get_drive('/','Target','',$hostlabel);
$dir=~s/^$self->{_cygdrive_regex}//;
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
$dir=~s/\\/\\\\/g;
} else {
$dir="\\\\$host\\$ms_share";
}
}
my $cnt=0;
while (1) {
($output,$stderr)=$self->cmd("cmd /c dir /-C \"$dir\"");
if (!$stderr && $output!~/bytes free\s*$/s) {
prin $Net::FullAuto::FA_Core::MRLOG "sub select_dir Rem_Command::cmd() BAD output=$output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
unless ($cnt++) { $output='';next }
my $die="Attempt to retrieve output from the command:\n"
."\n cmd /c dir /-C \"$dir\"\n"
."\n run on the host $self->{_hostlabel}->[0] FAILED"
."\n\n BAD OUTPUT==>$output\n";
&Net::FullAuto::FA_Core::handle_error($die,'-6');
} else { last }
}
if (!$stderr) {
$output=~s/^.*Directory of (.*)$/$1/s;
my $mn=0;my $dy=0;my $yr=0;
my $hr=0;my $mt='';my $pm='';my $size='';
my $file='';my $filetime=0;my $cnt=0;
foreach my $line (split /^/, $output) {
next if $cnt++<4;
next if -1==index $line,'<DIR>';
chomp($line=~tr/\0-\37\177-\377//d);
if (39<length $line) {
if (unpack('x6 a4',$line)=~/^\d\d\d\d$/) {
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x3 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,"$line");
$nt5=1;
} else {
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x1 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,"$line");
}
$filetime=timelocal(
0,$mt,$Net::FullAuto::FA_Core::hours{$hr.$pm},$dy,$mn-1,$yr);
} push @{$output{$filetime}},
{$file=>"$mn/$dy/$yr $hr:$mt$pm"};
}
foreach my $filetime (reverse sort keys %output) {
foreach my $filehash (@{$output{$filetime}}) {
foreach my $file (reverse sort keys %{$filehash}) {
push @output,${$filehash}{$file}." $file";
}
}
}
}
} else {
($output,$stderr)=$self->cmd("ls -lt $dir");
if (!$stderr) {
my $lchar_flag=0;
foreach my $line (split /\n/, $output) {
next if unpack('a5',$line) eq 'total';
my $lchar=substr($line,-1);
if ($lchar eq '*' || $lchar eq '/' || $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$lchar_flag=1;
}
chop $line;
}
my $endofline=substr($line,-2);
if ($endofline eq '..' && !$dots && !$dotdot) { next }
if ($endofline eq ' .' && !$dots && !$dot) { next }
my $date=substr($line,41,13);
my $file=unpack('x54 a*',$line);
push @output,"$date $file";
}
}
} my $die='';
if ($stderr) {
my $caller=(caller(1))[3];
substr($caller,0,(index $caller,'::')+2)='';
my $sub='';
if ($caller eq 'connect_ftp'
|| $caller eq 'connect_telnet') {
($caller,$sub)=split '::', (caller(2))[3];
$caller.='.pm';
} else {
my @called=caller(2);
if ($caller eq 'mirror' || $caller eq 'login_retry') {
$sub=$called[3]
} else {
$caller=$called[3];
$called[6]||='';
$sub=($called[6])?$called[6]:$called[3];
} $sub=~s/\s*\;\n*//
}
my $mod='';($mod,$sub)=split '::', $sub;
$stderr=~s/\sat\s${progname}\s/\n at ${progname} /;
$die="Cannot change to directory:\n\n"
." \"$dir\"\n\n in the \"&select_dir()\" "
."Subroutine (or Method)\n Called from the "
."User Defined Subroutine\n -> $sub\n "
."in the \"subs\" Subroutine File -> "."${mod}.pm\n\n"
." The Remote System $host Returned\n "
."the Following Error Message:\n\n $stderr";
} elsif ($random) {
$output=$output[rand $#output];
chomp $output;
if ($ms_share) {
if ($nt5) {
substr($output,0,19)="";
} else {
substr($output,0,21)="";
}
} else { substr($output,0,16)="" }
$output=~s/\s*$//;
} else {
my $banner="\n Please Pick a Directory :";
$output=&Menus::pick(\@output,$banner);
chomp $output;
if ($output ne ']quit[') {
if ($ms_share) {
if ($nt5) {
substr($output,0,19)="";
} else {
substr($output,0,21)="";
}
} else { substr($output,0,16)="" }
} else { &Net::FullAuto::FA_Core::cleanup() }
$output=~s/\s*$//;
}
if (wantarray) {
return $output,$die;
} elsif ($stderr) {
&Net::FullAuto::FA_Core::handle_error($die);
} else { return $output }
}
sub testfile
{
#print "TESTFILE_CALLER=",caller,"\n";
my ($self, @args) = @_;
my @output=();
my $output="";
eval {
$output=$self->cmd("ls -l @args");
print "OBJECT=$output\n";<STDIN>;
}
}
sub testdir
{
print "TESTDIR_CALLER=",caller,"\n";
my ($self, @args) = @_;
my @output=();
my $output="";
#eval {
}
sub ftp
{
my @topcaller=caller;
print "File_Transfer::ftp() CALLER=",
(join ' ',@topcaller),"\n";# if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::ftp() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($host1,$host2,$ftpcmd) = @_;
$ftpcmd=~s/^\s*//;
my $output='';my $stderr='';
my $gpcmd='';
$gpcmd=unpack('a3',$ftpcmd) if 2<length $ftpcmd;
eval {
if ($host2) {
if ($gpcmd eq 'get') {
($output,$stderr)=Rem_Command::cmd(
$host2,$ftpcmd,'__ftp__');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($output,$stderr)=Rem_Command::cmd(
$host1,$ftpcmd,'__ftp__');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} elsif ($host2 && $gpcmd eq 'put') {
($output,$stderr)=Rem_Command::cmd(
$host1,$ftpcmd,'__ftp__');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($output,$stderr)=Rem_Command::cmd(
$host2,$ftpcmd,'__ftp__');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
} else {
$ftpcmd=~s/\\/\\\\/g if -1==index $ftpcmd,'\\\\';
($output,$stderr)=Rem_Command::cmd(
$host1,$ftpcmd,'__ftp__');
my $die='';
if ($host1->{_hostlabel}->[1]) {
$die="\n FATAL ERROR! - The System "
."\"$host1->{_hostlabel}->[1]\" "
."Acting as an\n MSWin Proxy for "
."the System \"$host1->{_hostlabel}->[0]\" Returned "
."\n the Following Unrecoverable Error "
."Condition:\n\n ";
} else {
$die="\n FATAL ERROR! - The System "
."\"$host1->{_hostlabel}->[0]\" Returned "
."\n the Following Unrecoverable Error "
."Condition:\n\n ";
}
if ($output eq 'Not connected') {
$die.="$output\n ";
return '',$die;
} elsif ((-1<index($stderr,'530 '))
|| (-1<index($stderr,'421 ')
&& -1==index($stderr,'onnect'))
|| (-1<index($stderr,'425 ')
&& -1==index($stderr,'not avail'))) {
$die.="$stderr\n ";
return '',$die;
} elsif (-1<index($output,'No such file or directory')) {
$die.="$output\n\n From ftp CMD: $ftpcmd\n\n ";
&Net::FullAuto::FA_Core::handle_error($die,'-26');
} $die.="$stderr\n ";
&Net::FullAuto::FA_Core::handle_error($die,'-28') if $stderr;
}
};
$stderr=$@ if $@;
if (wantarray) {
return $output,$stderr;
} else { return $output }
}
sub cmd
{
my @topcaller=caller;
print "\nINFO: File_Transfer::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nFile_Transfer::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self='';my $command='';my @arg=();
($self,@arg) = @_;
$command=$arg[0];
my @output=();my $cmdlin=0;
my $output='';my $stderr='';
eval {
if (ref $self eq 'File_Transfer' && (!exists $self->{_cmd_handle}
|| $self->{_cmd_handle} ne "__Master_${$}__")) {
if ($self->{_cmd_type} eq 'telnet' ||
$self->{_cmd_type} eq 'ssh' ||
($^O eq 'cygwin' &&
exists $self->{_smb})) {
$cmdlin=29;
($output,$stderr)=Rem_Command::cmd($self,@arg);
} elsif ($self->{_ftm_type} eq 'ftp' ||
$self->{_ftm_type} eq 'sftp') {
($output,$stderr)=&Rem_Command::ftpcmd($self,$command);
$cmdlin=26;
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_cmd_type} .
" protocol not supported for command interface: ");
}
} else {
$cmdlin=9;
($output,$stderr)=&Net::FullAuto::FA_Core::cmd($command);
}
};
if ($@) {
print "$self->{_cmd_type} CMD ERROR! - $@\n";exit;
}
if (wantarray) {
return $output,$stderr;
} elsif ($stderr) {
&Net::FullAuto::FA_Core::handle_error($stderr,-$cmdlin) if $stderr;
} else { return $output }
}
sub ls
{
my @topcaller=caller;
print "File_Transfer::ls() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::ls() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($self, $options, $path) = @_;
$path='' unless defined $path;
$options='' unless defined $options;
my $output='';my $stderr='';
if ($path && unpack('a1',$path) eq '"') {
$path=unpack('a1 a*',$path);
substr($path,-1)='';
}
if ($path) {
($output,$stderr)=&Rem_Command::ftpcmd($self,"ls \"$path\"");
} else {
($output,$stderr)=&Rem_Command::ftpcmd($self,'ls');
}
my $newout='';
if ($options eq '1' || $options eq '-1') {
foreach my $line (split /^/, $output) {
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;
if ($line=~s/^.*\s+($rx1|$rx2)$/$1/) {
$line=~
s/^\d+\s+\w\w\w\s+\d+\s+(?:\d\d:\d\d\s+|\d\d\d\d\s+)+(.*)$/$1/;
$newout.=$line;
}
} $output=$newout if $newout;
}
return '',$stderr if $stderr;
chomp($output=~tr/\0-\11\13-\37\177-\377//d);$output=~s/^\s+//;
return $output,'';
}
sub lcd
{
my @topcaller=caller;
print "File_Transfer::lcd() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::lcd() CALLER=",
(join ' ',@topcaller),
"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($self, $path) = @_;
my $output='';my $stderr='';
if (unpack('a1',$path) eq '"') {
$path=unpack('a1 a*',$path);
substr($path,-1)='';
}
$self->{_work_dirs}->{_pre_lcd}=$self->{_work_dirs}->{_lcd};
$path=~s/\\/\\\\/g;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::lcd() PATH=$path<==\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($output,$stderr)=&Rem_Command::ftpcmd($self,"lcd \"$path\"");
$self->{_work_dirs}->{_lcd}=$path;
return '',$stderr if $stderr;
return $output,'';
}
sub get
{
my @topcaller=caller;
print "File_Transfer::get() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::get() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($self, @args) = @_;
my $output='';my $stderr='';
my $path='';my $file='';
foreach my $file_arg (@args) {
if ($self->{_ftp_handle} ne "__Master_${$}__") {
if ($self->{_ftm_type} eq 'ftp') {
if (-1<index $file_arg,'/') {
$path=substr($file_arg,0,(rindex $file_arg,'/'));
$file=substr($file_arg,(rindex $file_arg,'/')+1);
#($output,$stderr)=ftp($self,'',"cd \"$path\"");
($output,$stderr)=&Rem_Command::ftpcmd($self,"cd \"$path\"");
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
}
} elsif (-1<index $file_arg,'\\') {
$path=substr($file_arg,0,(rindex $file_arg,'\\'));
$file=substr($file_arg,(rindex $file_arg,'\\')+1);
($output,$stderr)=&Rem_Command::ftpcmd($self,"cd \"$path\"");
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
}
} else { $file=$file_arg }
} else { $file=$file_arg }
unless (&Net::FullAuto::FA_Core::acquire_semaphore($file_arg,,1)) {
return 'SEMAPHORE','' if wantarray;
return 'SEMAPHORE';
}
($output,$stderr)=&Rem_Command::ftpcmd($self,"get \"$file\"");
&Net::FullAuto::FA_Core::release_semaphore($file_arg);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
}
} elsif (wantarray) {
return '',
"YOU ARE TRYING TO FTP GET FILE TO THE SAME BOX :\n ".($!);
} else {
&Net::FullAuto::FA_Core::handle_error(
"YOU ARE TRYING TO FTP GET FILE TO THE SAME BOX :\n ".($!));
}
} return $output,'' if wantarray;
return $output;
}
sub put
{
my @topcaller=caller;
print "File_Transfer::put() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::put() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($self, @args) = @_;
my ($output,$stderr)='';
foreach my $file (@args) {
if ($self->{_ftp_handle} ne "__Master_${$}__") {
#print "FILEARGGGINT=",int $file,"\n";<STDIN>;
#return 'SEMAPHORE' if &Net::FullAuto::FA_Core::acquire_semaphore('',$file,,1);
($output,$stderr)=&Rem_Command::ftpcmd($self,"put $file");
&Net::FullAuto::FA_Core::release_semaphore($file);
if ($stderr) {
print "ERROR! - $stderr\n";
}
} else {
print "YOU ARE TRYING TO FTP PUT FILE TO THE SAME BOX\n$!";
}
}
}
sub size
{
my @topcaller=caller;
print "File_Transfer::size() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::size() CALLER=",
(join ' ',@topcaller),
"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($self, @args) = @_;
my ($output,$stderr)='';
foreach my $file (@args) {
if ($self->{_ftp_handle} ne "__Master_${$}__") {
($output,$stderr)=&Rem_Command::ftpcmd($self,"get $file");
} else {
$output=(stat("$file"))[7] || ($stderr=
"cannot stat and obtain file size for $file\n $!");
}
if ($stderr) {
print "ERROR! - $stderr\n";
}
}
}
sub ftr_cmd
{
my @topcaller=caller;
print "File_Transfer::ftr_cmd() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::ftr_cmd() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $hostlabel=$_[0];
my $ftp_handle=$_[1];
my $new_master=$_[2]||'';
my $_connect=$_[3]||'';
our @rcm_map=();our $track='';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$frtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)=('','','','','','','','','',
'','','','','','','','','');
($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$frtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,$_connect);
my $host= ($use eq 'ip') ? $ip : $hostname;
$ms_share='' unless defined $ms_share;
$ms_domain='' unless defined $ms_domain;
$login_id=$Net::FullAuto::FA_Core::username if !defined $su_id;
my $work_dirs={};my $ftr_cmd='';my $ms_su_id='';my $ms_login_id='';
my $ms_hostlabel='';my $ms_host='';my $ms_ms_share='';
my $local_transfer_dir='';my $cmd_type='';my $ms_ms_domain='';
my $output='';my $stderr='';my $ms_transfer_dir='';my $smb=0;
my @output=();my $cw1='';my $cw2='';my $ftm_type='';
foreach my $cnct (@{$cmd_cnct}) {
$cmd_type=lc($cnct);
if (!exists $Net::FullAuto::FA_Core::fa_maps{"localhost=->$hostlabel"}{'rcm'}
&& ($cmd_type eq 'telnet' || $cmd_type eq 'ssh')) {
#${$ftr_cnct}[0] eq 'smb')) {
#($cmd_type eq 'tn_proxy' || $cmd_type eq 'ssh' && exists
#$Net::FullAuto::FA_Core::same_host_as_Master{"$Net::FullAuto::FA_Core::DeployRCM_Proxy[0]"})) {
($ftr_cmd,$stderr)=
Rem_Command::new('Rem_Command',$hostlabel,
$new_master,$_connect);
if ($stderr) {
chomp $stderr;
return '','','','',$stderr;
}
$cmd_type=$ftr_cmd->{_cmd_type};
$ftr_cmd->{_ftp_handle}=$ftp_handle;
if (defined $transfer_dir && $transfer_dir) {
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftr_cmd,$cmd_type,'',$_connect);
my $curdir='';
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($ftr_cmd,'pwd');
&handle_error($stderr,'-1') if $stderr;
my $cdr='';
if (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$ftr_cmd,"cygpath -w $curdir");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$curdir}=$cdr;
}
${$work_dirs}{_pre_mswin}=$cdr.'\\\\';
$ftr_cmd->{_cygdrive}||='/';
${$work_dirs}{_pre}=$curdir;
($output,$stderr)=$ftr_cmd->cmd('cd '.${$work_dirs}{_tmp});
if ($stderr) {
@FA_Core::tran=();
my $die="Cannot cd to TransferDir -> ".${$work_dirs}{_tmp}
."\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die,'-5');
}
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
$output=join '',
$ftr_cmd->{_ftp_handle}->cmd('cd '.$work_dirs->{_tmp});
if ($output=~/^(5.*)$/m) {
my $line=$1;
chomp($line=~tr/\0-\37\177-\377//d);
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $line";
&Net::FullAuto::FA_Core::handle_error($die,'-7');
}
$work_dirs->{_cwd}=$work_dirs->{_tmp};
$work_dirs->{_cwd_mswin}=$work_dirs->{_tmp_mswin};
$Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;
$Net::FullAuto::FA_Core::ftpcwd{$ftr_cmd->{_ftp_handle}}{cd}
=${$work_dirs}{_tmp};
} elsif (${$ftr_cnct}[0] eq 'smb' && defined
$Net::FullAuto::FA_Core::Hosts{
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}
{'TransferDir'} &&
$Net::FullAuto::FA_Core::Hosts{
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}
{'TransferDir'}) {
my $transfer_dir=$Net::FullAuto::FA_Core::Hosts{
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}
{'TransferDir'};
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftr_cmd,$cmd_type,'',$_connect);
$work_dirs->{_pre}=$work_dirs->{_cwd}='';
$work_dirs->{_pre_mswin}=$work_dirs->{_cwd_mswin}=
"\\\\$host\\$ms_share\\";
($output,$stderr)=$ftr_cmd->cmd('cd '.$work_dirs->{_tmp});
if ($stderr) {
@FA_Core::tran=();
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die,'-5');
}
$output=join '',
$ftr_cmd->{_ftp_handle}->cmd('cd '.$work_dirs->{_tmp});
if ($output=~/^(5.*)$/m) {
my $line=$1;
chomp($line=~tr/\0-\37\177-\377//d);
my $die="Cannot cd to TransferDir -> ".$work_dirs->{_tmp}
."\n $line";
&Net::FullAuto::FA_Core::handle_error($die,'-7');
} $Net::FullAuto::FA_Core::tran[0]=$work_dirs->{_tmp};
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;
$Net::FullAuto::FA_Core::ftpcwd{$ftr_cmd->{_ftp_handle}}{cd}=
$work_dirs->{_tmp};
$smb=1;
} else {
my $curdir='';
if ($ftr_cmd->{_uname} eq 'cygwin') {
($curdir,$stderr)=&Net::FullAuto::FA_Core::cmd($localhost,'pwd');
&handle_error($stderr,'-1') if $stderr;
if ($^O eq 'cygwin') {
my $cdr='';
if (exists $localhost->{_cygdrive} &&
-1<index $curdir,$localhost->{_cygdrive}) {
my $l_cd=(length $localhost->{_cygdrive})+1;
my $cdr=unpack("x$l_cd a*",$curdir);
substr($cdr,1,0)=':';
$cdr=ucfirst($cdr);
$cdr=~s/\//\\\\/g;
} elsif (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=&Net::FullAuto::FA_Core::cmd(
$localhost,"cygpath -w $curdir");
&handle_error($stderr,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
}
$work_dirs->{_pre_mswin}=
$work_dirs->{_cwd_mswin}=$cdr.'\\\\';
$work_dirs->{_tmp_mswin}=
$ftr_cmd->{_work_dirs}->{_tmp_mswin};
}
$work_dirs->{_pre}=$work_dirs->{_cwd}=$curdir;
$work_dirs->{_tmp}=$ftr_cmd->{_work_dirs}->{_tmp};
} else {
my $cnt=3;
while ($cnt--) {
($curdir,$stderr)=$ftr_cmd->cmd('pwd');
if (!$curdir) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
} else {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftr_cmd->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
last
}
}
$curdir.='/' if $curdir ne '/';
$work_dirs->{_pre}=$work_dirs->{_cwd}=$curdir;
$work_dirs->{_tmp}=$ftr_cmd->{_work_dirs}->{_tmp};
}
} return $work_dirs,$ftr_cmd,$cmd_type,$ftm_type,'' if $ftr_cmd;
} elsif ($rcm_chain) {
if ($rcm_map && ref $rcm_map ne 'ARRAY') {
$rcm_map=[$rcm_map];
} else { $rcm_map=[] }
sub recurse_chain {
print "RECURSECALLER=",caller," and ZERO=$_[0]\n";<STDIN>;
print "ZERO=",join ' ',@{$_[0]}," and ONE=$_[1] and TWO=$_[2] and TEE=$_[3]\n";<STDIN>;
my @rcm_chain=@{$_[0]};
my $ftr_cmd = defined $_[1] ? $_[1] : '';;
my $hostlabel=$_[2];
my $new_master=$_[3];
my $_connect=$_[4];
my $host_label=$hostlabel;
my $rcm_chain_link_num=-1;
if (-1<$#rcm_chain) {
$rcm_chain_link_num=shift @rcm_chain;
$host_label=
$Net::FullAuto::FA_Core::DeployRCM_Proxy[$rcm_chain_link_num];
} elsif (!$ftr_cmd) {
if (defined $Net::FullAuto::FA_Core::DeployRCM_Proxy[0]
&& $Net::FullAuto::FA_Core::DeployRCM_Proxy[0]) {
$rcm_chain_link_num=0;
$host_label=$Net::FullAuto::FA_Core::DeployRCM_Proxy[0];
} else {
my $die="\n FATAL ERROR - No \"RCM_Proxy\" has "
."been Properly\n Defined in the "
."\"$Net::FullAuto::FA_Core::fa_host\" File.\n"
." This "
."Element must Appear in at least\n "
." One Block with the Syntax:\n "
." RCM_Proxy => \'<hostlabel>\'\, "
."Option - ChainLink Number\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
}
}
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$frtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$host_label,$_connect);
my $host= ($use eq 'ip') ? $ip : $hostname;
#print "IP=$ip and HOSTNAME=$hostname and HOST=$host\n";
if (!$login_id) {
if ($host eq
"$Net::FullAuto::FA_Core::Hosts{\"__Master_${$}__\"}{'HostName'}") {
print "FTR_RETURN2\n";
return Rem_Command::new('Rem_Command',$hostlabel,
$new_master,$_connect);
} elsif ($host eq
"$Net::FullAuto::FA_Core::Hosts{\"__Master_${$}__\"}{'IP'}") {
print "FTR_RETURN3\n";
return Rem_Command::new('Rem_Command',$ip,
$new_master,$_connect);
} else {
$login_id=$Net::FullAuto::FA_Core::username;
}
} my $ftr_cmd_error='';my $su_scrub='';my $retrys='';
if ($ftr_cmd) {
#print "GOING TO TRY LOGIN=$login_id and IP=$ip and FTR_CMD=$ftr_cmd\n";
$ftr_cmd->{_cmd_handle}->print("telnet $host");
#print "GOING TO LOG IN TO $hostname - USERNAME=$login_id\n";<STDIN>;
my ($alloutput,$output,$cygwin)='';
while (my $line=$ftr_cmd->{_cmd_handle}->get) {
if (-1<index $line,'CYGWIN') {
if ($su_id) {
if ($su_id ne $login_id) {
$login_id=$su_id;$cygwin=1;
} else { $su_id='' }
}
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}=
'cygwin';
} elsif (-1<index $line,'AIX') {
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}='aix';
}
last if $line=~
/(?<!Last )login[: ]*$|username[: ]*$/i;
}
while (1) {
eval {
$ftr_cmd->{_cmd_handle}->print($login_id);
## Wait for password prompt.
while (my $line=$ftr_cmd->{_cmd_handle}->get) {
last if $line=~/password[: ]*$/i;
}
## Send password.
my $recurse_passwd=
&Net::FullAuto::FA_Core::getpasswd($hostlabel,
$login_id,'',$ftr_cmd_error);
$ftr_cmd->{_cmd_handle}->print($recurse_passwd);
my $alloutput='';my $output='';my $stderr='';
my $cygwin='';my $newpw='';
while (my $line=$ftr_cmd->{_cmd_handle}->get) {
($output=$line)=~s/login:.*//s;
&Net::FullAuto::FA_Core::handle_error($output)
if $line=~/(?<!Last )login[: ]*$/m;
if ($line=~/new password: ?$/is) {
$newpw=$line;last;
} last if $line=~/[$|%|>|#|-|:] ?$/s;
}
&Net::FullAuto::FA_Core::change_pw($ftr_cmd) if $newpw;
if ($su_scrub) {
my $kind='prod';
my $mr="__Master_${$}__";
$kind='test' if $Net::FullAuto::FA_Core::test
&& !$Net::FullAuto::FA_Core::prod;
my $dbpath=$Net::FullAuto::FA_Core::Hosts{$mr}
{'FA_Secure'}.
${Net::FullAuto::FA_Core::progname}.
"_${kind}_passwds.db";
print "DBPATHHHH=$dbpath<==\n";
unless (-d $Hosts{$mr}{'FA_Secure'}.'Passwds') {
File::Path::make_path($Hosts{$mr}{'FA_Secure'}.
'Passwds');
}
my $dbenv = BerkeleyDB::Env->new(
-Home =>
$Net::FullAuto::FA_Core::Hosts{$mr}{'FA_Secure'}.
'Passwds',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: ".
"$BerkeleyDB::Error\n",'',$track);
&acquire_semaphore(9361,
"BDB DB Access: ".__LINE__);
my $pn=$Net::FullAuto::FA_Core::progname;
my $bdb = BerkeleyDB::Btree->new(
-Filename => "${pn}_${kind}_passwds.db",
-Flags => DB_CREATE,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
$bdb = BerkeleyDB::Btree->new(
-Filename =>
"${pn}_${kind}_passwds.db",
-Flags => DB_CREATE|DB_RECOVER_FATAL,
-Env => $dbenv
);
unless ($BerkeleyDB::Error=~/Successful/) {
die "Cannot Open DB: ".
"${pn}_${kind}_passwds.db".
" $BerkeleyDB::Error\n";
}
}
&handle_error(
"cannot open Btree for DB: ".
"$BerkeleyDB::Error\n",'__cleanup__',$track)
unless $BerkeleyDB::Error=~/Successful/;
my $href='';
my $status=$bdb->db_get($host,$href);
$href=~s/\$HASH\d*\s*=\s*//s;
$href=eval $href;
my $key="${Net::FullAuto::FA_Core::username}_X_"
."${Net::FullAuto::FA_Core::username}_X_${host}";
while (delete $href->{$key}) {}
my $cipher='';
#my $mr="__Master_${$}__";
if ($Hosts{"__Master_${$}__"}{'Cipher'}=~/DES/) {
if (8<length
$Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0])) {
$cipher = new Crypt::CBC(unpack('a8',
$Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0])),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
} else {
$cipher = new Crypt::CBC(
$Net::FullAuto::FA_Core::dcipher->decrypt(
$passetts->[0]),
$Net::FullAuto::FA_Core::Hosts{$mr}{'Cipher'});
}
my $new_encrypted=$cipher->encrypt(
$recurse_passwd);
$href->{$key}=$new_encrypted;
my $put_href=Data::Dump::Streamer::Dump($href)->Out();
$status=$bdb->db_put($host,$put_href);
undef $bdb;
$dbenv->close();
undef $dbenv;
&release_semaphore(9361);
}
$ftr_cmd->{_cmd_handle}->cmd(
"export PS1='_funkyPrompt_';unset PROMPT_COMMAND");
$ftr_cmd->{_cmd_handle}->prompt("/_funkyPrompt_\$/");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftr_cmd);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my ($ignore,$su_err)=
&Net::FullAuto::FA_Core::su($ftr_cmd->{_cmd_handle},
$host_label,
$Net::FullAuto::FA_Core::username,$su_id,$hostname,
$ip,$use,$ftr_cmd->{_uname},$ftr_cmd->{_connect},
$ftr_cmd->{_cmd_type},[],$ftr_cmd_error)
if !$cygwin;
&Net::FullAuto::FA_Core::handle_error($su_err) if $su_err;
};
if ($@) {
$ftr_cmd_error=$@;
print "FTR_CMD_ERROR=$ftr_cmd_error\n";<STDIN>;
$ftr_cmd_error=~s/^[\012|\015]*//s;
if ($ftr_cmd_error=~/invalid log|ogin incor/) {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$Net::FullAuto::FA_Core::username);
if ($^O eq 'cygwin' && $retrys==2) {
$ftr_cmd_error.="\nWARNING! - You may be in Danger"
." of locking out MS Domain ID - "
."$Net::FullAuto::FA_Core::username!"
."\n\n";
}
next;
} elsif ($su_id &&
-1<index($ftr_cmd_error,'ation is d')) {
print "GOOD - SCRUBBING\n";
$su_scrub=
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$su_id);
next;
}
my $c_t=$ftr_cmd->{_cmd_type};$c_t=~s/^(.)/uc($1)/e;
my $die="The System $host Returned\n "
." the Following Unrecoverable"
." Error Condition\,\n "
."Rejecting the $c_t Login Attempt"
." of the ID\n -> "
."$login_id at ".(caller(0))[1]." line "
.(caller(0))[2]." :\n\n "
."$ftr_cmd_error\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($die);
} last;
}
$ftr_cmd->{_cmd_handle}->cmd(
"export PS1='_funkyPrompt_';unset PROMPT_COMMAND");
$ftr_cmd->{_cmd_handle}->prompt("/_funkyPrompt_\$/");
if ($hostlabel eq $host_label) {
print "FTR_RETURN4\n";
return $ftr_cmd;
} else {
print "FTR_RETURN4\n";
return &recurse_chain(\@rcm_map,$ftr_cmd,
$hostlabel,$_connect);
}
} elsif (&Net::FullAuto::FA_Core::ping($host)) {
$ftr_cmd = Rem_Command::new('Rem_Command',$host_label,
$new_master);
if ($hostlabel eq $host_label) {
print "FTR_RETURN5\n";
return $ftr_cmd;
} else {
print "FTR_RETURN6\n";
return &recurse_chain(\@rcm_map,$ftr_cmd,
$hostlabel,$_connect);
}
}
}
## End of &recurse_chain()
#print "CMD_TYPEBEFORERECURSE=$cmd_type\n";
$ftr_cmd=&recurse_chain($rcm_map,'',$hostlabel,$_connect);
#print "CMD_TYPEAFTERRECURSE=$cmd_type\n";<STDIN>;
#print "RECURSED HOSTNAME=",$ftr_cmd->cmd('hostname'),"\n";
}
}
print "WHAT ARE WE DOING HERE SO THAT THINGS WORK and FTM_TYPE=$ftm_type\n";<STDIN>;
if (!$ftr_cmd && ${$ftr_cnct}[0] eq 'smb' &&
-1<$#FA_Core::DeploySMB_Proxy) {
($ftr_cmd,$stderr)=
Rem_Command::new('Rem_Command',$hostlabel,
$new_master);
if ($stderr) {
chomp $stderr;
print "FTR_RETURN7\n";
return '','','','',$stderr;
}
$cmd_type=$ftr_cmd->{_cmd_type};
$ms_hostlabel=$hostlabel;
$ms_host=$host;
$ms_ms_share=$ms_share;
$ms_ms_domain=$ms_domain;
$ms_login_id=$login_id;
$ms_su_id=$su_id;
$ms_login_id=$su_id if $su_id;
($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$frtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]);
$host=($use eq 'ip') ? $ip : $hostname;
$login_id=$Net::FullAuto::FA_Core::username if !$login_id;
$login_id=$su_id if $su_id;
$hostlabel=$Net::FullAuto::FA_Core::DeploySMB_Proxy[0];
if (defined $transfer_dir && $transfer_dir) {
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftr_cmd,$cmd_type,'',$_connect);
${$work_dirs}{_cwd_mswin}=${$work_dirs}{_pre_mswin}
="\\\\$ms_host\\$ms_ms_share\\";
${$work_dirs}{_cwd}=${$work_dirs}{_pre}='';
my ($output,$stderr)=$ftr_cmd->cmd('cd '.${$work_dirs}{_tmp});
if ($stderr) {
@FA_Core::tran=();
my $die="Cannot cd to TransferDir -> ".${$work_dirs}{_tmp}
."\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die,'-5');
}
($output,$stderr)=&ftpcmd($ftr_cmd,
'cd '.${$work_dirs}{_tmp});#,$hostlabel,$ftm_type);
my $die="Cannot cd to TransferDir -> $transfer_dir"
."\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die,'-2') if $stderr;
$Net::FullAuto::FA_Core::tran[0]=${$work_dirs}{_tmp};
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;
$Net::FullAuto::FA_Core::ftpcwd{$ftr_cmd->{_ftp_handle}}{cd}=${$work_dirs}{_tmp};
} else {
# ADD CODE HERE FOR DYNAMIC TMP DIR DISCOVERY
&Net::FullAuto::FA_Core::handle_error("No TransferDir Defined for $hostlabel");
}
} return $work_dirs,$ftr_cmd,$cmd_type,$ftm_type,'';
}
sub ftm_login
{
my @topcaller=caller;
print "\nINFO: File_Transfer::ftm_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nFile_Transfer::ftm_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $hostlabel=$_[0];
my $new_master=$_[1]||'';
my $_connect=$_[2]||'';
my $kill_arg=($^O eq 'cygwin')?'f':9;
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,$_connect);
my @connect_method=@{$ftr_cnct};
my $host=($use eq 'ip') ? $ip : $hostname;
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;
}
print $Net::FullAuto::FA_Core::MRLOG "NEWMASTER=$new_master<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (!$new_master && ($hostlabel eq "__Master_${$}__"
|| exists $Net::FullAuto::FA_Core::same_host_as_Master{$hostlabel})) {
return "__Master_${$}__",'','','','','','','','';
}
my $ftp_handle='';my $ftr_cmd='';my $su_login='';
my $ftm_errmsg='';my $die='';my $s_err='';my $shell_pid=0;
my $retrys=0;my $local_transfer_dir='';my $cmd_type='';
my $ms_host='';my $ms_hostlabel='';my $fpx_handle='';
my $work_dirs={};my $die_login_id='';my $ftm_only=0;
my $ms_su_id='';my $ms_login_id='';my $smb_type='';
my $ms_ms_domain='';my $ms_ms_share='';my $ftm_type='';
my $desthostlabel='';my $p_uname='',my $fpx_passwd='';
#my $ftm_passwd=$Net::FullAuto::FA_Core::passwd[2]||$Net::FullAuto::FA_Core::passwd[0];
my $ftm_passwd=$Net::FullAuto::FA_Core::dcipher->decrypt($Net::FullAuto::FA_Core::passetts->[0]);
#my $ftm_passwd=$Net::FullAuto::FA_Core::passetts->[2]||$Net::FullAuto::FA_Core::passetts->[0];
my $ftp_pid='';my $fpx_pid='';my $smb=0;
my @errorstack=();
my ($output,$stdout,$stderr)=('','','');
$login_id=$Net::FullAuto::FA_Core::username if !$login_id;
while (1) {
eval {
if (lc(${$ftr_cnct}[0]) eq 'smb') {
$smb=1;
$ms_hostlabel=$hostlabel;
$ms_host=$host;
if (!exists $same_host_as_Master{
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}) {
if (!defined $Net::FullAuto::FA_Core::DeploySMB_Proxy[0]) {
my $die="The Action You Selected Requires the Use of"
."\n an MSWin Proxy Host - and None are"
."\n Currently Available.";
&Net::FullAuto::FA_Core::handle_error($die);
}
($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]);
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;
}
$hostname||='';$ms_share||='';
$host=($use eq 'ip') ? $ip : $hostname;
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST1111=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$login_id=$Net::FullAuto::FA_Core::username if !$login_id;
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0],$su_id,
$ms_share,$ftm_errmsg,'','','smb');
if ($ftm_passwd ne 'DoNotSU!') {
$su_login=1;
} else { $su_id='' }
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0],$login_id,
$ms_share,$ftm_errmsg,'','','smb');
}
$ftm_errmsg='' unless defined $ftm_errmsg;
$hostlabel=$Net::FullAuto::FA_Core::DeploySMB_Proxy[0];
@connect_method=@{$ftr_cnct};
} else {
($work_dirs,$smb_type,$stderr)=
&connect_share($Net::FullAuto::FA_Core::localhost->{_cmd_handle},
$hostlabel);
$cmd_type='';
$ftm_type='';
$smb=1;
if (!$stderr) {
${$work_dirs}{_tmp}=
$Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp};
${$work_dirs}{_tmp_mswin}=
$Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp_mswin};
${$work_dirs}{_pre_mswin}=${$work_dirs}{_cwd_mswin};
print "HOW ABOUT AN SMB UNAME???===$uname<===\n";<STDIN>;
my %cmd=(
_cmd_handle =>
$Net::FullAuto::FA_Core::localhost->{_cmd_handle},
_cmd_type => $cmd_type,
_work_dirs => $work_dirs,
_hostlabel => [ $hostlabel,'' ],
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $^O,
_cmd_pid => $Net::FullAuto::FA_Core::localhost->{_cmd_pid},
_smb => 1
);
$ftr_cmd=bless \%cmd, 'Rem_Command';
return '','',$work_dirs,$ftr_cmd,$ftm_type,
$cmd_type,$smb,'','','';
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
}
} elsif (${$ftr_cnct}[0] eq 'ftp_proxy' &&
!exists $Net::FullAuto::FA_Core::same_host_as_Master{
$Net::FullAuto::FA_Core::DeployFTM_Proxy[0]}) {
if (!$ftp_handle) {
$desthostlabel=$hostlabel;
$hostlabel=$Net::FullAuto::FA_Core::DeployFTM_Proxy[0];
($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$rcm_chain,
$rcm_map,$p_uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel);
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;
}
$hostname||='';$ms_share||='';
$host=($use eq 'ip') ? $ip : $hostname;
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST2222=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::acquire_semaphore(1234,,1);
if ($su_id) {
$fpx_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$ftm_errmsg,'__su__',$ftm_type);
if ($fpx_passwd ne 'DoNotSU!') {
$su_login=1;
} else { $su_id='' }
}
if (!$su_id) {
$fpx_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'',$ftm_type);
}
my $sftploginid=($su_id)?$su_id:$login_id;
my $previous_method='';$stderr='';
my $fm_cnt=-1;
foreach my $connect_method (@connect_method) {
$fm_cnt++;
if ($stderr) {
# ftp_proxy
print "Warning, Preferred Connection ",
"$previous_method Failed\n"
if ((!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet);
} else { $previous_method=$connect_method;$stderr='' }
if (lc($connect_method) eq 'ftp') {
if (exists $Hosts{"__Master_${$}__"}{'ftp'}) {
$Net::FullAuto::FA_Core::ftppath=
$Hosts{"__Master_${$}__"}{'ftp'};
$Net::FullAuto::FA_Core::ftppath.='/'
if $Net::FullAuto::FA_Core::ftppath!~/\/$/;
}
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";
($fpx_handle,$fpx_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
["${Net::FullAuto::FA_Core::ftppath}ftp",$host,'',
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ftp subprocess");
$fpx_handle=Net::Telnet->new(Fhopen => $fpx_handle,
Timeout => $fttimeout);
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{'ftm_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $fpx_handle,$fpx_pid,'','' ];
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'ftm_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $fpx_handle,$fpx_pid,'','' ];
}
$fpx_handle->telnetmode(0);
$fpx_handle->binmode(1);
$fpx_handle->output_record_separator("\r");
while (my $line=$fpx_handle->get) {
print "FTPLOGINLINE=$line and MS_SHARE=$ms_share\n";
print $Net::FullAuto::FA_Core::MRLOG "FTPLOGINLINE=$line and MS_SHARE=$ms_share\n";
if ((20<length $line && unpack('a21',$line)
eq 'A remote host refused')
|| (31<length $line && unpack('a32',$line) eq
'ftp: connect: Connection refused')) {
while (my $ln=$fpx_handle->get) {
print "CHECLELINE=$ln\n";
last if $ln=~/_funkyPrompt_/s;
}
$line=~s/^(.*)?\n.*/$1/s;
$die=$line
."Destination Host - $host, HostLabel "
."- $hostlabel\n refused an "
."attempted connect operation.\n "
."Check for a running FTP daemon on "
."$hostlabel";
&Net::FullAuto::FA_Core::handle_error($die);
} last if $line=~/Name.*[: ]*$/i;
} $ftm_type='ftp';
} elsif (lc($connect_method) eq 'sftp') {
if (exists $Hosts{"__Master_${$}__"}{'sftp'}) {
$Net::FullAuto::FA_Core::sftppath=
$Hosts{"__Master_${$}__"}{'sftp'};
$Net::FullAuto::FA_Core::sftppath.='/'
if $Net::FullAuto::FA_Core::sftppath!~/\/$/;
}
print "WHAT IS SLAVE=$Net::FullAuto::FA_Core::slave<==\n";
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
($fpx_handle,$fpx_pid)=&Net::FullAuto::FA_Core::pty_do_cmd(
["${Net::FullAuto::FA_Core::sftppath}sftp",
"${sshport}$sftploginid\@$host",
'',$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch sftp subprocess");
$fpx_handle=Net::Telnet->new(Fhopen => $fpx_handle,
Timeout => $fttimeout);
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{'ftm_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $fpx_handle,$fpx_pid,'','' ];
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'ftm_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $fpx_handle,$fpx_pid,'','' ];
}
$fpx_handle->telnetmode(0);
$fpx_handle->binmode(1);
$fpx_handle->output_record_separator("\r");
$ftm_type='sftp';
}
}
if ($su_id) {
$fpx_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$ftm_errmsg,'__su__',$ftm_type);
if ($fpx_passwd ne 'DoNotSU!') {
$su_login=1;
} else { $su_id='' }
}
if (!$su_id) {
$fpx_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'',$ftm_type);
}
## Wait for password prompt.
my $allines='';
while (my $line=$fpx_handle->get) {
print "SFTPLINE=$line<==\n";
$allines.=$line;
if ($allines=~/password[: ]+$/si) {
last;
} elsif ((-1<index($line,'530 '))
|| (-1<index($line,'421 '))) {
$line=~s/^(.*)?\n.*$/$1/s;
&Net::FullAuto::FA_Core::handle_error($line);
}
}
my %ftp=(
_ftp_handle => $fpx_handle,
_ftm_type => $ftm_type,
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $^O,
_hostlabel => [ $hostlabel,
$Net::FullAuto::FA_Core::localhost->{_hostlabel}->[0] ],
_ftp_pid => $fpx_pid
);
print "FPX_PID=$fpx_pid and TEL=$fpx_handle\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,$fpx_passwd);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$fpx_handle->prompt("/s*ftp> ?\$/");
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary')
if $ftm_type ne 'sftp';
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
&Net::FullAuto::FA_Core::release_semaphore(1234);
if (defined $transfer_dir && $transfer_dir) {
print "FTRFOUR\n";
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$fpx_handle,$ftm_type,'',$_connect);
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$fpx_handle,
_hostlabel=>[ $hostlabel,'' ]
},'cd '.${$work_dirs}{_tmp});
if ($stderr) {
my $die="The FTP Service Cannot cd to "
."TransferDir -> ".${$work_dirs}{_tmp}
."\n\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die);
}
}
} $ftp_handle=1;
my $ip='';my $hostname='';my $use='';my $ms_share='';
my $ms_domain='';my $cmd_cnct='';my $ftr_cnct='';
my $login_id='';my $su_id='';my $chmod='';
my $owner='';my $group='';my $transfer_dir='';
my $rcm_chain='';my $rcm_map='';my $p_uname='';
my $cmd_type='';
($ftp_handle,$stderr)=new Rem_Command($hostlabel,
$new_master,$_connect);
$shell_pid=$ftp_handle->{_sh_pid};
$ftp_pid=$ftp_handle->{_cmd_pid};
$cmd_type=$ftp_handle->{_cmd_type};
$ftp_handle=$ftp_handle->{_cmd_handle};
my $cygdrive=$ftp_handle->{_cygdrive};
$hostlabel=$desthostlabel;
($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my $sftploginid=($su_id)?$su_id:$login_id;
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;
}
$ftp_handle->timeout($fttimeout);
$hostname||='';$ms_share||='';
$host=($use eq 'ip') ? $ip : $hostname;
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST3333=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $gotname=0;
my $previous_method='';$stderr='';
my $fm_cnt=-1;
CM1: foreach my $connect_method (@connect_method) {
# final dest via proxy
$fm_cnt++;
if ($stderr && $previous_method ne $connect_method) {
print "Warning, Preferred Connection ",
"$previous_method Failed\n"
if ((!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet);
} else { $previous_method=$connect_method;$stderr='' }
if (lc($connect_method) eq 'ftp') {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftp_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
eval {
my $ftp__cmd=
"${Net::FullAuto::FA_Core::ftppath}ftp $host";
$ftp_handle->print($ftp__cmd);
my $allines='';
my $fc='';
my $al='';
my $cmdseen=0;
## Send Login ID.
ID: while (my $line=$ftp_handle->get) {
$line||='';
$line=~tr/\r//d;
$allines.=$line;
print $Net::FullAuto::FA_Core::MRLOG
"\nFFFFFFF (1) ftm_login() FFFFFFF ",
"FTM RAW OUTPUT: ==>$line<== at Line ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nFFFFFFF (1) ftm_login() FFFFFFF ",
"FTM RAW OUTPUT: ==>$line<== at Line ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if (-1<index $allines,'_funkyPrompt_') {
$allines=~s/_funkyPrompt_//g;
my $fp='_funkyPrompt_';
my $stub=$line;
$stub=~/(^_fun*k*y*P*r*o*m*p*t*_*)/;
my $fs=$1;
$fs||='';
if (!$fs) {
$stub=~/(_*f*u*n*k*y*P*r*o*m*pt_$)/;
my $bs=$1;
$bs||='';
$line=~s/$bs$//s;
} else {
$line=~s/^$fs//s;
} $line=~s/^.*_funkyPrompt_//s;
}
if (!$cmdseen) {
next if $allines=~s/^\s$//s;
if (-1<index $ftp__cmd,$allines) {
next;
} elsif ((-1<index $allines,$ftp__cmd) ||
($ftp__cmd eq $allines)) {
print $ftp__cmd,"\n"
if !$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\n ==>$ftp__cmd<==\n",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$fc=$ftp__cmd;
$fc=~s/\\/\\\\/g;
$allines=~s/^\s*$fc\s*//s;
$cmdseen=1;
next;
}
}
if ($line=~/^$fc\s*/s) {
if ($line=~/^$fc\s*$/s) {
next;
} else {
$line=~s/^$fc\s*//s;
}
}
if ($line=~/^[^f].+\n/s && $line=~/ft?p?>? ?$/s) {
if ($line!~/ftp> $/s) {
$al=$line;
next;
}
} elsif ($line!~/^.*ftp> $/) {
if ($line=~/[.]\s*$/s) {
my $lline=$allines;
chomp($lline);
$lline=~s/^.*\n(.*)$/$1/s;
$line=$lline."\n";
} elsif ($allines=~/Name.*[: ]+$/si) {
if ($line=~/(.+)\n.+$/s) {
my $stub=$1;
my $tall=$allines;
$tall=~s/Name.*[: ]+$//si;
chomp($tall);
my $ll=$tall;
$ll=~s/^.*\n(.*)$/$1/s;
if (-1<index $ll, $stub) {
$line=$ll."\n";
}
}
} elsif (-1<index $line,'A remote host refused') {
$ftp_handle->cmd('bye');
$line=~s/\s*ftp> $//s;
die "$line";
} else {
$al=$line;next
}
}
print $Net::FullAuto::FA_Core::MRLOG
"\nFile_Transfer::ftm_login() LOOKING FOR FTP ",
"ERROR AFTER PASSWD OUTPUT IN CM1:->ID: SUBLOOP:",
"\n ==>$line<==\n",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nFile_Transfer::ftm_login() LOOKING FOR FTP ",
"ERROR AFTER PASSWD OUTPUT IN CM1:->ID: SUBLOOP:",
"\n ==>$line<==\n",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
my $tline=$line;
if (-1<index $allines,'Unknown host') {
$ftp_handle->cmd('bye');
die "ftp: connect: Unknown host";
}
if (-1<index $allines,'ftp: connect:') {
$allines=~/^.*connect:\s*(.*?)\n.*$/s;
my $m=$1;$m||='';
if ((-1==index $allines,'Address already in use')
&& (-1==index $allines,'Connection timed out')
&& (-1<index $allines,'Connection refused')) {
$ftp_handle->cmd('bye');
die "ftp: connect: $m";
} else {
$ftp_handle->close if defined fileno $ftp_handle;
sleep int $ftp_handle->timeout/3;
($ftp_handle,$stderr)=
&Rem_Command::new('Rem_Command',
"__Master_${$}__",$new_master);
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
my $ftp_pid=$ftp_handle->{_cmd_pid};
$cmd_type=$ftp_handle->{_cmd_type};
$ftp_handle=$ftp_handle->{_cmd_handle};
$ftp_handle->print(
"${Net::FullAuto::FA_Core::ftppath}ftp $host");
FH1: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys
%{$Net::FullAuto::FA_Core::Processes{
$hlabel}}) {
foreach my $type (
keys
%{$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}}) {
if ($ftp_handle eq
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}->[0]) {
my $value=
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type}=$value;
last FH1;
}
}
}
}
}
} elsif (-1<index $allines,'421 Service' ||
-1<index $allines,
'No address associated with name'
|| (-1<index $allines,'Connection' &&
(-1<index $allines,'Connection closed' ||
-1<index $allines,
'ftp: connect: Connection timed out'))) {
$allines=~s/s*ftp> ?$//s;
die "$allines\n $!";
}
$tline=~s/ftp> $//s;
print $tline if !$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\n ==>$tline<==\n",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (-1<index $allines,
'ftp: connect: Connection timed out') {
$allines=~s/s*ftp> ?\s*$//s;
die "$allines\n $!";
} elsif ((-1<index $allines,'A remote host refused')
|| (-1<index $allines,
'ftp: connect: Connection refused')) {
my $host=($use eq 'ip') ? $ip : $hostname;
$allines=~s/^(.*)?\n.*/$1/s;
$die=$allines;
if ($die) {
$die.="Destination Host - $host, HostLabel "
."- $hostlabel\n refused an attempted "
."connect operation.\n Check for a "
."running FTP daemon on $hostlabel";
&Net::FullAuto::FA_Core::handle_error($die);
}
}
if ($allines=~/Name.*[: ]+$/si) {
#$gotname=1;$ftr_cmd='ftp';last;
$gotname=1;last;
}
}
};
print "WHAT IS THE FTP_EVAL_ERROR1111=$@\n";
if (!$gotname && ((-1==index $@,'Unknown host') &&
(-1==index $@,'Connection refused') &&
(-1==index $@,'A remote host refused'))) {
if (1<=$#connect_method) {
$stderr=$@;
next CM1;
}
$retrys++;next;
}
if ($@) {
if ($@=~/read timed-out/) {
FLP: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{
$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}}) {
if ($ftp_handle eq
${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[2],$kill_arg) if
&Net::FullAuto::FA_Core::testpid(
${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[2]);
($stdout,$stderr)=
&Net::FullAuto::FA_Core::kill(
${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[1],$kill_arg) if
&Net::FullAuto::FA_Core::testpid(
${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[1]);
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
last FLP;
}
}
}
}
$ftp_handle->close;
my $die="&ftm_login() timed-out while\n "
."waiting for a login prompt from\n "
."Remote Host - $host,\n HostLabel "
."- $hostlabel\n\n The Current Timeout"
." Setting is $fttimeout Seconds.";
&Net::FullAuto::FA_Core::handle_error($die);
} else { die $@ }
}
if ($su_id) {
$ftp_handle->print($su_id);
} else {
$ftp_handle->print($login_id);
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;
} else {
$ftp_handle->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftp_handle);
next;
}
}
$ftm_type='ftp';last;
} elsif (lc($connect_method) eq 'sftp') {
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
$ftp_handle->print("${Net::FullAuto::FA_Core::sftppath}sftp ".
"${sshport}$sftploginid\@$host");
$ftm_type='sftp';
}
}
if ($su_id) {
my $value=$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};
$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"ftm_su_$Net::FullAuto::FA_Core::pcnt"}=$value;
} else {
my $value=$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"};
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"};
$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"ftm_id_$Net::FullAuto::FA_Core::pcnt"}=$value;
}
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$ftm_errmsg,'__su__');
if ($ftm_passwd ne 'DoNotSU!') {
$ftp_handle->print($su_id);
$su_login=1;
} else { $su_id='' }
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg);
$ftp_handle->print($login_id);
}
my %ftp=(
_ftp_handle => $ftp_handle,
_cmd_type => $cmd_type,
_ftm_type => $ftm_type,
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $^O,
_hostlabel => [ $hostlabel,
$Net::FullAuto::FA_Core::localhost->{_hostlabel}->[0] ],
_ftp_pid => $ftp_pid
);
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,$ftm_passwd);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$ftp_handle->prompt("/s*ftp> ?\$/");
if ($su_id) {
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$su_id"}=\%ftp;
} else {
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$login_id"}=\%ftp;
}
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary')
if $ftm_type ne 'sftp';
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
#$Net::FullAuto::FA_Core::pcnt++;
if (defined $transfer_dir && $transfer_dir) {
print "FTRFIVE\n";
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$ftp_handle,$ftm_type,$cygdrive,$_connect);
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ]
},'cd '.${$work_dirs}{_tmp});
if ($stderr) {
my $die="The FTP Service Cannot cd to "
."TransferDir -> ".${$work_dirs}{_tmp}
."\n\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die);
} $Net::FullAuto::FA_Core::ftpcwd{$ftp_handle}{cd}=${$work_dirs}{_tmp};
}
my $ftmtype='';
($work_dirs,$ftr_cmd,$cmd_type,$ftmtype,$stderr)
=ftr_cmd($hostlabel,$ftp_handle,
$new_master,$_connect)
if ($_connect ne 'connect_sftp' &&
$_connect ne 'connect_ftp');
$ftm_type=$ftmtype if $ftmtype;
print "RETURNTWO and FTR_CMD=$ftr_cmd\n";<STDIN>;
return $ftp_handle,$ftp_pid,$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,$fpx_handle,$fpx_pid,$die;
} else {
#########################################################
# ONE-TO-CONNECTION (NON-PROXY/NON-SMB) LOGIN BEGINS HERE
#########################################################
foreach my $connect_method (@connect_method) {
if (lc($connect_method) eq 'ftp') {
$ftm_type='ftp';last;
} elsif (lc($connect_method) eq 'sftp') {
$ftm_type='sftp';last;
}
}
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd($hostlabel,
$su_id,'',$ftm_errmsg,'__su__',$ftm_type);
if ($ftm_passwd ne 'DoNotSU!') {
$su_login=1;
} else { $su_id='' }
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd($hostlabel,
$login_id,'',$ftm_errmsg,$ftm_type);
}
} my $peer=0;
while ($peer++<2) {
($ftp_handle,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",$new_master,$_connect);
if ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG
"\nhhhhhhh Error getting \$ftp_handle via Rem_Command::cmd() hhhhhhh: ".
"==>$stderr<==\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nhhhhhhh Error getting \$ftp_handle via Rem_Command::cmd() hhhhhhh: ".
"==>$stderr<==\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
} else { last }
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$ftp_pid=$ftp_handle->{_cmd_pid};
$shell_pid=$ftp_handle->{_sh_pid};
$cmd_type=$ftp_handle->{_cmd_type};
$ftp_handle=$ftp_handle->{_cmd_handle};
$ftp_handle->timeout($fttimeout);
my $previous_method='';$stderr='';
my $fm_cnt=-1;
CM2: foreach my $connect_method (@connect_method) {
$fm_cnt++;
if ($stderr && $connect_method ne $previous_method) {
print "Warning, Preferred Connection $previous_method Failed\n"
if ((!$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet);
print "\n".$stderr."\n"
if ((!$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet);
} else { $previous_method=$connect_method;$stderr='' }
if (lc($connect_method) eq 'ftp') {
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";
$ftp_handle->print("${Net::FullAuto::FA_Core::ftppath}ftp $host");
FH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftp_handle eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last FH;
}
}
}
}
## Send Login ID.
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (2)
print "\n Logging into $host ($hostlabel) via $connect_method . . .\n\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (2) into $host ($hostlabel) via $connect_method ".
". . .\n\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (2) into $host ($hostlabel) via $connect_method . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$s_err=' ';
my $gotname=0;
while (1) {
eval {
my $allines='';
my $fc='';
my $al='';
my $cmdseen=0;
## Send Login ID.
$ftp_handle->autoflush(1);
ID: while (my $line=$ftp_handle->get) {
$line||='';
$line=~tr/\r//d;
$allines.=$line;
print $Net::FullAuto::FA_Core::MRLOG
"\nFFFFFFF (2) ftm_login() FFFFFFF ",
"FTP RAW OUTPUT: ==>$line<== at Line ",
__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nFFFFFFF (2) ftm_login() FFFFFFF ",
"FTP RAW OUTPUT: ==>$line<== at Line ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if (-1<index $allines,'_funkyPrompt_') {
$allines=~s/_funkyPrompt_//g;
my $fp='_funkyPrompt_';
my $stub=$line;
$stub=~/(^_fun*k*y*P*r*o*m*p*t*_*)/;
my $fs=$1;
$fs||='';
if (!$fs) {
$stub=~/(_*f*u*n*k*y*P*r*o*m*pt_$)/;
my $bs=$1;
$bs||='';
$line=~s/$bs$//s;
} else {
$line=~s/^$fs//s;
} $line=~s/^.*_funkyPrompt_//s;
}
if (!$cmdseen) {
next if $allines=~s/^\s$//s;
if (-1<index $ftp__cmd,$allines) {
next;
} elsif ((-1<index $allines,$ftp__cmd) ||
($ftp__cmd eq $allines)) {
print $ftp__cmd,"\n" if !$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG
"\n ==>$ftp__cmd<==\n",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$fc=$ftp__cmd;
$fc=~s/\\/\\\\/g;
$allines=~s/^\s*$fc\s*//s;
$cmdseen=1;
next;
}
}
if ($line=~/^$fc\s*/s) {
if ($line=~/^$fc\s*$/s) {
next;
} else {
$line=~s/^$fc\s*//s;
}
}
if ($line=~/^[^f].+\n/s && $line=~/ft?p?>? ?$/s) {
if ($line!~/ftp> $/s) {
$al=$line;
next;
}
} elsif ($line!~/^.*ftp> $/) {
if ($line=~/[.]\s*$/s) {
my $lline=$allines;
chomp($lline);
$lline=~s/^.*\n(.*)$/$1/s;
$line=$lline."\n";
} elsif ($allines=~/Name.*[: ]+$/si) {
if ($line=~/(.+)\n.+$/s) {
my $stub=$1;
my $tall=$allines;
$tall=~s/Name.*[: ]+$//si;
chomp($tall);
my $ll=$tall;
$ll=~s/^.*\n(.*)$/$1/s;
if (-1<index $ll, $stub) {
$line=$ll."\n";
}
}
} elsif (-1<index $line,'A remote host refused') {
$ftp_handle->cmd('bye');
$line=~s/\s*ftp> $//s;
die $line;
} else {
$al=$line;next
}
}
print $Net::FullAuto::FA_Core::MRLOG
"\nFile_Transfer::ftm_login() LOOKING FOR FTP ",
"ERROR AFTER PASSWD OUTPUT IN CM2:->ID: SUBLOOP:",
"\n ==>$line<==\n",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nFile_Transfer::ftm_login() LOOKING FOR FTP ",
"ERROR AFTER PASSWD OUTPUT IN CM2:->ID: SUBLOOP:",
"\n ==>$line<==\n",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
my $tline=$line;
if (-1<index $allines,'Unknown host') {
$ftp_handle->cmd('bye');
die "ftp: connect: Unknown host";
}
if (-1<index $allines,'ftp: connect:') {
$allines=~/^.*connect:\s*(.*?)\n.*$/s;
my $m=$1;$m||='';
if ((-1==index $allines,'Address already in use')
&& (-1==index $allines,'Connection timed out')
&& (-1<index $allines,'Connection refused')) {
$ftp_handle->cmd('bye');
die "ftp: connect: $m";
} elsif ($retrys++<2) {
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($shell_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($shell_pid)
&& $shell_pid ne $Net::FullAuto::FA_Core::localhost->{_sh_pid};
print "FTP_PID=$ftp_pid<== and ==>$localhost->{_cmd_pid}<==\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($ftp_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($ftp_pid)
&& $ftp_pid ne $Net::FullAuto::FA_Core::localhost->{_cmd_pid};
$ftp_handle->close if defined fileno $ftp_handle;
sleep int $ftp_handle->timeout/3;
($ftp_handle,$stderr)=
&Rem_Command::new('Rem_Command',
"__Master_${$}__",$new_master,$_connect);
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
$ftp_handle=$ftp_handle->{_cmd_handle};
$ftp_handle->timeout($fttimeout);
my $sftploginid=($su_id)?$su_id:$login_id;
my $previous_method='';$stderr='';
my $fm_cnt=-1;
my $ftp__cmd=
"${Net::FullAuto::FA_Core::ftppath}ftp $host";
foreach $connect_method (@connect_method) {
if (lc($connect_method) eq 'ftp') {
$ftp_handle->print(
$Net::FullAuto::FA_Core::ftppath.
"ftp $host");
last;
} elsif (lc($connect_method) eq 'sftp') {
my $sshport='';
if (exists
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
$ftp_handle->print(
$Net::FullAuto::FA_Core::sftppath.
"sftp ${sshport}$sftploginid\@$host");
last;
}
}
FH1: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftp_handle eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}
{$type}=$value;
last FH1;
}
}
}
}
} else {
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($shell_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($shell_pid)
&& $shell_pid ne $Net::FullAuto::FA_Core::localhost->{_sh_pid};
print "FTP_PID=$ftp_pid\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($ftp_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($ftp_pid)
&& $ftp_pid ne $Net::FullAuto::FA_Core::localhost{_cmd_pid};
&Net::FullAuto::FA_Core::handle_error("ftp: connect: $m\n "
."$retrys Attempts Tried",'-8','__cleanup__');
}
} elsif (-1<index $allines,'421 Service' ||
-1<index $allines,
'No address associated with name'
|| (-1<index $allines,'Connection' &&
(-1<index $allines,'Connection closed' ||
-1<index $allines,
'ftp: connect: Connection timed out'))) {
$allines=~s/s*ftp> ?$//s;
die "$allines\n $!";
}
$tline=~s/ftp> $//s;
print $tline if !$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\n DISPLAYED TO USER ==>$tline<==\n",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (-1<index $allines,
'ftp: connect: Connection timed out') {
$allines=~s/s*ftp> ?\s*$//s;
die "$allines\n $!";
} elsif ((-1<index $allines,'A remote host refused')
|| (-1<index $allines,
'ftp: connect: Connection refused')) {
my $host=($use eq 'ip') ? $ip : $hostname;
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST4444=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($ms_share && !$ftm_only) {
if ($^O eq 'cygwin') {
my $mswin_cwd='';
($mswin_cwd,$smb_type,$stderr)=
&connect_share(
$Net::FullAuto::FA_Core::localhost->{_cmd_handle},
$hostlabel);
$cmd_type='';
$ftm_type='';
$smb=1;
if (!$stderr) {
${$work_dirs}{_tmp}=
$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{_tmp};
${$work_dirs}{_tmp_mswin}=
$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{_tmp_mswin};
${$work_dirs}{_pre_mswin}
=${$work_dirs}{_cwd_mswin};
my %cmd=(
_cmd_handle =>
$Net::FullAuto::FA_Core::localhost->{
'_cmd_handle'},
_cmd_type => '',
_work_dirs => $work_dirs,
_hostlabel => [ $hostlabel,'' ],
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $^O,
_cmd_pid =>
$Net::FullAuto::FA_Core::localhost->{_cmd_pid},
_smb => 1
);
$ftr_cmd=bless \%cmd, 'Rem_Command';
print "RETURNTHREE and FTR_CMD=$ftr_cmd\n";<STDIN>;
return '','',$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,'','','';
} elsif (unpack('a10',$stderr) eq 'System err'
&& $stderr=~/unknown user name/s) {
&Net::FullAuto::FA_Core::handle_error($stderr);
} else { $die=$stderr }
} elsif (exists $Net::FullAuto::FA_Core::Hosts{
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}) {
$Net::FullAuto::FA_Core::Hosts{$hostname}{'RCM_Link'}
='';
$Net::FullAuto::FA_Core::Hosts{$hostname}{'FTM_Link'}
='smb';
$ms_host=$host;
$ms_ms_share=$ms_share;
$ms_hostlabel=$hostlabel;
$ms_login_id=$login_id;
$ms_su_id=$su_id;
$hostlabel=$Net::FullAuto::FA_Core::DeploySMB_Proxy[0];
($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,
$rcm_chain,$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]);
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fttimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fttimeout) {
$fttimeout=$timeout if !$fttimeout;
}
$host=($use eq 'ip') ? $ip : $hostname;
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST5555=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$login_id=$Net::FullAuto::FA_Core::username if !$login_id;
$login_id=$su_id if $su_id;
if (exists $Net::FullAuto::FA_Core::Connections{
${Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}.
"__%-$login_id"}) {
$ftp_handle=$Net::FullAuto::FA_Core::Connections{
${Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}.
"__%-$login_id"}->{_ftp_handle};
$ftr_cmd=$Net::FullAuto::FA_Core::Connections{
${Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}.
"__%-$login_id"};
$cmd_type=$ftr_cmd->{_cmd_type};
$ftm_type=$ftp_handle->{_ftm_type};
$smb=1;
$uname=$Net::FullAuto::FA_Core::Connections{
${Net::FullAuto::FA_Core::DeploySMB_Proxy[0]}.
"__%-$login_id"}->{_uname};
my $mswin_cwd='';
($work_dirs,$smb_type,$stderr)=
&connect_share($ftr_cmd,$ms_hostlabel);
if (defined $transfer_dir
&& $transfer_dir) {
if (unpack('@1 a1',$transfer_dir)
eq ':') {
my ($drive,$path)=
unpack('a1 x1 a*',$transfer_dir);
${$work_dirs}{_tmp_mswin}
=$transfer_dir.'\\';
$path=~tr/\\/\//;
${$work_dirs}{_tmp}
=$ftr_cmd->{_cygdrive}
.'/'.lc($drive).$path.'/';
} elsif ($transfer_dir=~/^[\/|\\]/
&& $transfer_dir!~/
$ftr_cmd->{_cygdrive_regex}/ &&
$hostlabel eq "__Master_${$}__") {
(${$work_dirs}{_tmp},
${$work_dirs}{_tmp_mswin})=
&File_Transfer::get_drive(
$transfer_dir,'Transfer',
'',$hostlabel);
}
}
if ($stderr) {
$die="Could Not Map the Directory "
."Share\n -> \"\\\\$host"
."\\$ms_share\"\n\n $stderr";
my $er=$!;
if ($er=~s/is not /is not\n /) {
$er=" $er";
} $die="$die\n $er";
}
print "RETURNFOUR and FTR_CMD=$ftr_cmd\n";<STDIN>;
return '','',$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,$smb,'','',$die;
} else {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0],$login_id,
$ms_share,$ftm_errmsg,'',$ftm_type);
$ftp_handle->print('bye');
$ftp_handle->get;
$ftp_handle->timeout($fttimeout);
my $sftploginid=($su_id)?$su_id:$login_id;
my $ftp__cmd=
$Net::FullAuto::FA_Core::ftppath.
"ftp $host";
my $sp=$Net::FullAuto::FA_Core::sftpport;
foreach $connect_method (@{$ftr_cnct}) {
if (lc($connect_method) eq 'ftp') {
$ftp_handle->print(
$Net::FullAuto::FA_Core::ftppath.
"ftp $host");
$ftm_type='ftp';
} elsif (lc($connect_method) eq 'sftp') {
my $sshport='';
if (exists
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
$ftp_handle->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ".
"${sshport}$sftploginid\@$host");
$ftm_type='sftp';
}
}
} $smb=1;
## Send Login ID.
while (my $line=$ftp_handle->get) {
if ((20<length $line && unpack('a21',$line)
eq 'A remote host refused')
|| (31<length $line && unpack(
'a32',$line) eq
'ftp: connect: Connection refused')) {
$line=~s/^(.*)?\n.*/$1/s;
$die=$line;last;
}
if ($line=~/Name.*[: ]*$/i) {
$gotname=1;last ID;
}
}
} else {
$allines=~s/^(.*)?\n.*/$1/s;
$die=$allines;
}
} else {
$allines=~s/^(.*)?\n.*/$1/s;
$die=$allines;
}
#print "NOWWWLINE=$line AND DIE=$die<==\n";
if ($die) {
$die.="Destination Host - $host, HostLabel "
."- $hostlabel\n refused an attempted "
."connect operation.\n\n Check for a "
."running FTP daemon on $hostlabel";
#&Net::FullAuto::FA_Core::handle_error($die);
die $die;
}
}
if ($allines=~/Name.*[: ]+$/si) {
#$gotname=1;$ftr_cmd='ftp';last;
$gotname=1;last;
}
}
};
#print "WHAT IS THE FTP_EVAL_ERROR2222=$@ and GOTNAME\n";
if (!$gotname && ((-1==index $@,'Unknown host') &&
(-1==index $@,'Connection refused') &&
(-1==index $@,'A remote host refused'))) {
if (1<=$#connect_method) {
$stderr=$@;
next CM2;
}
$retrys++;next;
}
if ($@) {
if ($@=~/read timed-out/) {
my $die="&ftm_login() timed-out while\n "
."waiting for a login prompt from\n "
."Remote Host - $host,\n HostLabel "
."- $hostlabel\n\n The Current Timeout"
." Setting is $fttimeout Seconds.";
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} else {
print $Net::FullAuto::FA_Core::MRLOG "ftplogin() EVALERROR=$@<==\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
die $@;
}
} last
}
if ($su_id) {
$ftp_handle->print($su_id);
} else {
$ftp_handle->print($login_id);
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;
} else {
$ftp_handle->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftp_handle);
next;
}
}
$ftm_type='ftp';last;
} elsif (lc($connect_method) eq 'sftp') {
my $sftploginid=($su_id)?$su_id:$login_id;
my $sshport='';
if (exists
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
$ftp_handle->print("${Net::FullAuto::FA_Core::sftppath}sftp ".
"${sshport}$sftploginid\@$host");
FH: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftp_handle eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type}=
$value;
last FH;
}
}
}
}
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (3)
print "\n Logging into $host ($hostlabel) via ",
"$connect_method . . .\n\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (3) into $host ($hostlabel) via ",
"$connect_method . . .\n\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (3) into $host via $connect_method ",
" . . .\n\n" if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;
} else {
$ftp_handle->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftp_handle);
next;
}
}
$ftm_type='sftp';last;
}
}
## Send password.
$ftp_handle->print($ftm_passwd);
my $lin='';my $asked=0;my $authyes=0;my @choices=();
while (1) {
while (my $line=$ftp_handle->get(Timeout=>$fttimeout)) {
if ($line=~/command not found/) {
die 'Perm';
}
print $Net::FullAuto::FA_Core::MRLOG
"\nFile_Transfer::ftm_login() ",
"LOOKING FOR $ftm_type PROMPT AFTER PASSWD OUTPUT:",
"\n ==>$line<==\n ",
"SEPARATOR=${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nFile_Transfer::ftm_login() ",
"LOOKING FOR $ftm_type PROMPT AFTER PASSWD OUTPUT:",
"\n ==>$line<==\n ",
"SEPARATOR=${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
$lin.=$line;
if ((-1<index $lin,'Perm') || $lin=~/^\s*[Pp]assword[:\s]+$/s) {
if ($lin=~/[Pp]assword[:\s]+$/s) {
if ($su_id && $su_id ne $login_id) {
if (!$asked++) {
my $error='';
($error=$lin)=~s/^\s*(.*)\n.*$/$1/s;
if ($error=~/^\s*[Pp]assword[:\s]+$/s) {
$error='Password *NOT* accepted';
}
$error||='Password *NOT* accepted';
my $asktimeout=300;my $a='';my $choice='';
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # NB:
# \n required
alarm $asktimeout;
my $banner="\n *** THIS SCREEN WILL "
."TIMEOUT IN 5 MINUTES ***\n"
."\n The Host \"$hostlabel\" is "
."configured to attempt a su\n with "
."the ID \'$su_id\'\; however, the first "
."attempt\n resulted in the following "
."Error :\n\n $error\n\n It "
."may be that sftp is configured to "
."disallow logins\n with \'$su_id\'\."
."\n\n Please Pick an Operation :\n"
."\n NOTE: Choice will affect all "
."future logins!\n";
$choices[0]=
"Re-enter password and re-attempt with "
."\'$su_id\'";
$choices[1]=
"Attempt login with base id \'$login_id\'";
$choice=&Term::Menus::pick(\@choices,$banner);
chomp $choice;
};
$choice||=']quit[';
if ($choice ne ']quit[') {
if ($choice=~/$su_id/s) {
my $show='';
($show=$lin)=~s/^.*?\n(.*)$/$1/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$show ";
my $newpass=<STDIN>;
chomp $newpass;
$ftp_handle->print($newpass);
print $Net::FullAuto::FA_Core::MRLOG $show
if $Net::FullAuto::FA_Core::log &&
-1<index
$Net::FullAuto::FA_Core::MRLOG,'*';
$lin='';last;
}
} else {
&Net::FullAuto::FA_Core::su_scrub(
$hostlabel,$su_id,$ftm_type);
&Net::FullAuto::FA_Core::passwd_db_update(
$hostlabel,$su_id,'DoNotSU!',
$ftm_type);
$ftp_handle->print("\003");
$ftp_handle->print;
while (my $line=$ftp_handle->get) {
print "TRYING TO USE NEW PASSWORDLINE=$line<==\n";
print $Net::FullAuto::FA_Core::MRLOG "LLINE44=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$line=~s/\s*$//s;
last if $line=~/_funkyPrompt_$/s;
last if $line=~/Killed by signal 2\.$/s;
} $lin='';
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
$ftp_handle->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ".
"${sshport}$login_id\@$host");
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;
} else {
$ftp_handle->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftp_handle);
next;
}
}
## Send password.
print "111 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";
my $ftm_passwd=
&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');
$ftp_handle->print($ftm_passwd);
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (4)
print "\n Logging into $host (",
"$hostlabel) ",
"via $ftm_type . . .\n\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print
"\n Logging (4) into $host (",
"$hostlabel) ",
"via $ftm_type . . .\n\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (4) into $host (",
"$hostlabel) ",
"via $ftm_type . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index
$Net::FullAuto::FA_Core::MRLOG,'*';
last;
}
} else {
&Net::FullAuto::FA_Core::cleanup();
}
} elsif ($asked<4) {
print "YESSSSSSS WE HAVE DONE IT FOUR TIMES11\n";<STDIN>;
}
} else {
## Send password.
my $showerr='';
($showerr=$lin)=~s/^.*?\n(.*)$/$1/s;
$showerr=~s/^(.*)?\n.*$/$1/s;
$retrys++;
if ($login_id eq 'root') {
$showerr="$showerr\n\n HINT: sftp may not be "
."configured to allow \'root\' access."
."\n If ssh connectivity & su root is "
."available, try setting\n SU_ID =>"
." \'root\' in "
."$Net::FullAuto::FA_Core::fa_host\n";
}
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$showerr,'','sftp','__force__');
$ftp_handle->print($ftm_passwd);
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet) {
# Logging (5)
print "\n Logging into $host ($hostlabel) ",
"via $ftm_type . . .\n\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print
"\n Logging (5) into $host ($hostlabel) ",
"via $ftm_type . . .\n\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (5) into $host ($hostlabel) ",
"via $ftm_type . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$lin='';next;
}
} elsif ($line=~/_funkyPrompt_$|Connection closed/s) {
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'sshport'}.' ';
}
$ftp_handle->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ".
"${sshport}$login_id\@$host");
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&wait_for_passwd_prompt(
{ _cmd_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type },$timeout);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
die $stderr;
} else {
$ftp_handle->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftp_handle);
next;
}
}
## Send password.
print $Net::FullAuto::FA_Core::MRLOG "333 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');
$ftp_handle->print($ftm_passwd);
my $showsftp="\n LoggingF into "
."$host via sftp . . .\n\n";
print $showsftp if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG $showsftp
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last;
}
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
print "AUTHENHERE!1111\n";<STDIN>;
my $question=$lin;
$question=~s/^.*(The authen.*)$/$1/s;
$question=~s/\' can\'t/\'\ncan\'t/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$question ";
my $answer=<STDIN>;
chomp $answer;
if (lc($answer) eq 'yes') {
$ftp_handle->print($answer);
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$authyes=1;$lin='';last;
} elsif (lc($answer) eq 'no') {
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::cleanup()
}
}
} elsif ($lin=~/channel is being closed/s) {
$lin=~s/\s*//s;
$lin=~s/^(.*)?\n.*$/$1/s;
my $warning=$lin;
$warning=~tr/\015//d;
$warning=~s/^/ /gm;
$warning="WARNING! - sftp on Host $host is not configured\n"
." for user $login_id :\n\n$warning";
&Net::FullAuto::FA_Core::handle_error(
$warning,'__return__','__warn__');
die $lin;
} elsif ($line=~/^530 /m) {
$line=~s/^.*(530.*)/$1/s;
$line=~s/\s*ftp\>\s*$//s;
$line=~s/\n/\n /s;
die "$line\n";
}
if ($line=~/[\$\%\>\#\-\:]+ ?$/m) {
$lin='';last;
} elsif ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
$lin='';last;
} elsif ($lin=~/Perm/s && $lin=~/password[: ]+$/si) { last }
}
if ($lin=~/Perm/s) {
$lin=~s/\s*//s;
$lin=~s/^(.*)?\n.*$/$1/s;
die "$lin\n";
} else { last }
}
my %ftp=(
_ftp_handle => $ftp_handle,
_ftm_type => $ftm_type,
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $^O,
_hostlabel => [ $hostlabel,
$Net::FullAuto::FA_Core::localhost->{
'_hostlabel'}->[0] ],
_ftp_pid => $ftp_pid
);
# Make sure prompt won't match anything in send data.
$ftp_handle->prompt("/s*ftp> ?\$/");
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary')
if $ftm_type ne 'sftp';
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
if ($_connect ne 'connect_sftp' && $_connect ne 'connect_ftp') {
my $ftmtype='';
if ($ms_hostlabel) {
($work_dirs,$ftr_cmd,$cmd_type,$ftmtype,$stderr)
=ftr_cmd($ms_hostlabel,$ftp_handle,
$new_master,$_connect);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1','__cleanup__')
if $stderr;
$ftm_type=$ftmtype if $ftmtype;
if ($su_id) {
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$su_id"}=$ftr_cmd;
} else {
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$login_id"}=$ftr_cmd;
}
} else {
($work_dirs,$ftr_cmd,$cmd_type,$ftmtype,$stderr)
=ftr_cmd($hostlabel,$ftp_handle,
$new_master,$_connect);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$ftm_type=$ftmtype if $ftmtype;
}
}
#$ftp_handle->print("quote stat");
#while ($line=$ftp_handle->get) {
# print "FTPLINE2=$line\n";
# last if $line=~/ftp>\s*/s;
#};<STDIN>;
if (!$ftm_only && exists ${$work_dirs}{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_uname=>$uname,
_luname=>$^O,
_ftm_type=>$ftm_type },
"cd \"${$work_dirs}{_tmp}\"");
if ($stderr) {
my $die="The FTP Service Cannot Change to "
."the Transfer Directory"
."\n\n -> $stderr\n";
&Net::FullAuto::FA_Core::handle_error($die);
} $Net::FullAuto::FA_Core::ftpcwd{$ftp_handle}{cd}=
${$work_dirs}{_tmp};
}
if ($Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$ftp_handle,
_hostlabel=>[ $hostlabel,'' ],
_uname=>$uname,
_luname=>$^O,
_ftm_type=>$ftm_type },
"lcd \"$Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp}\"");
if ($stderr) {
my $die="The FTP Service Cannot Change to "
."the Local Transfer Directory"
."\n\n -> $stderr\n";
&Net::FullAuto::FA_Core::handle_error($die);
}
$Net::FullAuto::FA_Core::ftpcwd{$ftp_handle}{lcd}=
$Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp};
}
};
if ($@) {
$ftm_errmsg=$@;
#print "FTM_LOGIN_ERRMSG=$ftm_errmsg and FTM_PID=$ftp_pid and SHELLPID=$shell_pid<===\n";
print "sub ftm_login FTM_LOGIN_ERROR=$ftm_errmsg<==\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "sub ftm_login FTM_LOGIN_ERROR=$ftm_errmsg<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (unpack('a4',$ftm_errmsg) eq 'read' ||
(-1<index $ftm_errmsg,'421 Service') ||
(-1<index $ftm_errmsg,'Connection refused') ||
(-1<index $ftm_errmsg,'Connection closed') ||
(-1<index $ftm_errmsg,'Unknown host') ||
(-1<index $ftm_errmsg,'A remote host refused')) {
my $host= $hostname ? $hostname : $ip;
print $Net::FullAuto::FA_Core::MRLOG "HOSTTEST6666=$host\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$ftm_errmsg="$@\n While Attempting "
."Login to $host\n -> HostLabel "
."\'$hostlabel\'\n\n";
if (unpack('a4',$ftm_errmsg) eq 'read') {
$ftm_errmsg.=" Current Timeout "
."Setting is -> " . $ftp_handle->timeout
." seconds.\n\n";
}
if ($retrys<2 && unpack('a4',$ftm_errmsg) eq 'read') {
$retrys++;
warn "$ftm_errmsg $!";
if (defined fileno $ftp_handle) {
$ftp_handle->print; # if defined fileno $ftp_handle;
while (my $line=$ftp_handle->get) {
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::ftm_login() LOOKING FOR PROMPT=$line\n and ERROR=$@\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "File_Transfer::ftm_login() LOOKING FOR PROMPT=$line\n and ERROR=$@\n";
if ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
return $ftp_handle,$ftp_pid,$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,$smb,'','',$die;
} elsif ($line=~
/logout|Connection.*closed|A remote host refused/s) {
last;
}
}
}
FTH: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{
$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftp_handle eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
last FTH;
}
}
}
}
$ftp_handle->close;
if ($hostlabel eq $Net::FullAuto::FA_Core::DeploySMB_Proxy[0]
&& 1<$#FA_Core::DeploySMB_Proxy) {
shift @FA_Core::DeploySMB_Proxy;
# DO MORE WORK ON SWITCHING DEPLOYPROXYS
$ftm_errmsg.="COULD HAVE WORKED WITH NEW CODE SWITCHING DPRX.";
&Net::FullAuto::FA_Core::handle_error($ftm_errmsg);
} elsif ($ftm_errmsg=~/421 Service/s ||
$ftm_errmsg=~/Connection closed/s) {
&Net::FullAuto::FA_Core::handle_error("$ftm_errmsg$s_err");
}
next;
} else {
print "\nEXITING from ftm_login() ERROR: $@\n at Line ",__LINE__,"\n ".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nEXITING FROM ftm_login() ERROR: $@\n at Line ",__LINE__,"\n ".
(join ' ',@topcaller)."\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$die=$ftm_errmsg;
$ftp_handle=Bad_Handle->new($hostlabel,$die);
last;
}
}
$die_login_id=($su_login)?$su_id:$login_id;
if ($retrys<2 &&
(-1==index $ftm_errmsg,'No more authentication methods')) {
if ($ftm_errmsg=~/530 |Perm|(channel is being closed)/) {
my $shipht=$1;
shift @connect_method if $shipht;
if ($su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id);
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);
}
$retrys++;
$retrys=0 if $shipht;
print "\nRETRYING from ftm_login() ERROR: $ftm_errmsg\n",
" at Line ",__LINE__,"\n ".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nRETRYING FROM ftm_login() ERROR: $ftm_errmsg\n",
" at Line ",__LINE__,"\n ".
(join ' ',@topcaller)."\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$ftp_handle->print("\003");
$ftp_handle->get;
$ftp_handle->print('bye');
while (my $line=$ftp_handle->get) {
last if $line=~/_funkyPrompt_|221 Goodbye/s;
}
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($shell_pid)
&& $shell_pid ne
$Net::FullAuto::FA_Core::localhost->{_sh_pid};
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$ftp_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($ftp_pid)
&& $ftp_pid ne $Net::FullAuto::FA_Core::localhost{_cmd_pid};
$ftp_handle->close;
if (-1<$#connect_method && ($shipht ||
!$Net::FullAuto::FA_Core::cron)) {
next;
}
} elsif (unpack('a10',$ftm_errmsg) eq 'System err' &&
$ftm_errmsg=~/unknown user name/s) {
if ($su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id);
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);
} $retrys++;next if !$Net::FullAuto::FA_Core::cron;
}
} else { shift @connect_method;next if $#connect_method }
if (unpack('a10',$ftm_errmsg) eq 'The System') {
$die="$ftm_errmsg$s_err";
} else {
my $f_t=$ftm_type;$f_t=~s/^(.)/uc($1)/e;
$ftm_errmsg=~s/^(.*)\n *(.*)$/$1\n $2/s;
$die="The Host $host Returned\n the "
."Following Unrecoverable Error Condition\,\n"
." Rejecting the $f_t Login Attempt"
." of the ID\n -> $die_login_id:"
."\n\n $ftm_errmsg\n$s_err"
." at ".(caller(0))[1]." "
."line ".(caller(2))[2].".\n\n ";
} last;
} else { last }
last if $die;
} return $ftp_handle,$ftp_pid,$work_dirs,$ftr_cmd,
$ftm_type,$cmd_type,$smb,'','',$die;
} ## END of &ftm_login
sub wait_for_passwd_prompt
{
## Wait for password prompt.
my @topcaller=caller;
print "\nINFO: File_Transfer::wait_for_passwd_prompt() ",
"(((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nINFO: File_Transfer::wait_for_passwd_prompt() ",
"(((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $filehandle=$_[0];
my $timeout=$_[1]||$Net::FullAuto::FA_Core::timeout;
my $notnew=$_[2]||'';
my $lin='';my $authyes=0;my $gotpass=0;my $warning='';
my $eval_stdout='';my $eval_stderr='';$@='';
my $connect_err=0;my $count=0;
$filehandle->{_cmd_handle}->autoflush(1);
my $starttime=time;my $firstflag=0;
eval {
while (1) {
PW: while (my $line=$filehandle->{_cmd_handle}->get(
Timeout=>$timeout)) {
$SIG{ALRM} = sub { die "read timed-out:do_slave\n" }; # \n required
alarm $timeout+1;
print $Net::FullAuto::FA_Core::MRLOG
"\nPPPPPPP wait_for_passwd_prompt() PPPPPPP ",
"CMD RAW OUTPUT: ==>$line<== at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nPPPPPPP wait_for_passwd_prompt() PPPPPPP ",
"CMD RAW OUTPUT: ==>$line<== at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
$lin.=$line;
if (!$notnew && !$firstflag && 5<=time()-$starttime) {
$firstflag=1;
unless (-e $Net::FullAuto::FA_Core::home_dir.'/.ssh' &&
&Net::FullAuto::FA_Core::grep_for_string_existence_only(
$Net::FullAuto::FA_Core::home_dir.'/.ssh/known_hosts',
qr/^localhost/)) {
print "\n\n ############### NOTICE ###############".
"\n It appears that this is the first time".
"\n FullAuto is starting on this host. If".
"\n so, it may take a few *MINUTES* for the".
"\n intial configurtion of Secure Shell".
"\n to complete. All future FullAuto".
"\n startups will go MUCH faster. Please".
"\n be patient.";
}
}
if (-1<index $line,'Permission denied') {
alarm 0;
die 'Permission denied';
} elsif ($warning || (-1<index $line,'@@@@@@@@@@')) {
$warning.=$line;
$count++ if $line=~/^\s*$/s;
if ($warning=~/Connection closed/s || $count==10) {
$warning=~s/^.*?(\@+.*)$/$1/s;
$warning=~s/_funkyPrompt_//s;
$warning=~s/^/ /gm;
$warning=~s/\s*$//s;
die "\n".$warning;
} $filehandle->{_cmd_handle}->print;
next;
} elsif (-1<index $lin,'Address already in use') {
alarm 0;
die 'Connection closed';
#} elsif (-1<index $lin,'No route to host') {
# alarm 0;
# die $lin;
} elsif (-1<index $lin,'Connection reset by peer') {
alarm 0;
if ($lin=~s/^.*(ssh:.*)$/$1/s) {
$lin=~s/Could/ Could/s;
$lin=~s/_funkyPrompt_//s;
die $lin;
} else {
$lin='Connection closed';
}
die $lin;
} elsif (7<length $line && unpack('a8',$line) eq 'Insecure') {
$line=~s/^Insecure/INSECURE/s;
$eval_stdout='';$eval_stderr=$line;
alarm 0;
die $line;
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
my $question=$lin;
$question=~s/^.*(The authen.*)$/$1/s;
$question=~s/\' can\'t/\'\ncan\'t/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$question ";
alarm 0;
my $authtimeout=120;my $a='';
my $answer='';
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $authtimeout;
$answer=<STDIN>;
alarm 0;
};
if (!$authorize_connect && ($@ || !$answer)) {
print
"\n\n","This request for autenticity timed",
" out and FullAuto terminated.",
"\nTo provide permission for this request",
" run FullAuto with the\n --authorize_connect",
" argument.\n\n";
print $Net::FullAuto::FA_Core::MRLOG
"\n\n","This request for autenticity timed",
" out and FullAuto terminated.",
"\nTo provide permission for this request",
" run FullAuto with the\n --authorize_connect",
" argument.\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::cleanup()
} elsif ($a=~/^[Nn]$/s) {
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::cleanup()
}
chomp $answer;
if (lc($answer) eq 'yes' or $authorize_connect) {
$filehandle->{_cmd_handle}->print('yes');
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$authyes=1;$lin='';
$SIG{ALRM} = sub { die "read timed-out:do_slave\n" };
last;
} elsif (lc($answer) eq 'no') {
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
alarm 0;
&Net::FullAuto::FA_Core::cleanup()
}
}
} elsif ($lin=~/password[: ]+$/si) {
print $Net::FullAuto::FA_Core::MRLOG
"wait_for_passwd_prompt() PASSWORD PROMPT=$lin<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$gotpass=1;alarm 0;last PW;
} elsif ((-1<index $lin,'530 ')
|| (-1<index $lin,'421 ')
|| (-1<index $lin,'Connection refused')
|| (-1<index $lin,'Connection closed')
|| (-1<index $lin,'ssh: Could not')
|| (-1<index $lin,'name not known')
|| (-1<index $lin,'Could not create')) {
chomp($lin=~tr/\0-\11\13-\31\33-\37\177-\377//d);
$lin=~/(^530[ ].*$)|(^421[ ].*$)
|(^Connection[ ]refused.*$)
|(^Connection[ ]closed.*$)
|(^ssh:[ ]Could[ ]not.*)/xm;
$lin=$1 if $1;$lin=$2 if $2;
$lin=$3 if $3;$lin=$4 if $4;
$lin=$5 if $5;
if (-1<index $lin,'Connection refused') {
alarm 0;
die 'Connection refused';
} elsif (-1<index $lin,'name not known') {
alarm 0;
die $lin;
} elsif (-1<index $lin,'Connection closed') {
alarm 0;
die 'Connection closed';
} elsif (-1<index $lin,'Could not create') {
alarm 0;
if ($^O eq 'cygwin') {
my $die="$lin\n ".
"Hint: Make sure there are no quote characters\n".
" used in the /etc/passwd file.\n";
$eval_stdout='';$eval_stderr=$die;
die $eval_stderr;
}
$eval_stdout='';$eval_stderr=$lin;
die $eval_stderr;
} else {
$eval_stdout='';$eval_stderr=$lin;
alarm 0;
die $eval_stderr;
}
}
if ($lin=~/Warning/s) {
$lin=~s/^.*(Warning.*)$/$1/s;
print "\n$lin";sleep 1;
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
} alarm 0;
last if $gotpass;
}
};
if ($@) {
if (wantarray) {
my $error=$@;
if ($@=~/Permission denied/) {
#print "do_slave ONE and ERROR=$error\n";
return ('','read timed-out:do_slave')
} elsif ($@!~/Connection closed/ &&
(-1==index $@, 'name not known')) {
my $err=$@;
eval {
$filehandle->{_cmd_handle}->print;
my $cnt=0;
while (my $line=$filehandle->{_cmd_handle}->get) {
last if $line=~/_funkyPrompt_/s;
$filehandle->{_cmd_handle}->print;
last if $cnt++==10;
}
if ($cnt==11 and (-1<index $err,'read timed-out')
&& !$slave) {
#print "do_slave TWO and ERROR=$error\n";
$error='read timed-out:do_slave';
}
};
if ($error eq 'read timed-out:do_slave') {
#print "do_slave THREE and ERROR=$error\n";
return ('','read timed-out:do_slave')
}
} return '', $error;
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} elsif (wantarray) {
return $eval_stdout,$eval_stderr;
} elsif ($eval_stderr) {
&Net::FullAuto::FA_Core::handle_error($@);
} else {
return $eval_stdout;
}
} ## END of &wait_for_passwd_prompt
sub connect_share
{
my @topcaller=caller;
print "File_Transfer::connect_share() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "File_Transfer::connect_share() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my (@outlines,@errlines)=();
my $cmd_handle=$_[0];
my $hostlabel=$_[1];
my $_connect=$_[2]||'';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$cdtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,$_connect);
my ($output,$stdout,$stderr)=('','','');
my $cnct_passwd='';
my $host=($use eq 'ip')?$ip:$hostname;
my $smb_type='';
#print "THISSS=net view \\\\\\\\$host | perl -pe 's/^/stdout: /' 2>&1";
my @output=$cmd_handle->cmd(
"net view \\\\\\\\$host | perl -pe 's/^/stdout: /' 2>&1");
#print "OUTPUT=@output and CMDHANDLE=$cmd_handle\n";
for (@output) {
push @{ s/stdout: // ? \@outlines : \@errlines }, $_;
} $stdout=join '', @outlines;
$stderr=join '',@errlines;@output=();
if ($stdout) {
if ($stdout=~/^Samba/m) {
$smb_type='Samba';
} else {
$smb_type='cygwin';
}
my $ms_cnct='net use \\\\'.$host.'\\'.$ms_share;
$login_id=$su_id if $su_id;
my $dom='';
if ($ms_domain) {
$dom=$ms_domain.'\\';
} else {
if (($host=~tr/.//)==2) {
$dom=substr($host,0,(index $host,'.')) . '\\';
} else {
$dom=$host.'//';
}
}
if ($su_id) {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
'','__su__');
} else {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,$ms_share,'');
}
while (1) {
my $ms_cmd="$ms_cnct $cnct_passwd /USER:$dom"
.$login_id;
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },$ms_cmd);
if (!$stderr ||
(-1<index $stderr,'credentials supplied conflict')) {
return "\\\\$host\\$ms_share\\",$smb_type,'';
} elsif (-1<index $stderr,'Logon failure') {
if ($su_id) {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
$stderr,'__force__','__su__');
} else {
$cnct_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,$ms_share,
$stderr,'__force__');
}
} else {
$stderr="From Command :\n\n $ms_cmd\n\n "
."$stderr\n $!";
return '','',$stderr;
}
}
} else {
$stderr=~s/^/ /mg;
$stderr=~s/\s*//;
$stderr="From Command :\n\n "
."net view \\\\\\\\$host | perl -pe 's/^/stdout: /' 2>&1"
."\n\n$stderr\n $!";
return '','',$stderr;
}
}
sub cwd
{
my @topcaller=caller;
print "\nINFO: File_Transfer::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nFile_Transfer::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self=$_[0];
my $target_dir=$_[1];
$target_dir||='';
$target_dir=~s/[\/\\]*$//
if $target_dir ne '/' && $target_dir ne '\\';
my $len_tdir=length $target_dir;
my $output='';my $stderr='';
if (unpack('a1',$target_dir) eq '.') {
if ($target_dir eq '.') {
if (wantarray) {
return '\'.\' is Current Directory','';
} else { return '\'.\' is Current Directory' }
} elsif (1<$len_tdir &&
(unpack('a2',$target_dir) eq './')
|| unpack('a2',$target_dir) eq '.\\') {
$target_dir=unpack('x2,a*',$target_dir);
}
}
#print "TARGET_DIR=$target_dir\n";
my $hostlabel=$self->{_hostlabel}->[0]||$self->{_hostlabel}->[1];
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$cwtimeout,$transfer_dir,$ms_chain,
$tn_chain,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$self->{_connect});
my $host=($use eq 'ip')?$ip:$hostname;
if (!$target_dir) {
my @caller=caller;
my $die="The First Argument to cwd is being "
."read by\n $0 as a null or ''. "
."Hint: (Perhaps a\n variable being "
."used to pass the destination-\n "
."directory-name is misspelled) in file\n"
." -> $caller[1] line $caller[2]\n\n";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
if ((exists $self->{_work_dirs}->{_cwd} &&
$target_dir eq $self->{_work_dirs}->{_cwd}) ||
($self->{_work_dirs}->{_cwd_mswin} &&
$target_dir eq $self->{_work_dirs}->{_cwd_mswin})) {
if (wantarray) {
return 'CWD command successful.','';
} else { return 'CWD command successful.' }
}
print $Net::FullAuto::FA_Core::MRLOG "GOING TO EVAL and $self->{_uname}\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
eval {
if (((exists $self->{_smb}) ||
$self->{_uname} eq 'cygwin') &&
($target_dir=~/^\\\\|^([^~.\/\\][^:])/
&& (exists $self->{_work_dirs}->{_cwd_mswin} &&
1<length $self->{_work_dirs}->{_cwd_mswin} &&
unpack('a2',$self->{_work_dirs}->{_cwd_mswin})
eq '\\\\') && !(exists $self->{_cygdrive} &&
$target_dir=~/^$self->{_cygdrive}/))) {
my $td=$1;my $tar_dir='';
if ($td) {
if ($td=~/^[\/\\][^:]/) {
if ($ms_share) {
if (($tar_dir=$target_dir)=~s/\//\\/g) {
$tar_dir=~s/\\/\\\\/g;
}
$tar_dir="\\\\$host\\$ms_share$tar_dir";
} else {
my $die='Cannot Determine Root -or- Drive -or- Share'
."\n for Directory $target_dir";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} elsif (exists $self->{_work_dirs}->{_cwd_mswin} &&
1<length $self->{_work_dirs}->{_cwd_mswin} &&
unpack('a2',$self->{_work_dirs}->{_cwd_mswin})
eq '\\\\') {
if (($tar_dir=$target_dir)=~s/\//\\/g) {
$tar_dir=~s/\\/\\\\/g;
}
$tar_dir=$self->{_work_dirs}->{_cwd_mswin}.$tar_dir;
} else {
my $die='Cannot Determine Root -or- Drive -or- Share'
."\n for Directory $target_dir";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} else {
$tar_dir=$target_dir;
}
my @output=();my $cnt=0;
while (1) {
($output,$stderr)=$self->{_cmd_handle}->
cmd("cmd /c dir /-C \"$tar_dir\"");
if (!$stderr && substr($output,-12,-2) ne 'bytes free') {
$output='';next unless $cnt++;
my $die="Attempt to retrieve output from the command:\n"
."\n cmd /c dir /-C \"$tar_dir\"\n"
."\n run on the host $hostlabel FAILED";
&Net::FullAuto::FA_Core::handle_error($die);
} else { last }
}
my $outdir='';
($outdir=$output)=~s/^.*Directory of ([^\n]*).*$/$1/s;
$outdir=~tr/\0-\37\177-\377//d;
if ($outdir eq $tar_dir) {
$self->{_work_dirs}->{_pre_mswin}=
$self->{_work_dirs}->{_cwd_mswin};
$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';
$output="CWD command successful";
} else {
$output=~s/^.*Directory of [^\n]*(.*)$/$1/s;
my $leaf=substr($tar_dir,(rindex $tar_dir,"\\")+1);
foreach my $line (split /\n/, $output) {
$line=~tr/\0-\37\177-\377//d;
if ($line=~/$leaf$/ and $line!~/\<DIR\>/) {
my $die="Cannot cwd to the FILE:"
."\n\n --> $tar_dir\n\n"
." Because First cwd() Argument"
."\n Must be a Directory.\n";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die) }
}
}
my $die="Cannot cwd to the Directory:"
. "\n\n --> $tar_dir\n\n"
. " The Directory DOES NOT EXIST!\n";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} elsif ($target_dir=~/^([^~.\/\\][^:])/) {
$target_dir=~s/\\/\//g;
$target_dir=$self->{_work_dirs}->{_cwd}
.$target_dir.'/';
($output,$stderr)=$self->{_cmd_handle}->
cmd("cd $target_dir");
my $phost=$hostlabel;
#if ($self->{_cmd_type} eq 'ms_proxy') {
# $phost=$Net::FullAuto::FA_Core::DeployMS_Proxy[0];
#} elsif ($self->{_cmd_type} eq 'tn_proxy') {
# $phost=$Net::FullAuto::FA_Core::DeployTN_Proxy[0];
#}
if ($stderr) {
#my $die="The Transfer Directory on Proxy Host "
my $die="The Transfer Directory on Host "
."- $phost :"
."\n\n --> $target_dir\n\n"
." DOES NOT EXIST!: $!";
if (wantarray) { return '',$die }
else { &Net::FullAuto::FA_Core::handle_error($die,'-12') }
}
if ($self->{_ftm_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_ftm_type =>$self->{_ftm_type} },
"cd \"$target_dir\"",$hostlabel);
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
}
}
$self->{_work_dirs}->{_pre_mswin}=
$self->{_work_dirs}->{_cwd_mswin};
$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';
} elsif ($self->{_uname} eq 'cygwin' &&
$target_dir=~/^[A-Za-z]:/) {
my ($drive,$path)=unpack('a1 x1 a*',$target_dir);
$path=~tr/\\/\//;
my $tar_dir=$self->{_cygdrive}.'/'.lc($drive).$path;
($output,$stderr)=$self->cmd("cd \"$tar_dir\"");
if ($stderr) {
if (wantarray) {
return $output,$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
}
if ($self->{_ftm_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_ftm_type =>$self->{_ftm_type} },
"cd \"$tar_dir\"",$hostlabel);
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
}
}
$self->{_work_dirs}->{_pre}=$self->{_work_dirs}->{_cwd};
$self->{_work_dirs}->{_pre_mswin}=
$self->{_work_dirs}->{_cwd_mswin};
$self->{_work_dirs}->{_cwd}=$tar_dir.'/';
$self->{_work_dirs}->{_cwd_mswin}=$target_dir.'\\';
} else {
if (1<$len_tdir && unpack('a2',$target_dir) eq '..') {
if ($self->{_ftm_type}=~/s*ftp/) {
($output,$stderr)=&Rem_Command::ftpcmd(
{ _ftp_handle=>$self->{_ftp_handle},
_ftm_type =>$self->{_ftm_type} },
'cd \'..\'',$hostlabel);
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
}
}
($output,$stderr)=$self->cmd('cd \'..\'');
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
}
} elsif (unpack('a1',$target_dir) ne '/' &&
unpack('a1',$target_dir) ne '\\' &&
unpack('x1 a1',$target_dir) ne ':') {
eval{
print "WHAT IS REF=",ref $self->{_cmd_handle},"\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "WHAT IS EXISTS=",exists $self->{_cmd_handle}->{_work_dirs},"\n";
print $Net::FullAuto::FA_Core::MRLOG "WHAT IS EXISTS=",exists $self->{_cmd_handle}->{_work_dirs},"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "WHAT IS REFNOW=",ref $self->{_cmd_handle}->{_work_dirs},"\n";
print $Net::FullAuto::FA_Core::MRLOG "WHAT IS REFNOW=",ref $self->{_cmd_handle}->{_work_dirs},"\n" if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
};
if (exists $self->{_work_dirs}->{_cwd}) {
$target_dir=$self->{_work_dirs}->{_cwd}
="$self->{_work_dirs}->{_cwd}/$target_dir/";
} else {
$target_dir=$self->{_work_dirs}->{_cwd_mswin}
="$self->{_work_dirs}->{_cwd_mswin}\\$target_dir\\";
}
}
if (exists $self->{_smb} && $ms_share &&
$target_dir=~/^[\/\\][^\/\\]/ &&
$target_dir!~/$self->{_cygdrive_regex}/) {
my $tdir=$target_dir;
$tdir=~s/^[\/|\\]+//;
$tdir=~tr/\//\\/;
$tdir="\\\\$host\\$ms_share\\$tdir";
my $t_dir=$tdir;
$t_dir=~s/\\/\\\\/g;
if (&Net::FullAuto::FA_Core::test_dir($self->{_cmd_handle},$t_dir)) {
if (exists $self->{_work_dirs}->{_pre_mswin}) {
$self->{_work_dirs}->{_pre_mswin}
=$self->{_work_dirs}->{_cwd_mswin};
$tdir=~s/[\\]*$//;
$self->{_work_dirs}->{_cwd_mswin}=$tdir.'\\';
}
$output='CWD command successful';
return $output,'';
} else {
if (wantarray) {
return '',"Cannot locate $target_dir";
} else {
&Net::FullAuto::FA_Core::handle_error(
"Cannot locate $target_dir");
}
}
} elsif ((exists $self->{_ftm_type}) &&
$self->{_ftm_type}=~/s*ftp/) {
($output,$stderr)=
&Rem_Command::ftpcmd($self,"cd \"$target_dir\"");
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
}
$Net::FullAuto::FA_Core::ftpcwd{$self->{_ftp_handle}}{cd}
=$target_dir;
}
if (($self->{_connect} eq 'connect_host') ||
($self->{_connect} eq 'connect_secure') ||
($self->{_connect} eq 'connect_insecure') ||
($self->{_connect} eq 'connect_ssh_telnet') ||
($self->{_connect} eq 'connect_ssh') ||
($self->{_connect} eq 'connect_telnet') ||
($self->{_connect} eq 'connect_telnet_ssh')) {
($output,$stderr)=$self->cmd("cd \'$target_dir\'");
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else {
$self->{_work_dirs}->{_pre}=$self->{_work_dirs}->{_cwd};
if (exists $self->{_work_dirs}->{_pre_mswin}) {
$self->{_work_dirs}->{_pre_mswin}
=$self->{_work_dirs}->{_cwd_mswin};
my $tdir='';
if (exists $Net::FullAuto::FA_Core::cygpathw{$target_dir}) {
$tdir=$Net::FullAuto::FA_Core::cygpathw{$target_dir};
} else {
($tdir,$stderr)=$self->cmd("cygpath -w $target_dir");
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-4');
}
}
$tdir=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$target_dir}=$tdir;
};
$self->{_work_dirs}->{_cwd_mswin}=$tdir.'\\\\';
}
$self->{_work_dirs}->{_cwd}=$target_dir.'/';
$output='CWD command successful'
}
}
}
};
if ($@) {
chomp($@);
if (-1<index $@,"Transfer Directory") {
if (wantarray) {
return '', $@;
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} else {
my $die=$@;
#$die=~s/\.$//s;
$die=~s/( line.*)[.]$/\n $1/s;
if ($hostlabel=~/Master/) {
$hostlabel='localhost';
}
$die.=" on Host $hostlabel\n";
my $cnt='';my $hnames='';
foreach my $host (@{$self->{_hostlabel}}) {
next if !$cnt++;
next if !$host;
$hnames.="\'$host\', ";
} substr($hnames,-2)='';
$die.=" (Host also has Labels - $hnames)\n"
if $hnames;
if (wantarray) {
return '', "$die";
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
} elsif (wantarray) {
return $output,'';
} else {
return $output;
}
}
sub pwd
{
my ($self) = @_;
if ($self->{_work_dirs}->{_cwd}) {
return $self->{_work_dirs}->{_cwd};
} else {
my $pwd=join '',$self->{"_$self->{_ftm_type}_handle"}->cmd('pwd');
chomp $pwd;return $pwd;
}
}
sub tmp
{
my $self=$_[0];
my $path=$_[1];
$path||='';
my $token=$_[2];
$token||='';
my ($output,$stderr)=('','');
if ($token=~/[Ww_1]/ && $token!~/[UuXx]/) { $token=1 } else { $token=0 }
if ($path) {
if ($path=~/^[\/|\\]|[a-zA-Z]:/) {
&Net::FullAuto::FA_Core::handle_error("Path: $path\n Must NOT be Fully "
."Qualified\n "
."(Hint: Must not begin with Drive Letter, or UNC, or '/')"
."\n Example: path/to/tmp -Not- b:\\path\\to\\tmp"
."\n or \\\\computer\\share\\path"
."\n or /path/to/tmp");
}
$path=~tr/\\/\//;
}
my $tdir='tmp'.$self->{_cmd_pid}.'_'
.$Net::FullAuto::FA_Core::invoked[0].'_'.$Net::FullAuto::FA_Core::increment++;
my $return_path='';
if ($token) {
$path=~tr/\\/\//;
$path=~s/\//\\/g;
$path=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::tmp_files_dirs{$self->{_cmd_handle}}=[
$self->{_work_dirs}->{_tmp},$tdir ];
($output,$stderr)=$self->cmd('mkdir -p '.
$self->{_work_dirs}->{_tmp}.'/'.$tdir);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
$return_path=$self->{_work_dirs}->{_tmp_mswin}
.$tdir.'\\'.$path;
} else {
$path=~tr/\\/\//;
$Net::FullAuto::FA_Core::tmp_files_dirs{$self->{_cmd_handle}}=[
$self->{_work_dirs}->{_tmp},$tdir ];
($output,$stderr)=$self->cmd('mkdir -p '.
$self->{_work_dirs}->{_tmp}.'/'.$tdir);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
$return_path=$self->{_work_dirs}->{_tmp}.$tdir.'/'.$path;
} return $return_path;
}
sub diff
{
push @_, '_diff';
return &mirror(@_);
}
sub mirror
{
my $_diff=0;
if ($_[$#_] eq '_diff') {
pop @_;
$_diff=1;
}
my ($baseFH, %args) = @_;
unless (exists $baseFH->{_ftp_handle} ||
!$same_host_as_Master{$baseFH->{_hostlabel}}) {
my $die="The \"BaseHost =>\" Argument to &mirror()"
."\n -> \"$baseFH->{_hostlabel}->[0]\" "
." Does not have an embedded SFTP connection\n "
." -> Be sure to use &connect_host() when"
." creating a base\n host connection to"
." be used with &mirror() when base"
."\n host is not the localhost.";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
my $dest_output='';my $base_output='';my $lsgnu=0;
my $num_of_levels='';my $mirrormap='';my $trantar='';
my $trandir='';my $chk_id='';my $local_transfer_dir='';
my $destFH={};my $bprxFH='';my $dprxFH='';
my $sub=(caller(1))[3];$sub=~s/\s*FA_Core::/&/;
my $caller='';my $cline='';my $mirror_output='';
my $debug_info='';$deploy_info='';my $dir='';
my $mirror_debug='';my $excluded='';
my $base_unzip_path='';my $dest_unzip_path='';
my $base_zip_path='';
my ($output,$stdout,$stderr)=('','','');
$args{ZipBDir}||='';
$args{ZipDDir}||='';
($caller,$cline)=(caller)[1,2];
if (ref $args{DestHost} eq 'ARRAY') {
@dhostlabels=@{$args{DestHost}};
} elsif (4<length $args{DestHost} && unpack('a5',$args{DestHost})
eq 'ARRAY') {
&Net::FullAuto::FA_Core::handle_error(
"quotes improperly surround destination hostlabel(s) arg");
} else { @dhostlabels=();push @dhostlabels, $args{DestHost} }
foreach my $dest_hlabel (@dhostlabels) {
unless (exists $Net::FullAuto::FA_Core::Hosts{$dest_hlabel}) {
my $die="The \"DestHost =>\" Argument to &mirror()"
."\n -> \"$dest_hlabel\" Called"
." from the User Defined Subroutine\n "
." -> $sub is NOT\n a Valid"
." Host Label in the \"subs\" Subroutine File"
."\n -> $caller line $cline.\n";
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
} else {
last;
}
}
my $bhostlabel=$baseFH->{_hostlabel}->[0];
my $dhostlabel=$dhostlabels[0];
my $base_fdr=$args{BaseFileOrDir} || $args{BaseDir} || $args{BaseFile};
my $verbose=(exists $args{Verbose} && $args{Verbose}) ? 1 : 0;
$base_fdr||='';
$base_fdr=~s/[\/|\\]*$//;
if (unpack('a1',$base_fdr) eq '~') {
($stdout,$stderr)=$baseFH->cmd('echo ~');
$base_fdr=~s/~/$stdout/s;
}
my $dest_fdr=$args{DestDir};
$dest_fdr||='';
$dest_fdr=~s/[\/|\\]*$//;
my ($bip,$bhostname,$buse,$bms_share,$bms_domain,
$bcmd_cnct,$bftr_cnct,$blogin_id,$bsu_id,$bchmod,
$bowner,$bgroup,$btimeout,$btransfer_dir,$brcm_chain,
$brcm_map,$buname,$bping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($bhostlabel,
$baseFH->{_connect});
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$btimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$btimeout) {
$btimeout=$timeout if !$btimeout;
}
my $bhost=($buse eq 'ip')?$bip:$bhostname;
$bms_share||='';$btransfer_dir||='';
my ($dip,$dhostname,$duse,$dms_share,$dms_domain,
$dcmd_cnct,$dftr_cnct,$dlogin_id,$dsu_id,$dchmod,
$downer,$dgroup,$dtimeout,$dtransfer_dir,$drcm_chain,
$drcm_map,$duname,$dping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($dhostlabel,
$destFH->{_connect});
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$dtimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$dtimeout) {
$dtimeout=$timeout if !$dtimeout;
} my $do_dest_tmp_cwd=1;
if ($baseFH->{_uname} ne 'cygwin' &&
$baseFH->{_hostlabel}->[0] ne "__Master_${$}__") {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,'lcd .');
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
}
$local_transfer_dir=unpack('x20 a*',$output);
$local_transfer_dir.='/';
($output,$stderr)=$baseFH->cwd($base_fdr) if $base_fdr;
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{cd}=$base_fdr;
}
if ((exists $baseFH->{_smb})
|| $baseFH->{_uname} eq 'cygwin') {
my $test_chr1='';my $test_chr2='';
if ($base_fdr) {
$test_chr1=unpack('a1',$base_fdr);
if (1<length $base_fdr) {
$test_chr2=unpack('a2',$base_fdr);
}
if ($test_chr2) {
if (($test_chr1 eq '/' && $test_chr2 ne '//')
|| ($test_chr1 eq '\\' &&
$test_chr2 ne '\\\\')) {
$dir=$base_fdr;
if ($base_fdr=~/$baseFH->{_cygdrive_regex}/) {
$dir=~s/$baseFH->{_cygdrive_regex}//;
$dir=~s/^(.)/$1:/;
$dir=~tr/\//\\/;
($output,$stderr)=$baseFH->cwd($base_fdr);
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');
}
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{
$baseFH->{_ftp_handle}}{cd}=$base_fdr;
$do_dest_tmp_cwd=0;
} elsif ($bms_share) {
$dir="\\\\$bhost\\$bms_share";
$base_fdr=~tr/\//\\/;
$dir.=$base_fdr;
} else {
if (exists $Net::FullAuto::FA_Core::cygpathw{$dir}) {
$dir=$Net::FullAuto::FA_Core::cygpathw{$dir};
} else {
($dir,$stderr)=$baseFH->cmd("cygpath -w $dir");
&handle_error($stderr,'-1') if $stderr;
$dir=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$dir}=$dir;
}
($output,$stderr)=$baseFH->cwd($base_fdr);
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');
}
} else { $stderr='' }
if (exists $baseFH->{_ftp_handle} ||
!$same_host_as_Master{$baseFH->{_hostlabel}->[0]}) {
$Net::FullAuto::FA_Core::ftpcwd{
$baseFH->{_ftp_handle}}{cd}=$base_fdr;
}
$do_dest_tmp_cwd=0;
}
} elsif ($test_chr2 eq '//' ||
$test_chr2 eq '\\\\') {
$dir=$base_fdr;
} elsif ($test_chr2=~/^[a-zA-Z]:$/) {
$dir=$base_fdr;
($output,$stderr)=$baseFH->cwd($base_fdr);
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-4');
}
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{
$baseFH->{_ftp_handle}}{cd}=$base_fdr;
$do_dest_tmp_cwd=0;
} elsif ($test_chr1!~/\W/) {
$dir=$baseFH->{_work_dirs}->{_cwd}.$base_fdr;
($output,$stderr)=$baseFH->cwd($dir);
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-4') }
} else { $stderr='' }
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{cd}=$dir;
$do_dest_tmp_cwd=0;
} elsif ($test_chr1 ne '~') {
&Net::FullAuto::FA_Core::handle_error(
"Base Directory - $base_fdr CANNOT Be Located");
}
} elsif ($test_chr1 eq '/' || $test_chr1 eq '\\') {
if ($baseFH->{_work_dirs}->{_cwd}=~
/$baseFH->{_cygdrive_regex}/) {
($dir=$baseFH->{_work_dirs}->{_cwd})=~
s/$baseFH->{_cygdrive_regex}//;
$dir=s/^(.)/$1:/;
$dir=~tr/\//\\/;
} else {
$dir=$baseFH->{_work_dirs}->{_cwd};
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
$dir=$test_chr1.':/';
} elsif ($test_chr1 eq '.') {
$dir=$baseFH->{_cwd};
} elsif ($test_chr1 ne '~') {
&Net::FullAuto::FA_Core::handle_error(
"Base Directory - $base_fdr CANNOT Be Located");
} my $cnt=0;
} else {
$dir=$baseFH->{_work_dirs}->{_cwd};
#print "WHAT IS THE DIRRRRRR=$dir<== and THIS=$baseFH->{_cwd}\n";<STDIN>;
} my $cnt=0;
if (!exists $base_shortcut_info{$baseFH} ||
$base_shortcut_info{$baseFH} ne $dir ||
!(exists $args{ReUseAnalysis} && $args{ReUseAnalysis})) {
while (1) {
($base_output,$stderr)=$baseFH->cmd(
"cmd /c dir /s /-C /A- \"$dir\"",'__delay__');
if ($stderr) {
my $die=$stderr;
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
$base_shortcut_info{$baseFH}=$dir;
if (exists $baseFH->{_unaltered_basehash} &&
$baseFH->{_unaltered_basehash}) {
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
my $elems=$#{${$baseFH->{_unaltered_basehash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key}[$elems]
ne 'HASH') {
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}) {
if (${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}};
} delete ${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key};
} undef %{${$baseFH->{_unaltered_basehash}}
{$key}[$elems]};
undef ${$baseFH->{_unaltered_basehash}}
{$key}[$elems];
}
} undef ${$baseFH->{_unaltered_basehash}}{$key};
delete ${$baseFH->{_unaltered_basehash}}{$key};
} undef %{$baseFH->{_unaltered_basehash}};
$baseFH->{_unaltered_basehash}='';
}
if (!$stderr && $base_output!~/bytes free\s*/s) {
delete $base_shortcut_info{$baseFH};
$base_output='';next unless $cnt++;
my $die="Attempt to retrieve output from the command:\n"
."\n cmd /c dir /-C \"$dir\"\n\n run"
." on the host $baseFH->{_hostlabel}->[0] FAILED\n";
&Net::FullAuto::FA_Core::handle_error($die);
} else { last }
}
} else {
$baseFH->{_bhash}={}; # cygwin
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_unaltered_basehash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_bhash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$baseFH->{_bhash}}{$key}}, \%newelem;
}
}
} else {
${$baseFH->{_bhash}}{$key}= # cygwin
${$baseFH->{_unaltered_basehash}}{$key};
}
}
} &Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
} elsif ($base_fdr) {
my $dir='';
if (unpack('a1',$base_fdr) ne '/' && $base_fdr!~/^\W/) {
$dir=$baseFH->{_work_dirs}->{_cwd}.$base_fdr;
} elsif (unpack('a1',$base_fdr) eq '/') {
$dir=$base_fdr;
} else {
print "BASE3\n";
&Net::FullAuto::FA_Core::handle_error(
"Base Directory - $base_fdr CANNOT Be Located");
}
if (!exists $base_shortcut_info{$baseFH} ||
$base_shortcut_info{$baseFH} ne $dir) {
if (exists $args{BaseZip} && -f $dir.'/'.$args{BaseZip}) {
if (-e '/usr/bin/unzip') {
$base_unzip_path='/usr/bin/';
} elsif (-e '/bin/unzip') {
$base_unzip_path='/bin/';
} elsif (-e '/usr/local/bin/unzip') {
$base_unzip_path='/usr/local/bin/';
}
if (-e '/usr/bin/zip') {
$base_zip_path='/usr/bin/';
} elsif (-e '/bin/zip') {
$base_zip_path='/bin/';
} elsif (-e '/usr/local/bin/zip') {
$base_zip_path='/usr/local/bin/';
}
($base_output,$stderr)=$baseFH->cmd(
"${base_unzip_path}unzip -l $dir/$args{BaseZip}");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
if ($args{ZipBDir}) {
my $bo='';
foreach my $ln (split "\n", $base_output) {
next if -1<index $ln,'Archive:';
next unless -1<index $ln,$args{ZipBDir};
$bo.=$ln."\n";
} chop $bo;
$base_output=$bo;
}
} else {
my $ls_path='';
if ($baseFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};
$ls_path.='/' if $ls_path!~/\/$/;
}
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls --version");
if (-1<index $base_output,'GNU') {
$lsgnu=1;
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs --block-size=1 \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
} else {
($base_output,$stderr)=
$baseFH->cmd("${ls_path}ls -lRFs \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
}
if ($stderr) {
my $die=$stderr;
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
} elsif (unpack('x2a1',$base_output) eq 'l' ||
unpack('x4a1',$base_output) eq 'l') {
$dir=substr($base_output,(index $base_output,'-> .')+4);
$dir=~s/\/?$//;
$base_fdr=$dir;
if ($lsgnu) {
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs --block-size=1 \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__
."\n" if $stderr;
} else {
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRFs \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__
."\n" if $stderr;
}
if ($stderr) {
my $die=$stderr;
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
}
}
$base_shortcut_info{$baseFH}=$dir;
if ($baseFH->{_unaltered_basehash}) {
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
my $elems=$#{${$baseFH->{_unaltered_basehash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key}[$elems]
ne 'HASH') {
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}) {
if (${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}};
} delete ${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key};
} undef %{${$baseFH->{_unaltered_basehash}}{$key}[$elems]};
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];
}
} undef ${$baseFH->{_unaltered_basehash}}{$key};
delete ${$baseFH->{_unaltered_basehash}}{$key};
} undef %{$baseFH->{_unaltered_basehash}};
$baseFH->{_unaltered_basehash}='';
}
}
} elsif (!exists $base_shortcut_info{$baseFH} ||
$base_shortcut_info{$baseFH} ne $dir) {
my $dir=$baseFH->{_work_dirs}->{_cwd};
$base_shortcut_info{$baseFH}=$dir;
my $ls_path='';
if ($baseFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};
$ls_path.='/' if $ls_path!~/\/$/;
}
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls --version");
if (-1<index $base_output,'GNU') {
$lsgnu=1;
($base_output,$stderr)=$baseFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
} else {
($base_output,$stderr)=$baseFH->cmd("${ls_path}ls -lRs \'$dir\'");
$stderr.="\n\n at ".(caller(0))[1]." line ".__LINE__."\n"
if $stderr;
}
if ($baseFH->{_unaltered_basehash}) { # line 7144
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
my $elems=$#{${$baseFH->{_unaltered_basehash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key}[$elems]
ne 'HASH') {
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}) {
if (${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key}};
} delete ${${$baseFH->{_unaltered_basehash}}
{$key}[$elems]}{$key};
} undef %{${$baseFH->{_unaltered_basehash}}{$key}[$elems]};
undef ${$baseFH->{_unaltered_basehash}}{$key}[$elems];
}
} undef ${$baseFH->{_unaltered_basehash}}{$key};
delete ${$baseFH->{_unaltered_basehash}}{$key};
} undef %{$baseFH->{_unaltered_basehash}};
$baseFH->{_unaltered_basehash}='';
}
} else {
$baseFH->{_bhash}={};
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_unaltered_basehash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_bhash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$baseFH->{_bhash}}{$key}}, \%newelem;
}
}
} else {
${$baseFH->{_bhash}}{$key}=${$baseFH->{_unaltered_basehash}}{$key};
}
}
}
if ($stderr) {
if (unpack('a10',$stderr) eq 'The System') {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr) }
} else {
my $die="The System $bhostlabel Returned\n "
." the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]
." line ".(caller(0))[2]." :\n\n $stderr";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$die;
} else { &Net::FullAuto::FA_Core::handle_error($die) }
}
}
my $mdh=0;
my $timehash={};
if (!$baseFH->{_bhash}) {
my $hostlabel='';
eval {
my $ignore='';
($ignore,$stderr)=&build_base_dest_hashes(
$base_fdr,\$base_output,$args{Directives},
$bhost,$bms_share,$bms_domain,
$baseFH->{_uname},$baseFH,'BASE',$lsgnu,$args{ZipBDir});
if ($stderr) {
if ($stderr eq 'redo ls') {
while (1) {
my $err='';
my $ls_path='';
if ($_[7]->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};
$ls_path.='/' if $ls_path!~/\/$/;
}
if ($lsgnu) {
($base_output,$err)=$_[7]->cmd(
"${ls_path}ls -lRs --block-size=1 \'$_[0]\'");
} else {
($base_output,$err)=$_[7]->cmd(
"${ls_path}ls -lRs \'$_[0]\'");
}
&Net::FullAuto::FA_Core::handle_error($err,'-3') if $err;
($ignore,$stderr)=&build_base_dest_hashes(
$base_fdr,\$base_output,$args{Directives},
$bhost,$bms_share,$bms_domain,
$baseFH->{_uname},$baseFH,'BASE',$lsgnu,$args{ZipBDir});
next if $stderr eq 'redo ls';
last;
}
} else {
$hostlabel=$bhostlabel;
&Net::FullAuto::FA_Core::handle_error($stderr,'__cleanup__');
}
}
};
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','',"$@";
} else {
my $die="The System $hostlabel Returned\n "
." the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]
." line ".(caller(0))[2]." :\n\n $@";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return '','','',$die;
}
}
## CREATING UNALTERED BASE HIGH
$baseFH->{_unaltered_basehash}={};
foreach my $key (keys %{$baseFH->{_bhash}}) {
if (ref ${$baseFH->{_bhash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_bhash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_unaltered_basehash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$baseFH->{_unaltered_basehash}}{$key}}, \%newelem;
}
}
} else {
${$baseFH->{_unaltered_basehash}}{$key}=${$baseFH->{_bhash}}{$key};
}
}
}
foreach my $dhostlabel (@dhostlabels) {
my $activity=0;
%Net::FullAuto::FA_Core::file_rename=();
%Net::FullAuto::FA_Core::rename_file=();
($dip,$dhostname,$duse,$dms_share,$dms_domain,
$dcmd_cnct,$dftr_cnct,$dlogin_id,$dsu_id,$dchmod,
$downer,$dgroup,$dtimeout,$dtransfer_dir,$drcm_chain,
$drcm_map,$duname,$dping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($dhostlabel);
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$dtimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$dtimeout) {
$dtimeout=$timeout if !$dtimeout;
}
##=======================================
## DOES DESTHOST CONNECTION EXIST?
##=======================================
if ((($dip eq $Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'IP'}) ||
($dhostname eq $Net::FullAuto::FA_Core::Hosts{
"__Master_${$}__"}{'HostName'})) && !exists
$Net::FullAuto::FA_Core::Hosts{$dhostlabel}{
'sshport'}) {
$dhostlabel="__Master_${$}__";
$destFH=$Net::FullAuto::FA_Core::localhost;
($output,$stderr)=$destFH->cwd($destFH->{_work_dirs}->{_tmp});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} else {
if ($dsu_id) { $chk_id=$dsu_id }
elsif ($dlogin_id) { $chk_id=$dlogin_id }
else { $chk_id=$Net::FullAuto::FA_Core::username }
if (exists $Net::FullAuto::FA_Core::Connections{
"${dhostlabel}__%-$chk_id"}) {
$destFH=$Net::FullAuto::FA_Core::Connections{
"${dhostlabel}__%-$chk_id"};
if ($destFH->{_uname} ne $baseFH->{_uname} ||
$do_dest_tmp_cwd) {
if (defined $destFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=$destFH->cwd(
$destFH->{_work_dirs}->{_tmp}||
$destFH->{_work_dirs}->{_tmp_mswin});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
} else {
if (exists $args{DestTimeout}) {
$dtimeout=$args{DestTimeout};
}
($destFH,$stderr)=&Net::FullAuto::FA_Core::connect_host(
$dhostlabel,$dtimeout);
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
}
if ($destFH->{_work_dirs}->{_tmp}
&& (exists $destFH->{_smb}) && ($destFH->{_uname}
ne $baseFH->{_uname})) {
($output,$stderr)=$destFH->cwd(
$destFH->{_work_dirs}->{_tmp});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
}
}
$dms_share||='';
$dtransfer_dir||='';
my $dest_dir='';
my $dhost=($duse eq 'ip')?$dip:$dhostname;
my $die="The System $dhost Returned"
."\n the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]." "
."line ".(caller(0))[2]." :\n\n ";
my $err='';
($dest_output,$dest_dir,$err)=get_dest_ls_output(
$destFH,$dest_fdr,$dms_share,$dhost,$die);
($output,$stderr)=$destFH->cwd($dest_dir)
if $dest_fdr && (!exists $destFH->{_smb});
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else { &Net::FullAuto::FA_Core::handle_error($stderr,'-7'); }
}
if (ref $dest_first_hash eq 'HASH') {
foreach my $key (keys %{$destFH->{_dhash}}) {
my $elems=$#{${$destFH->{_dhash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$destFH->{_dhash}}{$key}[$elems] ne 'HASH') {
undef ${$destFH->{_dhash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$destFH->{_dhash}}{$key}[$elems]}) {
if (${${$destFH->{_dhash}}{$key}[$elems]}{$key}) {
undef @{${${$destFH->{_dhash}}{$key}[$elems]}{$key}};
} delete ${${$destFH->{_dhash}}{$key}[$elems]}{$key};
} undef %{${$destFH->{_dhash}}{$key}[$elems]};
undef ${$destFH->{_dhash}}{$key}[$elems];
}
} undef ${$destFH->{_dhash}}{$key};
delete ${$destFH->{_dhash}}{$key};
} undef %{$destFH->{_dhash}};
foreach my $key (keys %{$baseFH->{_bhash}}) {
my $elems=$#{${$baseFH->{_bhash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$baseFH->{_bhash}}{$key}[$elems] ne 'HASH') {
undef ${$baseFH->{_bhash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$baseFH->{_bhash}}{$key}[$elems]}) {
if (${${$baseFH->{_bhash}}{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_bhash}}{$key}[$elems]}{$key}};
} delete ${${$baseFH->{_bhash}}{$key}[$elems]}{$key};
} undef %{${$baseFH->{_bhash}}{$key}[$elems]};
undef ${$baseFH->{_bhash}}{$key}[$elems];
}
} undef ${$baseFH->{_bhash}}{$key};
print "WHY ARE WE DELETING THE KEY=$key<==\n";sleep 1;
delete ${$baseFH->{_bhash}}{$key};
} undef %{$baseFH->{_bhash}};$baseFH->{_bhash}={};
foreach my $key (keys %{$baseFH->{_unaltered_basehash}}) {
if (ref ${$baseFH->{_unaltered_basehash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_unaltered_basehash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_bhash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$baseFH->{_bhash}}{$key}}, \%newelem;
}
}
} else {
${$baseFH->{_bhash}}{$key}=
${$baseFH->{_unaltered_basehash}}{$key};
}
}
}
my $hostlabel='';
eval {
my $ignore='';
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',$lsgnu,$args{ZipDDir});
if ($stderr) {
if ($stderr eq 'redo ls' ||
$stderr=~/does not exist/s) {
while (1) {
my $dest_output='';my $err='';
my $ls_path='';
if ($destFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};
$ls_path.='/' if $ls_path!~/\/$/;
}
if ($lsgnu) {
($dest_output,$err)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_fdr\'");
} else {
($dest_output,$err)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_fdr\'");
}
&Net::FullAuto::FA_Core::handle_error($err,'-3') if $err;
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',$lsgnu,$args{ZipDDir});
next if $stderr eq 'redo ls';
last;
}
} else {
$hostlabel=$dhostlabel;
&Net::FullAuto::FA_Core::handle_error($stderr,'-3');
}
}
};
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','',"$@";
} else {
my $die="The System $hostlabel Returned\n "
." the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]
." line ".(caller(0))[2]." :\n\n $@";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return '','','',$die;
}
}
my $newborn_dest_first_hash_flag=0;
if (ref $dest_first_hash ne 'HASH') {
## BUILDING FIRST DEST HASH
$dest_first_hash={};$newborn_dest_first_hash_flag=1;
foreach my $key (keys %{$destFH->{_dhash}}) {
if (ref ${$destFH->{_dhash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$destFH->{_dhash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$dest_first_hash}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
if (${${$elem}{$key}}[0] ne 'EXCLUDE') {
$newelem{$key}=[@{${$elem}{$key}}];
}
}
push @{${$dest_first_hash}{$key}}, \%newelem;
}
}
} else {
${$dest_first_hash}{$key}=${$destFH->{_dhash}}{$key};
}
}
}
my $shortcut=1;
if (!$newborn_dest_first_hash_flag) {
my $fdh=0;
TK: foreach my $key (keys %{$destFH->{_dhash}}) {
$fdh=1;
#print "SEARCHINGKEY=$key and VALUE=${$dest_first_hash}{$key}<==\n";
if (exists ${$dest_first_hash}{$key}) {
my %firstscalelems=();
my %firsthashelems=();
#print "MAKING NEW FIRSTHASHELEMS and ALL=",@{${$dest_first_hash}{$key}},"\n";
foreach my $felem (@{${$dest_first_hash}{$key}}) {
#print "ARE ALL FELEMS HASHES=$felem<==\n";
if ($felem eq 'EXCLUDE') {
delete ${$dest_first_hash}{$key};
next TK;
}
if (ref $felem ne 'HASH') {
#delete ${$dest_first_hash}{$key};
$firstscalelems{$felem}='-';
next;
}
#print "KEYSSSSBABYYYY=",keys %{${${$dest_first_hash}{$key}}[1]},"<==\n";
#<STDIN>;
foreach my $key (keys %{$felem}) {
#print "POPULATINGFIRST KEY=$key and VALUE=@{${$felem}{$key}}\n";
$firsthashelems{$key}=${$felem}{$key};
}
} my $elemnum=-1;
foreach my $elem (@{${$destFH->{_dhash}}{$key}}) {
if ($elem eq 'EXCLUDE') {
delete ${$dest_first_hash}{$key};
next TK;
}
if (ref $elem ne 'HASH') {
if (!exists $firstscalelems{$elem}) {
print "DEST SUBVALUE=$elem DOES NOT EXIST IN FIRST\n";
print "SETTING SHORTCUT TO ZERO 1\n";<STDIN>;
$shortcut=0;last;
}
} else {
#print "PARENTKEY=$key\n";
#print "ELEMSKEYSSSSSSSSSSSSSSSS=",keys %{$elem},"<==\n";
#print "FIRSTHASHSSSSSSSSSSSSSSSS=",keys %firsthashelems,"<==\n";
if (keys %{$elem}) {
if (keys %firsthashelems) {
foreach my $elm (keys %{$elem}) {
if (!exists $firsthashelems{$elm}) {
#print "0_DEST SUBHASHKEY=$elm DOES NOT EXIST IN FIRST and DIR=$key\n";
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($elm,$key)
if $Net::FullAuto::FA_Core::f_sub;
if ($return &&
(-1<index $returned_modif,'e')) {
delete
${${$destFH->{_dhash}}{$key}}[$elemnum];
next TK;
}
print "SETTING SHORTCUT TO ZERO 2\n";
$shortcut=0;last;
} else {
my $arr1=join '',@{${$elem}{$elm}};
my $arr2=join '',@{$firsthashelems{$elm}};
if ($arr1 ne $arr2) {
my ($mn1,$dy1,$hr1,$mt1,$yr1,$sz1)=
split ' ',$arr1;
my ($mn2,$dy2,$hr2,$mt2,$yr2,$sz2)=
split ' ',$arr2;
if ($sz1==$sz2) {
my $testnum='';
if ($hr1<$hr2) {
$testnum=$hr2-$hr1;
} else { $testnum=$hr1-$hr2 }
if ($testnum==1 || ($hr1==23
&& ($testnum==12 ||
$testnum==11)) ||
("$mn1$dy1" eq "$mn2$dy2"
&& (($hr1 eq '12' &&
$mt1 eq '00') ||
($hr2 eq '12' &&
$mt2 eq '00')))) {
delete ${$dest_first_hash}{$key};
next TK;
}
}
print "0_ELEM VALUE=",$arr1,"<== DOES NOT EXIST IN FIRST\n";
print "OKAY WHAT THE HECK IS THE ELEM VALUE=",$arr1,"<==\n";
print "OKAY WHAT THE HECK IS THE FVALUE=",$arr2,"<==\n";#<STDIN>;
print "SETTING SHORTCUT TO ZERO 3\n";sleep 3;
$shortcut=0;last;
}
}
} last if !$shortcut;
} else {
print "0_ELEM BUT NOT FIRST\n";
print "SETTING SHORTCUT TO ZERO 4\n";<STDIN>;
$shortcut=0;last;
}
} elsif (keys %firsthashelems) {
print "0_FIRSTHASHELEMS=",keys %firsthashelems,"\n";
print "SETTING SHORTCUT TO ZERO 5\n";<STDIN>;
$shortcut=0;last;
}
}
} last if !$shortcut;
} else {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key)
if $Net::FullAuto::FA_Core::d_sub;
if ($return &&
-1<index $returned_modif,'e') {
delete
${$destFH->{_dhash}}{$key};
next TK;
} else { $shortcut=0;
print "0_DEST KEY=$key DOES NOT EXIST IN FIRST\n";
print "SETTING SHORTCUT TO ZERO 6\n";sleep 6;
}
} last if !$shortcut;
} $dest_first_hash={} if !$fdh;
} else {
## BUILDING FIRST BASE HASH
$baseFH->{_first_hash}={};
foreach my $key (keys %{$baseFH->{_bhash}}) {
#print "DO WE HAVE A KEY=$key<==\n";<STDIN>;
if (ref ${$baseFH->{_bhash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_bhash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_first_hash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$baseFH->{_first_hash}}{$key}}, \%newelem;
}
}
} else {
${$baseFH->{_first_hash}}{$key}=${$baseFH->{_bhash}}{$key};
}
}
%Net::FullAuto::FA_Core::renamefile=
%Net::FullAuto::FA_Core::rename_file;
$shortcut=0;
}
#print "WHAT IS SHORTCUT AFTER LOOKING AT FIRSTDESTHASH=$shortcut\n";sleep 5;
if ($shortcut) {
foreach my $key (keys %{$baseFH->{_bhash}}) {
my $elems=$#{${$baseFH->{_bhash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$baseFH->{_bhash}}{$key}[$elems] ne 'HASH') {
undef ${$baseFH->{_bhash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$baseFH->{_bhash}}{$key}[$elems]}) {
if (${${$baseFH->{_bhash}}{$key}[$elems]}{$key}) {
undef @{${${$baseFH->{_bhash}}{$key}[$elems]}{$key}};
} delete ${${$baseFH->{_bhash}}{$key}[$elems]}{$key};
} undef %{${$baseFH->{_bhash}}{$key}[$elems]};
undef ${$baseFH->{_bhash}}{$key}[$elems];
}
} undef ${$baseFH->{_bhash}}{$key};
delete ${$baseFH->{_bhash}}{$key};
} undef %{$baseFH->{_bhash}};$baseFH->{_bhash}={};
foreach my $key (keys %{$baseFH->{_first_hash}}) {
if (ref ${$baseFH->{_first_hash}}{$key} eq 'ARRAY') {
foreach my $elem (@{${$baseFH->{_first_hash}}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$baseFH->{_bhash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$baseFH->{_bhash}}{$key}}, \%newelem;
}
}
} else {
${$baseFH->{_bhash}}{$key}=${$baseFH->{_first_hash}}{$key};
}
}
foreach my $key (keys %{$destFH->{_dhash}}) {
my $elems=$#{${$destFH->{_dhash}}{$key}}+1;
while (-1<--$elems) {
if (ref ${$destFH->{_dhash}}{$key}[$elems] ne 'HASH') {
undef ${$destFH->{_dhash}}{$key}[$elems];
} else {
foreach my $key (
keys %{${$destFH->{_dhash}}{$key}[$elems]}) {
if (${${$destFH->{_dhash}}{$key}[$elems]}{$key}) {
undef @{${${$destFH->{_dhash}}{$key}[$elems]}{$key}};
} delete ${${$destFH->{_dhash}}{$key}[$elems]}{$key};
} undef %{${$destFH->{_dhash}}{$key}[$elems]};
undef ${$destFH->{_dhash}}{$key}[$elems];
}
} undef ${$destFH->{_dhash}}{$key};
delete ${$destFH->{_dhash}}{$key};
} undef %{$destFH->{_dhash}};$destFH->{_dhash}={};
foreach my $key (keys %{$dest_first_hash}) {
if (ref ${$dest_first_hash}{$key} eq 'ARRAY') {
foreach my $elem (@{${$dest_first_hash}{$key}}) {
if (ref $elem ne 'HASH') {
push @{${$destFH->{_dhash}}{$key}}, $elem;
} else {
my %newelem=();
foreach my $key (keys %{$elem}) {
$newelem{$key}=[@{${$elem}{$key}}];
}
push @{${$destFH->{_dhash}}{$key}}, \%newelem;
}
}
} else {
${$destFH->{_dhash}}{$key}=${$dest_first_hash}{$key};
}
}
}
$dest_output='';$deploy_info='';
($baseFH,$destFH,$timehash,$deploy_info,$debug_info)
=&build_mirror_hashes($baseFH,$destFH,$bhostlabel,
$dhostlabel,$verbose);
$mirror_output.="\n### mirror() output for Base Host:"
." $bhostlabel\n and Destination Host:"
." $dhostlabel\n\n $deploy_info";
$mirror_debug.="\n### mirror() debug for Base Host:\n"
." $bhostlabel\n and Destination Host:"
." $dhostlabel\n\n $debug_info";
#print "WHAT IS THIS=",keys %{$baseFH},"\n";
#print "KEYSBASEHASH=",keys %{$baseFH->{_bhash}},"\n";
#print "KEYSDESTHASH=",keys %{$destFH->{_dhash}},"\n";
#print "KEYSTIMEHASH=",keys %{$timehash},"\n";
if (keys %{$baseFH->{_bhash}}) {
if ($baseFH->{_uname} ne 'cygwin' ||
$base_fdr!~/^[\/|\\][\/|\\]/ ||
!$bms_share || !$#{$baseFH->{_hostlabel}}) {
#my $base__dir=$baseFH->{_work_dirs}->{_cwd};
my $base__dir=$base_fdr;
my $bcurdir=$baseFH->{_work_dirs}->{_tmp};
my $aix_tar_input_variable_flag=0;
my $aix_tar_input_variable1='';
my $aix_tar_input_variable2='';
my $gnu_tar_input_file_flag=0;
my $gnu_tar_input_file1='';
my $gnu_tar_input_file2='';
my $gnu_tar_input_list1='';
my $gnu_tar_input_list2='';
my $solaris_tar_input_variable_flag=0;
my $solaris_tar_input_variable1='';
my $solaris_tar_input_variable2='';
my @dirt=();my $tmp_dir='';
if ($baseFH->{_uname} eq 'cygwin' &&
$destFH->{_uname} eq 'cygwin' &&
$dest_fdr=~/^[\/|\\][\/|\\]*/ &&
$dms_share && $#{$destFH->{_hostlabel}}) {
my $de_f=$dest_fdr;
$de_f=~s/^[\/\\]+//;
$de_f=~tr/\//\\/;my $ps='/';
if (exists $destFH->{_smb}) {
$dir="\\\\$dhost\\$dms_share\\$de_f";
$ps='\\';
} else {
$dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';
}
my @basekeys=sort keys %{$baseFH->{_bhash}};
while (my $key=shift @basekeys) {
my @files=();
foreach my $file
(keys %{${$baseFH->{_bhash}}{$key}[1]}) {
if (${$baseFH->{_bhash}}{$key}[1]
{$file}[0] ne 'EXCLUDE'
&& unpack('a4',
${$baseFH->{_bhash}}{$key}[1]
{$file}[0]) ne 'SAME') {
push @files, $file;
}
} my $tar_cmd='';my $save_dir='';
my $filearg='';my $farg='';
my $tdir='';my $filecount=0;my $fil_='';
foreach my $file (@files) {
$filecount++;
$file=~s/%/\\%/g;
if ($key eq '/') {
$farg.="\'$base__dir$file\' ";
$tdir=$dir;
} else {
$farg.="\'$base__dir$key/$file\' ";
my $tkey=$key;
$tkey=~tr/\//\\/ if ($ps ne '/');
$tdir="$dir$ps$tkey"
}
$fil_=$file;
if (1500 < length "cp -fpv $farg\'$tdir\'") {
print "HERE IS THE COMMANDXXX==>","cp -fpv $filearg\'$tdir\'","<==\n";
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');
print "CMDXXXOUTPUT=$output<== and STDERR=$stderr<==\n";
if ($stderr) {
&clean_process_files($destFH);
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir$ps$file\"");
} elsif (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$tdir,$destFH,'')
}
}
} $filearg=$farg;
}
if ($filearg) {
if ($filecount==1) {
my $testd=&Net::FullAuto::FA_Core::test_dir(
$destFH->{_cmd_handle},$tdir);
if ($testd) {
if ($testd eq 'READ') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir\"");
if ($stderr) {
my $die="Destination Directory $tdir\n"
.' is NOT Writable!';
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
} else {
print "BE SURE TO ADD NEW CODE TO CHANGE BACK TO ",
"MORE RESTRICTIVE PERMISSIONS\n";
}
} else {
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');
if ($stderr) {
&clean_process_files($destFH);
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir$ps$fil_\"");
} elsif (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$tdir,$destFH,'')
}
}
}
} else {
($output,$stderr)=$destFH->cmd(
"cmd /c mkdir \"$tdir\"",'__live__');
#'__display__','__notrap__');
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
}
} else {
($output,$stderr)=$destFH->cmd(
"cp -fpv $filearg\'$tdir\'",
'__display__','__notrap__');
if ($stderr) {
&clean_process_files($destFH);
if (-1<index $stderr,': Permission denied') {
($output,$stderr)=$destFH->cmd(
"chmod -v 777 \"$tdir/$fil_\"");
} elsif (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$tdir,$destFH,'')
}
}
}
}
}
} else {
if (!$shortcut) {
if (0<$#dhostlabels && !$newborn_dest_first_hash_flag
&& !$Net::FullAuto::FA_Core::tranback && $activity) {
($output,$stderr)=$baseFH->cmd(
"cp $bcurdir/transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ".
"$bcurdir/transfer".
"$Net::FullAuto::FA_Core::tran[3]_1.tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$Net::FullAuto::FA_Core::tranback=2;
} $activity=0;
my @basekeys=sort keys %{$baseFH->{_bhash}};
#print "WHAT ARE THE BASEKEYS=@basekeys<==\n";
my $f_cnt=0;
($output,$stderr)=$baseFH->cmd(
"${Net::FullAuto::FA_Core::tarpath}tar --help");
if ($stderr) {
if (-1<index $stderr,'-LInputList') {
$aix_tar_input_variable_flag=1;
} elsif (-1<index $stderr,'BDeEFhilmnopPqTvw') {
$solaris_tar_input_variable_flag=1;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-5');
}
} elsif ($output) {
if (-1<index $output,'-T, --files-from=NAME') {
$gnu_tar_input_file_flag=1;
}
}
my $cppath='';my $diffpath='';
while (my $key=shift @basekeys) {
my @files=();
foreach my $file
(keys %{${$baseFH->{_bhash}}{$key}[1]}) {
if (${$baseFH->{_bhash}}{$key}[1]
{$file}[0] ne 'EXCLUDE'
&& unpack('a4',
${$baseFH->{_bhash}}{$key}[1]
{$file}[0]) ne 'SAME') {
push @files, $file;
}
} my $tar_cmd='';my $save_dir='';my $zdir_flag=0;
foreach my $file (sort @files) {
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY2" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$activity=1;
my $base___dir='';
my $dir= ($key eq '/') ? '' : "$key/";
#print "WHAT IS DIR=$dir<== and KEY=$key\n";
if ($dir && $baseFH->{_uname} eq 'cygwin') {
if (exists $Net::FullAuto::FA_Core::cygpathu{$dir}) {
$dir=$Net::FullAuto::FA_Core::cygpathu{$dir};
} else {
($dir,$stderr)=$baseFH->cmd("cygpath -u $dir");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
$Net::FullAuto::FA_Core::cygpathu{$dir}=$dir;
}
my $bcd='';
if (exists $Net::FullAuto::FA_Core::cygpathu{
$base_fdr}) {
$bcd=$Net::FullAuto::FA_Core::cygpathu{$base_fdr};
} else {
($bcd,$stderr)=$baseFH->cmd(
"cygpath -u $base_fdr");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
$Net::FullAuto::FA_Core::cygpathu{$base_fdr}=$bcd;
}
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY2 and DIR=$dir and BCD=$bcd" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$dir=~s/^(\/usr)*$bcd\/*//;
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY2AFTER and DIR=$dir\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
my $dirt='';
if (exists $Net::FullAuto::FA_Core::file_rename{
"$dir$file"}) {
my $cmd="cp -Rpv \"$base__dir$dir$file\" "
."\"$bcurdir/"
.$Net::FullAuto::FA_Core::file_rename{
"$dir$file"}."\"";
$file=$Net::FullAuto::FA_Core::file_rename{
"$dir$file"};
$base___dir=$bcurdir;
($output,$stderr)=$baseFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-2') if $stderr;
$dirt=substr($dir,0,(index $dir,'/'));
$dir='';
if ($gnu_tar_input_file_flag) {
$gnu_tar_input_file2=
$baseFH->tmp('tarlist2.txt')
if !$gnu_tar_input_file2;
$gnu_tar_input_list2.="$file\n";
$tmp_dir=$bcurdir;
push @dirt, $file;
} elsif ($aix_tar_input_variable_flag) {
$aix_tar_input_variable2.="$bcurdir/$file\n";
push @dirt, $file;
$tmp_dir=$bcurdir;
} elsif ($solaris_tar_input_variable_flag) {
$solaris_tar_input_variable2.="$bcurdir/$file\n";
push @dirt, $file;
$tmp_dir=$bcurdir;
} next
} else { $base___dir=$base__dir }
if ($_diff) {
if ($args{BaseZip}) {
if ($args{DestZip}) {
} else {
#print "ZIP=$args{BaseDir}/$args{BaseZip} and FILEEEE=$args{ZipBDir}/$dir$file<== and THIS=$baseFH->{_cwd}\n";
#my $env=$baseFH->cmd('env');
#print "WHAT IS ID=$env<== and $ENV{HOME}\n";<STDIN>;
($output,$stderr)=$baseFH->cmd(
"$base_unzip_path/unzip -o -d ".
"$baseFH->{_cwd}FA_Diff_Report_Zip ".
"$args{BaseDir}/$args{BaseZip} ".
"\"$args{ZipBDir}/$dir$file\"");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
if ($same_host_as_Master{$destFH->{_ip}}) {
unless ($cppath) {
if (-e '/usr/bin/cp') {
$cppath='/usr/bin/';
} elsif (-e '/bin/cp') {
$cppath='/bin/';
} elsif (-e '/usr/local/bin/cp') {
$cppath='/usr/local/bin/';
}
}
unless ($diffpath) {
if (-e '/usr/bin/diff') {
$diffpath='/usr/bin/';
} elsif (-e '/bin/diff') {
$diffpath='/bin/';
} elsif (-e '/usr/local/bin/diff') {
$diffpath='/usr/local/bin/';
}
}
($output,$stderr)=
$baseFH->cmd("${cppath}cp -fp ".
"$args{DestDir}/$dir$file ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file.dest");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=
$baseFH->cmd("${diffpath}diff ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file ".$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file.dest > ".$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file.diff");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=
$baseFH->cmd("rm -rf ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file.dest");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=
$baseFH->cmd("rm -rf ".
$baseFH->{_cwd}.
"FA_Diff_Report_Zip/$args{ZipBDir}".
"/$dir/$file");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
}
}
} elsif ($args{DESTZIP}) {
} else {
}
} elsif ($gnu_tar_input_file_flag) {
$gnu_tar_input_file1=
$baseFH->tmp('tarlist1.txt')
if !$gnu_tar_input_file1;
$gnu_tar_input_list1.="$dir$file\n";
} elsif ($aix_tar_input_variable1) {
$aix_tar_input_variable1.="$dir$file\n";
} elsif ($solaris_tar_input_variable1) {
$solaris_tar_input_variable1.="$dir$file\n";
} else {
my $tar_cmd='';
if (!$f_cnt) {
$f_cnt++;
$tar_cmd=
"tar cvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
} else {
$tar_cmd=
"tar rvf ${bcurdir}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
}
$tar_cmd.="-C \"$base___dir\" \"$dir$file\"";
print "mirror() TAR CMD =>$tar_cmd<==",
" and BASE DIR=$base_fdr AND ATTRIBUTES=",
${${$baseFH->{_bhash}}{$key}[1]{$file}}[0],
" AND KEY=$key AND FILE=$file\n"
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose;
print $Net::FullAuto::FA_Core::MRLOG
"mirror() TAR CMD =>$tar_cmd<==",
" and BASE DIR=$base_fdr AND ATTRIBUTES=",
${${$baseFH->{_bhash}}{$key}[1]{$file}}[0],
" AND KEY=$key AND FILE=$file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($output,$stderr)=$baseFH->cmd($tar_cmd,500);
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr &&
$stderr!~/\[A(?:\[C)+\[K1/;
if ($dirt) {
my $cmd="rm -rf \"$base___dir/$dirt\"";
($output,$stderr)=$baseFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1
if $stderr;
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-2') if $stderr;
}
}
} @files=();
}
} elsif ($Net::FullAuto::FA_Core::tranback==2 && $activity) {
($output,$stderr)=$baseFH->cmd(
"cp $bcurdir/transfer".
"$Net::FullAuto::FA_Core::tran[3]_1.tar ".
"$bcurdir/transfer$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$Net::FullAuto::FA_Core::tranback=1;$activity=0;
} else { $activity=0 }
}
if ($_diff) {
my $curdir=$baseFH->{_cwd};
($output,$stderr)=$baseFH->cwd(
"$baseFH->{_cwd}FA_Diff_Report_Zip");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=$baseFH->cmd(
"$base_zip_path/zip -r ".
"fa_diff_report *");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=$baseFH->cmd(
"mv fa_diff_report.zip ..");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
#($output,$stderr)=$baseFH->cwd($curdir);
#if ($stderr) {
# &Net::FullAuto::FA_Core::handle_error(
# $stderr,'-1');
#}
($output,$stderr)=$baseFH->cmd(
"rm -rf $curdir/FA_Diff_Report_Zip");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
($output,$stderr)=$baseFH->cmd(
"chown $username $curdir/fa_diff_report.zip");
if ($stderr) {
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1');
}
} else {
if ($activity) {
if ($gnu_tar_input_list1) {
chomp $gnu_tar_input_list1;
my @files=split /^/, $gnu_tar_input_list1;
my $filearg='';my $farg='';
foreach my $fil (@files) {
$fil=~s/%/\\%/g;
$farg.=$fil;
if (1601 < length
"echo \"$farg\" >> \$gnu_tar_input_file1") {
chomp $filearg;
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file1");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$farg=$fil;
} $filearg=$farg;
}
if ($filearg) {
chomp $filearg;
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file1");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
my $tar_cmd=
"tar cvf $bcurdir/transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
$tar_cmd.="-C \"$base__dir\" -T \"$gnu_tar_input_file1\"";
($output,$stderr)=$baseFH->cmd($tar_cmd,'__display__');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
if ($gnu_tar_input_list2) {
chomp $gnu_tar_input_list2;
my @files=split /^/, $gnu_tar_input_list2;
my $filearg='';my $farg='';
foreach my $fil (@files) {
$fil=~s/%/\\%/g;
$farg.=$fil;
if (1601 < length
"echo \"$farg\" >> \$gnu_tar_input_file2") {
chomp $filearg;
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file2");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$farg=$fil;
} $filearg=$farg;
}
if ($filearg) {
chomp $filearg;
($output,$stderr)=$baseFH->cmd(
"echo \"$filearg\" >> $gnu_tar_input_file2");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
my $tar_cmd=
"tar rvf $bcurdir/transfer".
"$Net::FullAuto::FA_Core::tran[3].tar ";
$tar_cmd.="-C \"$tmp_dir\" -T \"$gnu_tar_input_file2\"";
($output,$stderr)=$baseFH->cmd($tar_cmd);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
foreach my $dirt (@dirt) {
my $cmd="rm -rf \"$tmp_dir/$dirt\"";
($output,$stderr)=$baseFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
}
} elsif ($aix_tar_input_variable1) {
} elsif ($solaris_tar_input_variable1) {
}
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY3" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (!$shortcut) {
($output,$stderr)=$baseFH->cmd(
"chmod 777 $bcurdir/transfer".
"$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
}
&move_tarfile($baseFH,$btransfer_dir,$destFH,$shortcut);
#print "BASEFH=$baseFH\n";
#print "DESTFH=$destFH\n";
#print "BMS_SHARE=$bms_share\n";
#print "DMS_SHARE=$dms_share\n";
#print "LOCALTRANSFERDIR=$local_transfer_dir\n";
#print "TRANTAR=$trantar\n";
#print "BHOSTLABEL=$bhostlabel\n";
#print "DHOSTLABEL=$dhostlabel\n";
if ($destFH->{_uname} eq 'cygwin' &&
$dest_fdr=~/^[\/|\\][\/|\\]/ &&
$dms_share && $#{$destFH->{_hostlabel}}) {
$trantar=move_files($baseFH,'/','',
$dest_fdr,
$destFH,$bms_share,
$dms_share,'DEPLOY_ALL',
$local_transfer_dir,'',
$bhostlabel,$dhostlabel,
'',$shortcut);
}
($dest_output,$dest_dir,$err)=get_dest_ls_output(
$destFH,$dest_fdr,$dms_share,$dhost,$die);
my $ignore='';
($ignore,$stderr)=&build_base_dest_hashes(
$dest_fdr,\$dest_output,$args{Directives},
$dhost,$dms_share,$dms_domain,
$destFH->{_uname},$destFH,'DEST',$lsgnu,$args{ZipDDir});
($baseFH,$destFH,$timehash,$deploy_info,$debug_info)
=&build_mirror_hashes($baseFH,$destFH,
$bhostlabel,$dhostlabel,$verbose);
my @basekeys=sort keys %{$baseFH->{_bhash}};
while (my $key=shift @basekeys) {
my @files=();
foreach my $file
(keys %{${$baseFH->{_bhash}}{$key}[1]}) {
if (-1<index ${$baseFH->{_bhash}}{$key}[1]{$file}[0],
'DIFF_TIME') {
my $ts=${$baseFH->{_bhash}}{$key}[1]{$file}[1];
$ts=unpack('x12 a4',$ts).unpack('a2',$ts).
unpack('x3 a2',$ts).unpack('x6 a2',$ts).
unpack('x9 a2',$ts);
my $key_dir=($key ne '/') ? "/$key/" : '/';
($stdout,$stderr)=$destFH->cmd(
"touch -t $ts \"$dest_fdr$key_dir$file\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
}
}
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);
next if $return && -1<index $returned_modif,'e';
} $excluded=0;
if (exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;
next if $return && -1<index $returned_modif,'e';
if ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) && (!exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
${$baseFH->{_unaltered_basehash}}{$key}[1]{$file}||='';
print "SHORTCUT=$shortcut and THISSS=",
${$baseFH->{_unaltered_basehash}}{$key}[1]{$file},"<== and KEY=$key and FILE=$file\n";#<STDIN>;
if ($key eq '/') {
$activity=1;
$mirror_output.="DELETEDa File ==> $file\n";
$mirror_debug.="DELETED File ==> $file\n";
print "DELETINGa File ==> $file\n"
if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil=$file;
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
} else {
print $Net::FullAuto::FA_Core::MRLOG "DELETEFILE1b=$file\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$activity=1;
$mirror_output.="DELETEDb File ==> $key/$file\n";
$mirror_debug.="DELETED File ==> $key/$file\n";
print "DELETINGb File ==> $key/$file\n";
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil="$key/$file";
$fil=~s/\//\\/g;
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$activity=1;
$key="$dest_fdr/." if $key eq '/';
$mirror_output.="DELETEDc Directory ==> $key\n";
$mirror_debug.="DELETED Directory ==> $key\n";
print "DELETINGc Directory ==> $key\n"
if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $dir=$key;
$dir=~s/\//\\/g;
$dir=$destFH->{_work_dirs}->{_cwd_mswin}
.$dir;
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$dir\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$key\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
}
foreach my $key (keys %{$baseFH->{_bhash}}) {
if (defined ${$baseFH->{_bhash}}{$key}[3]
&& ${$baseFH->{_bhash}}{$key}[3] eq 'NOT_ON_DEST') {
if (exists $destFH->{_smb}) {
my $tdir=$key;
$tdir=~tr/\//\\/;
$tdir="\\\\$dhost\\$dms_share\\$tdir";
($output,$stderr)=$destFH->cmd("cmd /c mkdir $tdir",
'__live__');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
} else {
($output,$stderr)=$destFH->cmd("mkdir -p $key");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
$activity=1;
}
}
}
my $nodif="\n THERE ARE NO DIFFERENCES "
."BETWEEN THE BASE AND TARGET\n\n";
print $nodif if (((!$Net::FullAuto::FA_Core::cron && $verbose)
|| $Net::FullAuto::FA_Core::debug) && !$activity);
print $Net::FullAuto::FA_Core::MRLOG $nodif
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*'
&& !$activity;
$mirror_output.=$nodif if !$activity;
$mirror_debug.=$nodif if !$activity;
push @main::test_tar_output, $mirror_output;
} else {
$activity=0;
if (${$baseFH->{_bhash}}{'/'}[0] eq 'ALL') {
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY7" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$activity=1;
$trantar=move_files($baseFH,'/','',
$dest_fdr,
$destFH,$bms_share,
$dms_share,'DEPLOY_ALL',
$local_transfer_dir,'',
$bhostlabel,$dhostlabel,
'',$shortcut);
#'',$shortcut,\%desthash);
#if (exists $baseFH->{_smb}) {
#}
} else {
#print "HERE WE ARE FFFFTOP and $#{[keys %{$baseFH->{_bhash}}]}\n";
#print $Net::FullAuto::FA_Core::MRLOG "WE ARE HERE FFFFTOP and ",
#"$#{[keys %{$baseFH->{_bhash}}]}\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my @basekeys=sort keys %{$baseFH->{_bhash}};my @files=();
while (my $key=shift @basekeys) {
#print "BASEKEYYYYYY=$key and ==>",${$baseFH->{_bhash}}{$key}[0],"<==\n";
if (${$baseFH->{_bhash}}{$key}[0] eq 'ALL' ||
${$baseFH->{_bhash}}{$key}[0] eq 'NOT_ON_DEST'
|| ${$baseFH->{_bhash}}{$key}[0] eq
'ALL_DIR_ON_DEST') {
#print "BASEFH=$baseFH\n";
#print "KEY=$key\n";
#print "DEST_FDR=$dest_fdr\n";
#print "DESTFH=$destFH\n";
#print "BMS_SHARE=$bms_share\n";
#print "DMS_SHARE=$dms_share\n";
#print "LOCAL=$local_transfer_dir\n";
#print "TRANTAR=$trantar\n";
#print "BHOSTLABEL=$bhostlabel\n";
#print "KEYYYYY=$key and DIREC=",${$baseFH->{_bhash}}{$key}[0],"\n";<STDIN>;
my $parentkey='';
if ($key ne '/') {
if (-1<index $key,'/') {
$parentkey=$key;
substr($parentkey,(rindex $parentkey,'/'))='';
next if exists ${$baseFH->{_bhash}}{$parentkey}[0]
&& ${$baseFH->{_bhash}}{$parentkey}[0] eq 'ALL';
$parentkey="\\$parentkey";
}
}
$trantar=move_files($baseFH,$key,'',
$dest_fdr,
$destFH,$bms_share,$dms_share,
'',$local_transfer_dir,$trantar,
$bhostlabel,$dhostlabel,
$parentkey,$shortcut);
if ($basekeys[0] && (-1<index $basekeys[0],'/')) {
my $lkey=0;my $lbky=0;
$lkey=length $key;
$lbky=length $basekeys[0];
while ($lkey<=$lbky &&
unpack("a$lkey",$basekeys[0])
eq $key &&
(-1<index $basekeys[0],'/')) {
shift @basekeys;
}
} $activity=1;
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY8" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
next;
} elsif (${$baseFH->{_bhash}}{$key}[0] ne 'EXCLUDE'
&& ${$baseFH->{_bhash}}{$key}[2] ne
'DEPLOY_NOFILES_OF_CURDIR') {
foreach my $file
(keys %{${$baseFH->{_bhash}}{$key}[1]}) {
if (${$baseFH->{_bhash}}{$key}[1]
{$file}[0] ne 'EXCLUDE'
&& unpack('a4',
${$baseFH->{_bhash}}{$key}[1]
{$file}[0]) ne 'SAME') {
push @files, $file;
}
}
$trantar=move_files($baseFH,$key,
\@files,$dest_fdr,
$destFH,$bms_share,$dms_share,
'',$local_transfer_dir,$trantar,
$bhostlabel,$dhostlabel,
'',$shortcut);
$activity=1;
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY9" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
} elsif (${$baseFH->{_bhash}}{$key}[0] ne 'EXCLUDE') {
$trantar=move_files($baseFH,$key,
\@files,$dest_fdr,
$destFH,$bms_share,$dms_share,
'',$local_transfer_dir,$trantar,
$bhostlabel,$dhostlabel,
')DIRONLY',$shortcut);
print $Net::FullAuto::FA_Core::MRLOG "ACTIVITY10" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$activity=1;
}
}
}
if ($activity && $trantar) { #&& (exists $baseFH->{_smb})
#&& !$dms_share) {
print "WE HAVE ACIVITY AND TRANTAR=$trantar<==\n";
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::file_rename) {
my $cmd=
"mv \"transfer$Net::FullAuto::FA_Core::tran[3]/$file\""
." \"transfer$Net::FullAuto::FA_Core::tran[3]/"
."$Net::FullAuto::FA_Core::file_rename{$file}\"";
my ($output,$stderr)=$baseFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
}
my $cmd="cmd /c tar -C "
."\'transfer$Net::FullAuto::FA_Core::tran[3]\' -cvf "
."\'transfer$Net::FullAuto::FA_Core::tran[3].tar\' .";
$cmd=~tr/\\/\//;
($output,$stderr)=$baseFH->cmd('pwd');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
print $Net::FullAuto::FA_Core::MRLOG "TARRRPWDDDDD=$output\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($output,$stderr)=$baseFH->cmd($cmd);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
($output,$stderr)=$baseFH->cmd(
"cmd /c rmdir /s /q transfer".
"$Net::FullAuto::FA_Core::tran[3]");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
if (&Net::FullAuto::FA_Core::test_dir(
#$baseFH->{_cmd_handle}->{_cmd_handle},
$baseFH->{_cmd_handle},
"transfer$Net::FullAuto::FA_Core::tran[3]")) {
($output,$stderr)=$baseFH->cmd(
"chmod -R 777 transfer".
"$Net::FullAuto::FA_Core::tran[3]");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
($output,$stderr)=$baseFH->cmd(
"cmd /c rmdir /s /q transfer".
"$Net::FullAuto::FA_Core::tran[3]");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
print "DO MOVETARFILE\n";
&move_tarfile($baseFH,$btransfer_dir,$destFH,$shortcut);
if (keys %{$timehash}) {
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
($output,$stderr)=$destFH->cmd("touch --version");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr &&
(-1==index $stderr,'Not a recog') &&
(-1==index $stderr,'illegal opt');
print "TOUCHOUT=$output and STDERR=$stderr\n";
print $Net::FullAuto::FA_Core::MRLOG "TOUCHOUT=$output and STDERR=$stderr and EVAL=$@\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $touch='';
$touch='GNU' if -1<index $output,'GNU';
foreach my $file (keys %{$timehash}) {
my $time='';
$time=${${$timehash}{$file}}[1];
$time=~tr/ //d;
if ($touch eq 'GNU') {
$time="$time${${$timehash}{$file}}[0]";
} else {
$time="${${$timehash}{$file}}[0]$time";
}
print "GOING TO TOUCH TIME=$time and FILE=$file\n";
print $Net::FullAuto::FA_Core::MRLOG "GOING TO TOUCH TIME=$time and FILE=$file\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($output,$stderr)=
$destFH->cmd('touch -t'." $time \"$file\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
#$Net::FullAuto::FA_Core::log=0 if $logreset;
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);
next if $return && -1<index $returned_modif,'e';
} $excluded=0;
if (!$shortcut && exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (
keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;
next if $return && -1<index $returned_modif,'e';
if ((exists $args{DeleteOnDest}
&& $args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
if ($key eq '/') {
$mirror_output.="DELETEDd File ==> $file\n";
$mirror_debug.="DELETED File ==> $file\n";
print "DELETINGd File ==> $file\n"
if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil=$file;
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
} else {
$mirror_output.=
"DELETEDe File ==> $key/$file\n";
$mirror_debug.=
"DELETED File ==> $key/$file\n";
print "DELETINGe File ==> $key/$file\n"
if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $fil="$key/$file";
$fil=~s/\//\\/g;
$fil=$destFH->{_work_dirs}->{_cwd_mswin}
.$fil;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$fil\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$key="$dest_fdr/." if $key eq '/';
$mirror_output.="DELETEDf Directory ==> $key\n";
$mirror_debug.="DELETED Directory ==> $key\n";
print "DELETINGf Directory ==> $key\n"
if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
if (!$destFH->{_work_dirs}->{_cwd} &&
$destFH->{_work_dirs}->{_cwd_mswin}) {
my $dir=$key;
$dir=~s/\//\\/g;
$dir=$destFH->{_work_dirs}->{_cwd_mswin}
.$dir;
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$dir\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
} else {
my ($output,$stderr)=
$destFH->cmd("rm -rf \"$key\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
}
}
} elsif (!$activity) {
my $nodif='';my $excluded=0;
foreach my $key (keys %{$destFH->{_dhash}}) {
if ($Net::FullAuto::FA_Core::d_sub) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::d_sub($key);
next if $return && -1<index $returned_modif,'e';
} $excluded=0;
if (exists ${$baseFH->{_bhash}}{$key}) {
foreach my $file (keys %{${$destFH->{_dhash}}{$key}[1]}) {
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key)
if $Net::FullAuto::FA_Core::f_sub;
next if $return && -1<index $returned_modif,'e';
if ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}
{$key}[1]{$file})) {
if ($key eq '/') {
$mirror_output.="DELETEDg File ==> $file\n";
$mirror_debug.="DELETED File ==> $file\n";
print "DELETINGg File ==> $file\n"
if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
} else {
$mirror_output.=
"DELETEDh File ==> $key/$file\n";
$mirror_debug.=
"DELETED File ==> $key/$file\n";
print "DELETINGh File ==> $key/$file\n"
if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
my ($output,$stderr)=
$destFH->cmd("rm -f \"$key/$file\"");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
}
} elsif ((exists $args{DeleteOnDest} &&
$args{DeleteOnDest}) &&
(!$shortcut || !exists
${$baseFH->{_unaltered_basehash}}{$key})) {
$key="$dest_fdr/." if $key eq '/';
$mirror_output.="DELETEDi Directory ==> $key\n";
$mirror_debug.="DELETED Directory ==> $key\n";
print "DELETINGi DIRECTORY ==> $key\n"
if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
my ($output,$stderr)=
$destFH->cmd("rm -rf $key");
&Net::FullAuto::FA_Core::handle_error(
$stderr,'-1') if $stderr;
}
}
$nodif="\n THERE ARE NO DIFFERENCES "
."BETWEEN THE BASE AND TARGET\n\n";
print $nodif if (((!$Net::FullAuto::FA_Core::cron && $verbose)
|| $Net::FullAuto::FA_Core::debug) && !$activity);
print $Net::FullAuto::FA_Core::MRLOG $nodif
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*'
&& !$activity;
$mirror_output.=$nodif if !$activity;
$mirror_debug.=$nodif if !$activity;
push @main::test_tar_output, $mirror_output;
}
}
}
}
%base_shortcut_info=();
if (exists $destFH->{_work_dirs}->{_pre} && $destFH->{_work_dirs}->{_pre}
&& $destFH->{_work_dirs}->{_pre} ne $destFH->{_work_dirs}->{_cwd}
&& $destFH->{_work_dirs}->{_pre} ne $destFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=$destFH->cwd($destFH->{_work_dirs}->{_pre});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
if (wantarray) {
return $mirror_output,$mirror_debug;
} else { return $mirror_output }
}
sub get_drive
{
my @topcaller=caller;
print "get_drive() CALLER=",(join ' ',@topcaller),"\n";
# if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "get_drive() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($folder,$base_or_dest,$cmd_handle,$hostlabel)=('','','','');
($folder,$base_or_dest,$cmd_handle,$hostlabel)=@_;
$cmd_handle||='';
my ($output,$stderr)=('','');
my @drvs=();my $dir='';
if (unpack('a1',$folder) eq '/' ||
unpack('a1',$folder) eq '\\') {
$dir=unpack('a1',$folder);
} else { $dir=$folder }
$dir=~tr/\\/\//;
my $ms_dir=$dir;
$ms_dir=~tr/\//\\/;
$ms_dir=~s/\\/\\\\/g;my $drvs='';
if (exists $Net::FullAuto::FA_Core::drives{$hostlabel}) {
$drvs=$Net::FullAuto::FA_Core::drives{$hostlabel};
} else {
my $sav_curdir='';
if ($cmd_handle) {
bless $cmd_handle, 'File_Transfer';
($sav_curdir,$stderr)=$cmd_handle->cmd('pwd');
&handle_error($stderr,'-1') if $stderr;
if (exists $Net::FullAuto::FA_Core::cygpathw{$sav_curdir}) {
$sav_curdir=$Net::FullAuto::FA_Core::cygpathw{$sav_curdir};
} else {
($sav_curdir,$stderr)=$cmd_handle->cmd("cygpath -w $sav_curdir");
&handle_error($stderr,'-1') if $stderr;
$sav_curdir=~s/\\/\\\\/g;
$Net::FullAuto::FA_Core::cygpathw{$sav_curdir}=$sav_curdir;
}
($output,$stderr)=$cmd_handle->cwd($cmd_handle->{_cygdrive});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($drvs,$stderr)=$cmd_handle->cmd('ls');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} elsif ($^O eq 'cygwin') {
$sav_curdir=Cwd::getcwd();
chdir $Net::FullAuto::FA_Core::localhost->{_cygdrive};
$drvs=`ls`;
}
if ($cmd_handle) {
($output,$stderr)=$cmd_handle->cwd($sav_curdir);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} else { chdir $sav_curdir }
$Net::FullAuto::FA_Core::drives{$hostlabel}=$drvs;
}
foreach my $drv (split /\n/, $drvs) {
last unless $drv;
if ($cmd_handle) {
my $result=&Net::FullAuto::FA_Core::test_dir(
$cmd_handle->{_cmd_handle},
$cmd_handle->{_cygdrive}."/$drv/$dir/");
if ($result ne 'NODIR') {
if ($ms_dir && $ms_dir ne '\\\\') {
push @drvs, "$drv:\\$ms_dir\\";
} else { push @drvs, "$drv:\\" }
}
} elsif (-d "$drv:\\$ms_dir") {
if ($ms_dir && $ms_dir ne '\\\\') {
push @drvs, "$drv:\\$ms_dir\\";
} else { push @drvs, "$drv:\\" }
}
}
if (-1<$#drvs) {
if ($#drvs==0) {
$dir=$drvs[0];
} else {
my $banner="\n Please Pick a $base_or_dest Directory\n"
." on the Local Host "
."$Net::FullAuto::FA_Core::Local_HostName :";
$dir=&Term::Menus::pick(\@drvs,$banner);
}
my ($drive,$path)=unpack('a1 x1 a*',$dir);
$path=~tr/\\/\//;
if ($cmd_handle) {
$folder=$cmd_handle->{_cygdrive}.'/'.lc($drive).$path.'/';
} else {
$folder=$Net::FullAuto::FA_Core::localhost->{_cygdrive}.'/'.
lc($drive).$path.'/';
}
} else {
my $die="Cannot Locate Directory $folder\n"
." Anywhere on Local $base_or_dest Host "
."$Net::FullAuto::FA_Core::Local_HostName\n";
&Net::FullAuto::FA_Core::handle_error($die);
}
if (wantarray) {
return $folder,$dir
} else { return $folder }
}
sub get_dest_ls_output {
my $destFH=$_[0];
my $dest_fdr=$_[1]||'';
my $dms_share=$_[2]||'';
my $dhost=$_[3]||'';
my $die=$_[4]||'';
my $dest_dir='';
my $dest_output='';
my $stderr='';my $lsgnu=0;
if ($destFH->{_uname} eq 'cygwin') {
my ($test_chr1,$test_chr2)='';
if ($dest_fdr) {
$test_chr1=unpack('a1',$dest_fdr);
if (1<length $dest_fdr) {
$test_chr2=unpack('a2',$dest_fdr);
}
if ($test_chr2) {
if (($test_chr1 eq '/' && $test_chr2 ne '//')
|| ($test_chr1 eq '\\' &&
$test_chr2 ne '\\\\')) {
$dest_dir=$dest_fdr;
if ($dest_dir=~s/$destFH->{_cygdrive_regex}//) {
$dest_dir=~s/^(.)/$1:/;
$dest_dir=~tr/\//\\/;
} else {
my $de_f=$dest_fdr;
$de_f=~s/^[\/\\]+//;
$de_f=~tr/\//\\/;
if (exists $destFH->{_smb}) {
$dest_dir="\\\\$dhost\\$dms_share\\$de_f";
} else {
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;
print "JDKKDK\n";<STDIN>;
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';
}
}
} elsif ($test_chr2 eq '//' ||
$test_chr2 eq '\\\\') {
$dest_dir=$dest_fdr;
print "NAKED\n";<STDIN>;
} elsif ($test_chr2=~/^[a-zA-Z]:$/) {
$dest_dir=$dest_fdr;
print "NAKED\n";<STDIN>;
} elsif ($test_chr1!~/\W/) {
my $de_f=$dest_fdr;
$de_f=~s/^[\/\\]+//;
$de_f=~tr/\//\\/;
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';
} else {
my $die="Destination Directory - $dest_fdr"
." CANNOT Be Located";
&Net::FullAuto::FA_Core::handle_error($die);
}
} elsif ($test_chr1 eq '/' || $test_chr1 eq '\\') {
$dest_dir=$dest_fdr;
if ($dest_dir=~s/$destFH->{_cygdrive_regex}//) {
$dest_dir=~s/^(.)/$1:/;
$dest_dir=~tr/\//\\/;
print "OLSKDKF\n";
} else {
my $de_f=$dest_fdr;
$de_f=~s/^[\/\\]+//;
$de_f=~tr/\//\\/;
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin}.=$de_f;
$destFH->{_work_dirs}->{_cwd_mswin}.='\\';
print "WOOEEE\n";
}
} elsif ($test_chr1=~/^[a-zA-Z]$/) {
print "BLECKKK\n";
$dest_dir=$test_chr1 . ':\\';
} else {
my $die="Destination Directory - $dest_fdr"
." CANNOT Be Located";
&Net::FullAuto::FA_Core::handle_error($die);
}
} else {
$dest_dir=$destFH->{_work_dirs}->{_cwd_mswin};
} my $cnt=0;
while (1) {
($dest_output,$stderr)=$destFH->cmd(
"cmd /c dir /s /-C /A- \"$dest_dir\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
if ($dest_output!~/bytes free\s*/s) {
$dest_output='';next unless $cnt++;
my $die="Attempt to retrieve output from the command:\n"
."\n cmd /c dir /-C \"$dest_dir\"\n"
."\n run on the host "
."$destFH->{_hostlabel}->[0] FAILED";
&Net::FullAuto::FA_Core::handle_error($die,'-1');
} else { last }
}
} elsif ($dest_fdr) {
my $test_char=unpack('a1',$dest_fdr);
if ($test_char ne '/' && $test_char ne '.') {
$dest_dir=$destFH->{_work_dirs}->{_cwd}
.$dest_fdr;
} else {
$dest_dir=$dest_fdr;
}
my $ls_path='';
if ($destFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};
$ls_path.='/' if $ls_path!~/\/$/;
}
($dest_output,$stderr)=$destFH->cmd("${ls_path}ls --version");
if (-1<index $dest_output,'GNU') {
$lsgnu=1;
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_dir\'");
} else {
$lsgnu=0;
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_dir\'");
}
if ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "$die$stderr"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return '', '', "$die$stderr";
}
} else {
my $dest_dir=$destFH->{_work_dirs}->{_cwd};
my $ls_path='';
if ($destFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};
$ls_path.='/' if $ls_path!~/\/$/;
}
($dest_output,$stderr)=$destFH->cmd("${ls_path}ls --version");
if (-1<index $dest_output,'GNU') {
$lsgnu=1;
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs --block-size=1 \'$dest_dir\'");
} else {
$lsgnu=0;
($dest_output,$stderr)=$destFH->cmd(
"${ls_path}ls -lRs \'$dest_dir\'");
}
if ($stderr) {
print $Net::FullAuto::FA_Core::MRLOG "$die$stderr"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return '', '', "$die$stderr";
}
}
return $dest_output,$dest_dir,'';
}
sub move_tarfile
{
my @topcaller=caller;
print "move_tarfile() CALLER=",(join ' ',@topcaller),"\n";
#if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "move_tarfile() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($baseFH,$btransfer_dir,$destFH,$shortcut)=('','','','');
($baseFH,$btransfer_dir,$destFH,$shortcut)=@_;
my ($output,$stdout,$stderr)=('','','');
my $dest_fdr=$destFH->{_work_dirs}->{_cwd};
my $bprxFH='';my $dprxFH='';my $d_fdr='';
my $trandir_parent='';
my $phost= $baseFH->{_hostlabel}->[1]?
$baseFH->{_hostlabel}->[1]:
$baseFH->{_hostlabel}->[0];
unless ($destFH->{_hostlabel}->[0] eq "__Master_${$}__" &&
$baseFH->{_hostlabel}->[0] eq "__Master_${$}__") {
if ($destFH->{_hostlabel}->[0] eq "__Master_${$}__") {
if ($destFH->{_work_dirs}->{_tmp}) { # DEST-Master has trandir
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"lcd \"$destFH->{_work_dirs}->{_tmp}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$d_fdr=$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}=
$destFH->{_work_dirs}->{_tmp};
} else {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,"lcd \"$dest_fdr\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$d_fdr=$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}=
$dest_fdr;
}
if ($baseFH->{_work_dirs}->{_tmp}) { # If BASE has remote trandir
# cd ftp handle to it
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"cd $baseFH->{_work_dirs}->{_tmp}");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
} else {
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"cd $baseFH->{_work_dirs}->{_cwd}");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
}
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"get transfer$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
} elsif ($baseFH->{_hostlabel}->[0] eq "__Master_${$}__" ||
($Net::FullAuto::FA_Core::DeploySMB_Proxy[0] eq "__Master_${$}__"
&& (exists $baseFH->{_smb}))) {
if ($baseFH->{_work_dirs}->{_tmp} &&
exists $baseFH->{_ftp_handle}) {
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"lcd \"$baseFH->{_work_dirs}->{_tmp}\"");
$Net::FullAuto::FA_Core::ftpcwd{$baseFH->{_ftp_handle}}{lcd}=
$baseFH->{_work_dirs}->{_tmp};
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
}
if ($destFH->{_work_dirs}->{_tmp}) { # If DEST has trandir
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"cd \"$destFH->{_work_dirs}->{_tmp}\"");
# cd ftp handle to trandir
$d_fdr="$destFH->{_work_dirs}->{_tmp}/";
if (exists $destFH->{_smb}) { # If DEST needs SMB
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"mkdir \"transfer$Net::FullAuto::FA_Core::tran[3]\""); # Add
# tmp 'transfer' dir
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr && (-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::tran[4]=1;
($output,$stderr)=
&Rem_Command::ftpcmd($destFH, # cd ftp handle to 'transfer'
"cd \"transfer$Net::FullAuto::FA_Core::tran[3]\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}
="transfer$Net::FullAuto::FA_Core::tran[3]";
$d_fdr.="transfer$Net::FullAuto::FA_Core::tran[3]";
}
} else { # No trandir on DEST,
($output,$stderr)=&Rem_Command::ftpcmd( # use $dest_fdr for transfer
$destFH,"cd \"$dest_fdr\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}
=$d_fdr=$dest_fdr;
}
($output,$stderr)=&Rem_Command::ftpcmd( # Transfer the tar file
$destFH,"!id"); # 'put' because DEST is remote
print "move_tarfile() TRYING TO DO PUT TWO\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"move_tarfile() TRYING TO DO PUT TWO\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($output,$stderr)=&Rem_Command::ftpcmd( # Transfer the tar file
$destFH, # 'put' because DEST is remote
"put transfer$Net::FullAuto::FA_Core::tran[3].tar");
if (-1<index "$output","permissions do not") {
&Net::FullAuto::FA_Core::handle_error($output,'-1');
die "$output $!"
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
if ($baseFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(
$destFH, # lcd ftp handle back to parent
"lcd \"$baseFH->{_work_dirs}->{_tmp}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{lcd}
=$baseFH->{_work_dirs}->{_tmp};
}
} elsif (&ftm_connect($destFH,$phost)) {
my %ftp=(
_ftp_handle => $destFH->{_cmd_handle},
_ftm_type => $destFH->{_ftm_type},
_hostname => $destFH->{_hostname},
_ip => $destFH->{_ip},
_uname => $destFH->{_uname},
_luname => $baseFH->{_uname},
_hostlabel => [ $destFH->{_hostlabel}->[0],$phost ],
_ftp_pid => $destFH->{_ftp_pid}
);
if ($destFH->{_uname} ne 'cygwin' ||
$dest_fdr!~/^[\/|\\][\/|\\]/ ||
!$destFH->{_ms_share} || !$#{$destFH->{_hostlabel}}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,"lcd \"$dest_fdr\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
print "SAVING LCD PATH OF DEST2=transfer$Net::FullAuto::FA_Core::tran[3]\n";
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{lcd}
=$d_fdr=$dest_fdr;
} else {
#if (exists $destFH->{_smb}) {
#print "XXXXXAAAAA\n";
if ($destFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd \"$destFH->{_work_dirs}->{_tmp}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$d_fdr="$destFH->{_work_dirs}->{_tmp}/";
}
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"!mkdir transfer$Net::FullAuto::FA_Core::tran[3]");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$Net::FullAuto::FA_Core::tran[4]=1;
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd transfer$Net::FullAuto::FA_Core::tran[3]");
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{lcd}
="transfer$Net::FullAuto::FA_Core::tran[3]";
$d_fdr.="transfer$Net::FullAuto::FA_Core::tran[3]";
} #else {
#print "XXXXXBBBBB\n";
# ($output,$stderr)=&ftp(\%ftp,'',"lcd \"$dest_fdr\"");
# &Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
# (-1==index $stderr,'command success');
#print "SAVING LCD PATH OF DEST2=transfer$Net::FullAuto::FA_Core::tran[3]\n";
# #$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}->{_cmd_handle}}{lcd}
# $Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{lcd}
# =$d_fdr=$dest_fdr;
# }
if ($baseFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd \"$baseFH->{_work_dirs}->{_tmp}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
my ($output,$stderr)=$baseFH->cwd(
$baseFH->{_work_dirs}->{_tmp});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{cd}
=$baseFH->{_work_dirs}->{_tmp};
} else {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd \"$baseFH->{_work_dirs}->{_cwd}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{cd}
="$baseFH->{_work_dirs}->{_cwd}";
}
print "GOING TO GET THE TAR AND BRING IT TO DESTTTTTTTTTTTTTTTTT\n";
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"get transfer$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
my $prompt = '_funkyPrompt_';
$destFH->{_cmd_handle}->prompt("/$prompt\$/");
$destFH->{_cmd_handle}->print('bye');
while (my $line=$destFH->{_cmd_handle}->get) {
print "GETTING BACK THE CMD FROM FTP LINE=$line\n";
last if $line=~/_funkyPrompt_/s;
}
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
DH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($destFH->{_cmd_handle}
eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
substr($type,0,3)='cmd';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last DH;
}
}
}
}
} elsif ($Net::FullAuto::FA_Core::DeployFTM_Proxy[0]
eq "__Master_${$}__" ||
exists $Net::FullAuto::FA_Core::same_host_as_Master{
$Net::FullAuto::FA_Core::DeployFTM_Proxy[0]}) {
if ($baseFH->{_work_dirs}->{_tmp}) {
#($output,$stderr)=&Rem_Command::ftpcmd(\%bftp,
($output,$stderr)=&Rem_Command::ftpcmd($baseFH,
"cd \"$baseFH->{_work_dirs}->{_tmp}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
($stdout,$stderr)=$baseFH->cmd(
"cd \"$baseFH->{_work_dirs}->{_tmp}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_cmd_handle}}{cd}
=$baseFH->{_work_dirs}->{_tmp};
}
($output,$stderr)=&Rem_Command::ftpcmd(
$baseFH,"get transfer$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
if (exists $destFH->{_smb}) {
if ($destFH->{_work_dirs}->{_tmp}) {
#($output,$stderr)=&ftp(\%dftp,'',
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"cd \"$destFH->{_work_dirs}->{_tmp}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$d_fdr="$destFH->{_work_dirs}->{_tmp}/";
}
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"mkdir transfer$Net::FullAuto::FA_Core::tran[3]");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$Net::FullAuto::FA_Core::tran[4]=1;
$d_fdr.=transfer$Net::FullAuto::FA_Core::tran[3];
} else {
$d_fdr=$destFH->{_work_dirs}->{_cwd};
}
#($output,$stderr)=&ftp(\%dftp,'',"cd $d_fdr");
($output,$stderr)=&Rem_Command::ftpcmd($destFH,"cd $d_fdr");
if ($stderr && -1==index $stderr,'command success') {
my $die="The System $destFH->{_hostlabel}->[0]"
." Returned\n the Following "
."Unrecoverable Error "
."Condition :\n\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die);
} $Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}=$d_fdr;
my $putoutput='';
($putoutput,$stderr)=&Rem_Command::ftpcmd($destFH,
"put transfer$Net::FullAuto::FA_Core::tran[3].tar");
#&ftp($destFH,'',
# "put transfer$Net::FullAuto::FA_Core::tran[3].tar");
if (-1<index $putoutput,"Couldn't get handle: Permission denied") {
my $die="The System $destFH->{_hostlabel}->[0]"
." Returned\n the Following "
."Unrecoverable Error "
."Condition :\n\n "
."Couldn't get handle: Permission denied";
($output,$stderr)=$destFH->cwd('/tmp');
&Net::FullAuto::FA_Core::handle_error("$die\n\n $stderr",'-1')
if $stderr;
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"put transfer$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error("$die\n\n $stderr",'-1')
if $stderr && (-1==index $stderr,'command success');
($output,$stderr)=$destFH->cmd(
"mv transfer$Net::FullAuto::FA_Core::tran[3].tar $d_fdr");
&Net::FullAuto::FA_Core::handle_error("$die\n\n $stderr",'-1')
if $stderr;
($output,$stderr)=$destFH->cwd($d_fdr);
&Net::FullAuto::FA_Core::handle_error("$die\n\n $stderr",'-1')
if $stderr;
} elsif ($stderr && -1==index $stderr,'command success') {
my $die="The System $destFH->{_hostlabel}->[0]"
." Returned\n the Following "
."Unrecoverable Error "
."Condition :\n\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die);
}
} elsif ($Net::FullAuto::FA_Core::DeployFTM_Proxy[0]) {
print "IM HERE THIS\n";
($bprxFH,$stderr)=
Rem_Command::new('Rem_Command',
$Net::FullAuto::FA_Core::DeployFTM_Proxy[0]);
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
my $bprx={
_cmd_handle => $bprxFH,
};
&ftm_connect($bprx,$phost);
my %bftp=(
_ftp_handle => $bprx->{_cmd_handle},
_ftm_type => $bprx->{_ftm_type},
_hostname => $bprx->{_hostname},
_ip => $bprx->{_ip},
_uname => $bprx->{_uname},
_luname => $baseFH->{_uname},
_hostlabel => [ $Net::FullAuto::FA_Core::DeployFTM_Proxy[0],'' ],
_ftp_pid => $bprx->{_cmd_pid}
);my $btrandir='';
if ($btransfer_dir) {
if (unpack('@1 a1',"$btransfer_dir") eq ':') {
my ($drive,$path)=unpack('a1 x1 a*',$btransfer_dir);
$path=~tr/\\/\//;
$btrandir=$baseFH->{_cygdrive}.'/'.lc($drive).$path.'/';
} elsif (substr($btransfer_dir,-1) ne '/') {
$btrandir.='/';
}
($output,$stderr)=&Rem_Command::ftpcmd(
\%bftp,"cd \"$btrandir\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$bprx->{_cmd_handle}}{cd}=$btrandir;
} elsif ($baseFH->{_work_dirs}->{_tmp}) {
($output,$stderr)=&Rem_Command::ftpcmd(
\%bftp,"cd $baseFH->{_work_dirs}->{_tmp}");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$bprx->{_cmd_handle}}{cd}=
$baseFH->{_work_dirs}->{_tmp};
} else {
($output,$stderr)=&Rem_Command::ftpcmd(\%bftp,
"cd \"$baseFH->{_work_dirs}->{_cwd}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$bprx->{_cmd_handle}}{cd}=
$baseFH->{_work_dirs}->{_cwd};
}
($output,$stderr)=&Rem_Command::ftpcmd(\%bftp,
"get transfer$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
my $prompt = '_funkyPrompt_';
$bprx->{_cmd_handle}->prompt("/$prompt\$/");
$bprx->{_cmd_handle}->cmd('bye');
BPH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($bprx->{_cmd_handle}
eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
substr($type,0,3)='cmd';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last BPH;
}
}
}
}
($dprxFH,$stderr)=
Rem_Command::new('Rem_Command',
$Net::FullAuto::FA_Core::DeployFTM_Proxy[0]);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
my $dprx={
_cmd_handle => $dprxFH,
};
&ftm_connect($dprx,$destFH->{_hostlabel}->[0]);
my %dftp=(
_ftp_handle => $dprx->{_cmd_handle},
_ftm_type => $dprx->{_ftm_type},
_hostname => $dprx->{_hostname},
_ip => $dprx->{_ip},
_uname => $dprx->{_uname},
_luname => $destFH->{_uname},
_hostlabel => [ $Net::FullAuto::FA_Core::DeployFTM_Proxy[0],'' ],
_ftp_pid => $dprx->{_cmd_pid}
);
#($output,$stderr)=&ftp(\%dftp,'',
($output,$stderr)=&Rem_Command::ftpcmd(
\%dftp,"cd \"$dest_fdr\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$Net::FullAuto::FA_Core::ftpcwd{$dprx->{_cmd_handle}}{cd}
=$d_fdr=$dest_fdr;
print "move_tarfile() TRYING TO DO PUT ONE\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"move_tarfile() TRYING TO DO PUT ONE\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($output,$stderr)=&Rem_Command::ftpcmd(
\%dftp,"put transfer$Net::FullAuto::FA_Core::tran[3].tar");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr &&
(-1==index $stderr,'command success');
$dprx->{_cmd_handle}->prompt("/$prompt\$/");
$dprx->{_cmd_handle}->cmd('bye');
DPH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($dprx->{_cmd_handle}
eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete
$Net::FullAuto::FA_Core::Processes{
$hlabel}{$sid}{$type};
substr($type,0,3)='cmd';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last DPH;
}
}
}
}
} else {
&Net::FullAuto::FA_Core::handle_error("NO FTP PROXY DEFINED");
}
} else {
File::Copy::copy($destFH->{_work_dirs}->{_tmp}.
"transfer$Net::FullAuto::FA_Core::tran[3].tar",
$dest_fdr)
|| do{ die "copy failed: $!" };
$d_fdr=$dest_fdr;
}
my $shownow="NOW HERE SO THERE and FTPProxy=$Net::FullAuto::FA_Core::DeployFTM_Proxy[0] and "
.(exists $Net::FullAuto::FA_Core::same_host_as_Master{"$Net::FullAuto::FA_Core::DeployFTM_Proxy[0]"})."\n";
#print "SHOWWWWWWWWWWWWWWWWW=$shownow\n";
#print $Net::FullAuto::FA_Core::MRLOG $shownow
# if $Net::FullAuto::FA_Core::log &&
# -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#print "HOSTNAME FOR DEST=",$destFH->cmd('hostname'),"\n";
#print "THISHOSTNAME FOR DEST=",$destFH->cmd('hostname'),"\n";
#print "D_FDR=$d_fdr<== and DEST_FDR=$dest_fdr<==\n";<STDIN>;
if ($d_fdr eq $dest_fdr) {
($output,$stderr)=$destFH->cwd( # cd cmd handle to folder
$d_fdr); # that now has tar file
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
my $tdr='';
my $testf=&Net::FullAuto::FA_Core::test_file($destFH,
"transfer$Net::FullAuto::FA_Core::tran[3].tar");
if ($testf ne 'WRITE' && $testf ne 'READ') {
$tdr=$destFH->{_work_dirs}->{_tmp}
if $destFH->{_work_dirs}->{_tmp};
}
($output,$stderr)=
$destFH->cmd(
"chmod 755 ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # chmod it
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($output,$stderr)=
$destFH->cmd(
"tar xovf ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # un-tar it
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
#print "WHAT IS THE SHORTCUT HERE=$shortcut\n";sleep 6;
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::rename_file) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::rename_file{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
} else {
foreach my $file (keys %Net::FullAuto::FA_Core::renamefile) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::renamefile{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
}
($output,$stderr)=$destFH->cmd("rm -f ${tdr}transfer".
$Net::FullAuto::FA_Core::tran[3].".tar"); # delete tar file
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} elsif (exists $destFH->{_smb}) {
($output,$stderr)=$destFH->cwd( # cd cmd handle to folder
$d_fdr); # that is the un-tar target
$Net::FullAuto::FA_Core::tran[2]=1 if $Net::FullAuto::FA_Core::tran[4];
&Net::FullAuto::FA_Core::handle_error($stderr,'-3') if $stderr;
my $tdr='';
my $testf=&Net::FullAuto::FA_Core::test_file($destFH,
"transfer$Net::FullAuto::FA_Core::tran[3].tar");
if ($testf ne 'WRITE' && $testf ne 'READ') {
$tdr="$destFH->{_work_dirs}->{_tmp}/"
if $destFH->{_work_dirs}->{_tmp};
}
my $dtr=($destFH->{_hostlabel}->[0] ne "__Master_${$}__") ? $d_fdr
: $destFH->{_work_dirs}->{_tmp};
($output,$stderr)=
$destFH->cmd(
"chmod 755 ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # chmod it
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($output,$stderr)=
$destFH->cmd(
"tar xovf $dtr/transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # un-tar it
&Net::FullAuto::FA_Core::handle_error($stderr,'-3') if $stderr;
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::rename_file) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::rename_file{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
} else {
foreach my $file (keys %Net::FullAuto::FA_Core::renamefile) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::renamefile{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
}
if ($Net::FullAuto::FA_Core::tran[4]) {
($output,$stderr)=&Rem_Command::ftpcmd($destFH,
"cd \"$destFH->{_work_dirs}->{_tmp}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
$Net::FullAuto::FA_Core::ftpcwd{$destFH->{_ftp_handle}}{cd}
=$destFH->{_work_dirs}->{_tmp};
($output,$stderr)=
$destFH->cwd($destFH->{_work_dirs}->{_tmp});
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
$Net::FullAuto::FA_Core::tran[2]=0;
}
($output,$stderr)=
$destFH->cmd("rm -f $dtr/transfer".
$Net::FullAuto::FA_Core::tran[3].".tar"); # delete tar file
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
} else {
($output,$stderr)=$destFH->cwd( # cd cmd handle to dest folder
$dest_fdr);
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
my $tdr='';
my $testf=&Net::FullAuto::FA_Core::test_file($destFH,
"transfer$Net::FullAuto::FA_Core::tran[3].tar");
if ($testf ne 'WRITE' && $testf ne 'READ') {
$tdr=$destFH->{_work_dirs}->{_tmp}
if $destFH->{_work_dirs}->{_tmp};
}
($output,$stderr)=$destFH->cmd("chmod 777 ${tdr}transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # chmod it
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($output,$stderr)=$destFH->cmd("tar xovf $d_fdr/transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # un-tar it
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
if (!$shortcut) {
foreach my $file (keys %Net::FullAuto::FA_Core::rename_file) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::rename_file{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
} else {
foreach my $file (keys %Net::FullAuto::FA_Core::renamefile) {
my $cmd="mv \"$file\" ".
"\"$Net::FullAuto::FA_Core::renamefile{$file}\"";
my ($output,$stderr)=$destFH->cmd($cmd);
$Net::FullAuto::FA_Core::savetran=1 if $stderr;
&Net::FullAuto::FA_Core::handle_error($stderr,'-2') if $stderr;
}
}
($output,$stderr)=$destFH->cmd("rm -f $d_fdr/transfer".
"$Net::FullAuto::FA_Core::tran[3].tar"); # delete tar file
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
}
sub ftm_connect
{
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;
print "ftm_connect() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "ftm_connect() CALLER=",
(join ' ',@topcaller)," and HOSTLABEL=$_[1]\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $ftpFH=$_[0];my $hostlabel=$_[1];my $_connect=$_[2]||'';
my $ftm_type='';my $ftm_passwd='';
my $output='';my $stderr='';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fctimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,$_connect);
my @connect_method=@{$ftr_cnct};
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fctimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fctimeout) {
$fctimeout=$timeout if !$fctimeout;
}
my @hosts=();
if ($use eq 'ip') {
@hosts=($hostname,$ip);
} else {
@hosts=($ip,$hostname);
} my $host='';
if ($ping) {
while (1) {
my $error=0;
eval {
while ($host=pop @hosts) {
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::pingpath}ping $host");
while (my $line=
$ftpFH->{_cmd_handle}->get(
Timeout=>5)) {
if ($line=~/ from /s) {
print "TEN003\n";
$ftpFH->{_cmd_handle}->print("\003");
while (my $ln=$ftpFH->{_cmd_handle}->get) {
last if $ln=~/_funkyPrompt_$/s;
} return;
} elsif (-1<index $line,'NOT FOUND'
|| -1<index $line,'Bad IP') {
if ($line=~/_funkyPrompt_$/s) {
$error=1;return;
}
}
}
}
};
if ($@) {
next if $error;
if (-1<index $@,'read timed-out') {
print "ELEVEN003\n";
$ftpFH->{_cmd_handle}->print("\003");
while (my $ln=$ftpFH->{_cmd_handle}->get) {
last if $ln=~/_funkyPrompt_$/s;
} return 0;
} elsif ((-1<index $@,'read error') ||
(-1<index $@,'filehandle isn')) {
print $Net::FullAuto::FA_Core::MRLOG "ftm_connect::cmd() HAD TO DO LOGIN_RETRY".
" for $ftpFH->{_cmd_handle} and HOSTLABEL=$ftpFH->{_hostlabel}->[0] and $ftpFH->{_hostlabel}->[1]\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($ftpFH->{_cmd_handle}->{_cmd_handle},$stderr)=
&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$@);
if ($stderr) {
$stderr="$@\n $stderr";
return 0;
} elsif (!$ftpFH->{_cmd_handle}) {
return 0;
}
($output,$stderr)=$ftpFH->{_cmd_handle}->cmd(
"cd $ftpFH->{_work_dirs}->{_cwd}");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} elsif ($error) {
$error=0;next;
} last;
}
} elsif ($use eq 'ip') {
$host=$ip
} else { $host=$hostname }
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,$ms_share,
'','__su__');
print $Net::FullAuto::FA_Core::MRLOG "ftm_connect::cmd() BACK FROM PASSWD at Line: ",
__LINE__,"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#if ($ftm_passwd ne 'DoNotSU!') {
# $su_login=1;
#} else { $su_id='' }
$su_id=''
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,'');
}
$ftpFH->{_cmd_handle}->timeout($fctimeout);
my $fm_cnt=-1;
WE: while (1) {
foreach my $connect_method (@connect_method) {
$fm_cnt++;
if (lc($connect_method) eq 'ftp') {
$ftm_type='ftp';
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});
if ($cfh_error) {
if ($cfh_error ne 'Invalid filehandle') {
print $Net::FullAuto::FA_Core::MRLOG "ftm_connect::cmd() HAD TO DO FTP LOGIN_RETRY".
" for $ftpFH->{_cmd_handle} and HOSTLABEL=$ftpFH->{_hostlabel}->[0] and $ftpFH->{_hostlabel}->[1]\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($ftpFH->{_cmd_handle},$stderr)
=&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$stderr);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
@connect_method=();
@connect_method=@{$ftr_cnct};
next WE;
} else {
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-14');
}
}
my $showftp=
"\n LoggingG into $host via ftp . . .\n\n";
print $showftp if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG $showftp
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::ftppath}ftp $host");
FP: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftpFH->{_cmd_handle}
eq ${$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete $Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}
=$value;
last FP;
}
}
}
}
my $lin='';$stderr='';
eval {
while (my $line=$ftpFH->{_cmd_handle}->get) {
my $tline=$line;
$tline=~s/Name.*$//s;
$lin.=$line;
print $tline if !$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG $tline
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($lin=~/Name.*[: ]+$/si) {
$ftm_type='ftp';last;
}
$stderr.=$line;
if ($lin=~/s*ftp> ?$/s) {
$stderr=~s/^(.*?)(\012|\013)+//s;
$stderr=~s/s*ftp> ?$//s;
last;
}
}
};
if ($@) {
$ftpFH->{_cmd_handle}->print('bye');
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
return 0;
}
if ($su_id) {
$ftpFH->{_cmd_handle}->print($su_id);
} else {
$ftpFH->{_cmd_handle}->print($login_id);
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&wait_for_passwd_prompt($ftpFH);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$ftpFH->{_cmd_handle}->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);
next;
}
}
$ftm_type='ftp';last;
} elsif (lc($connect_method) eq 'sftp') {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$ftpFH->{_cmd_handle});
if ($cfh_error && $cfh_error ne 'Invalid filehandle') {
print "YEP GOT TO LOGIN_RETRY<==\n";
print $Net::FullAuto::FA_Core::MRLOG "ftm_connect::cmd() HAD TO DO SFTP LOGIN_RETRY".
" for $ftpFH->{_cmd_handle} and HOSTLABEL=$ftpFH->{_hostlabel}->[0] and $ftpFH->{_hostlabel}->[1]\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($ftpFH->{_cmd_handle},$stderr)
=&Rem_Command::login_retry(
$ftpFH->{_cmd_handle},
$ftpFH->{_connect},
$ftpFH->{_cmd_type},$stderr);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
@connect_method=();
@connect_method=@{$ftr_cnct};
next WE;
}
$ftm_type='sftp';
my $showsftp=
"\n LoggingH into $host via sftp . . .\n\n";
print $showsftp if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG $showsftp
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#print "SU_IDDDDDDDDDDDDDDD=$su_id and FTHH=$ftpFH and CH=$ftpFH->{_cmd_handle}<==\n";
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';
}
if ($su_id) {
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ${sshport}$su_id\@$host");
} else {
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ${sshport}$login_id\@$host");
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=&wait_for_passwd_prompt($ftpFH);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$ftpFH->{_cmd_handle}->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);
next;
}
}
SP: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($ftpFH->{_cmd_handle}
eq ${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete $Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type};
substr($type,0,3)='ftm';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last SP;
}
}
}
}
$ftm_type='sftp';last;
}
} last;
}
my $die='';my $die_login_id='';my $ftm_errmsg='';
my $su_login='';my $retrys=0;
my %ftp=();my @choices=();
while (1) {
eval {
%ftp=(
_ftp_handle => $ftpFH->{_cmd_handle},
_ftm_type => $ftm_type,
_hostname => $hostname,
_ip => $ip,
_hostlabel => [ $hostlabel, $ftpFH->{_hostlabel}->[0] ],
_uname => $uname,
_luname => $ftpFH->{_uname},
_ftp_pid => $ftpFH->{_ftp_pid}
);
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,$ftm_passwd);
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
print "I AM GOING TO TRY AND DO THE PROMPT\n";
eval {
$ftpFH->{_cmd_handle}->prompt("/s*ftp> ?\$/");
};
print "GOT PAST THE PROMPT and EVALERR=$@\n";
################## MAKE NEW SUBROUTINE START HERE
my $lin='';my $asked=0;my $authyes=0;
while (1) {
$ftpFH->{_cmd_handle}->print;
while (my $line=$ftpFH->{_cmd_handle}->get) {
print "LOOKING FOR FTPPROMPTLINE12=$line<==\n";
#print $Net::FullAuto::FA_Core::MRLOG "LOOKING FOR FTPPROMPTLINE12=$line<==\n"
#if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
$lin.=$line;
if ($lin=~/Perm/s && $lin=~/password[: ]+$/si) {
if ($su_id) {
if (!$asked++) {
my $error='';
($error=$lin)=~s/^\s*(.*)\n.*$/$1/s;
my $banner="\n The Host \"$hostlabel\" is "
."configured to attempt a su\n with "
."the ID \'$su_id\'\; however, the first "
."attempt\n resulted in the following "
."Error :\n\n $error\n\n It "
."may be that sftp is configured to "
."disallow logins\n with \'$su_id\'\."
."\n\n Please Pick an Operation :\n"
."\n NOTE: Choice will affect all "
."future logins!\n";
$choices[0]="Re-enter password and re-attempt with "
."\'$su_id\'";
$choices[1]="Attempt login with base id \'$login_id\'";
my $choice=&Menus::pick(\@choices,$banner);
chomp $choice;
if ($choice ne ']quit[') {
if ($choice=~/$su_id/s) {
my $show='';
($show=$lin)=~s/^.*?\n(.*)$/$1/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$show ";
my $newpass=<STDIN>;
chomp $newpass;
$ftpFH->{_cmd_handle}->print($newpass);
print $Net::FullAuto::FA_Core::MRLOG $show
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$lin='';last;
}
} else {
&Net::FullAuto::FA_Core::su_scrub($hostlabel,$su_id,$ftm_type);
&Net::FullAuto::FA_Core::passwd_db_update(
$hostlabel,$su_id,'DoNotSU!',
$ftm_type);
print "TWELVE003\n";
$ftpFH->{_cmd_handle}->print("\003");
while (my $line=$ftpFH->{_cmd_handle}->get) {
print $Net::FullAuto::FA_Core::MRLOG "LLINE44=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$line=~s/\s*$//s;
last if $line=~/_funkyPrompt_$/s;
last if $line=~/Killed by signal 2\.$/s;
}
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';
}
if ($sshport) {
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ".
"${sshport}$login_id\@$host");
} else {
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ".
"${sshport}$login_id\@$host");
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&wait_for_passwd_prompt($ftpFH);
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$ftpFH->{_cmd_handle}->("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle($ftpFH);
next;
}
}
## Send password.
print "444 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg,'','sftp');
$ftpFH->{_cmd_handle}->print($ftm_passwd);
my $showsftp=
"\n LoggingI into $host via sftp . . .\n\n";
print $showsftp if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG $showsftp
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last;
}
} else {
&Net::FullAuto::FA_Core::cleanup();
}
} elsif ($asked<4) {
print "YESSSSSSS WE HAVE DONE IT FOUR TIMES22\n";<STDIN>;
}
} else {
## Send password.
print "555 LIN=$lin<== and FTM_ERRMSG=$ftm_errmsg<==\n";<STDIN>;
my $showerr='';
($showerr=$lin)=~s/^.*?\n(.*)$/$1/s;
$showerr=~s/^(.*)?\n.*$/$1/s;
$retrys++;
my $ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$showerr,'','sftp','__force__');
$ftpFH->{_cmd_handle}->print($ftm_passwd);
my $showsftp=
"\n LoggingJ into $host via sftp . . .\n\n";
print $showsftp if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG $showsftp
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$lin='';next;
}
} elsif (!$authyes && (-1<index $lin,'The authen') &&
$lin=~/\?\s*$/s) {
my $question=$lin;
$question=~s/^.*(The authen.*)$/$1/s;
$question=~s/\' can\'t/\'\ncan\'t/s;
while (1) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n$question ";
my $answer=<STDIN>;
chomp $answer;
if (lc($answer) eq 'yes') {
$ftpFH->{_cmd_handle}->print($answer);
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$authyes=1;$lin='';last;
} elsif (lc($answer) eq 'no') {
print $Net::FullAuto::FA_Core::MRLOG $lin
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::cleanup()
}
}
}
if ($line=~/[\$\%\>\#\-\:]+ ?$/m) {
$lin='';last;
} elsif ($line=~/[\$\%\>\#\-\:]+ ?$/s) {
$lin='';last;
} elsif ($lin=~/Perm/s) { last }
}
if ($lin=~/Perm/s) {
$lin=~s/\s*//s;
$lin=~s/^(.*)?\n.*$/$1/s;
#while (1) {
# last if $previous_method eq $connect_method[0];
shift @connect_method;
#}
die $lin;
} else { last }
}
################## MAKE NEW SUBROUTINE END HERE
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary')
if $ftm_type ne 'sftp';
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
};
if ($@=~/ogin incor/ && $retrys<2) {
$retrys++;
if ($su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id);
$die_login_id=$su_id;
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$login_id);
$die_login_id=$login_id;
}
$ftpFH->{_cmd_handle}->print('bye');
while (my $line=$ftpFH->{_cmd_handle}->get) {
last if $line=~/_funkyPrompt_$/s;
}
$ftpFH->{_cmd_handle}->timeout($fctimeout);
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';
}
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";
if ($ftm_type eq 'ftp') {
$ftpFH->{_cmd_handle}->print("${Net::FullAuto::FA_Core::ftppath}ftp $host");
} elsif ($ftm_type eq 'sftp') {
if ($su_id) {
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ${sshport}$su_id\@$host");
} else {
$ftpFH->{_cmd_handle}->print(
"${Net::FullAuto::FA_Core::sftppath}sftp ${sshport}$login_id\@$host");
}
}
$ftpFH->{_cmd_handle}->
waitfor(-match => '/Name.*[: ]+$/i');
$@='';next;
} elsif ($@) {
my $f_t=$ftm_type;$f_t=~s/^(.)/uc($1)/e;
$die="The System $host Returned\n the "
."Following Unrecoverable Error Condition\,\n"
." XRejecting the $f_t Login Attempt"
." of the ID\n -> $die_login_id "
."at ".(caller(0))[1]." "
."line ".(caller(2))[2]." :\n\n $@";
} else { last }
}
if (defined $transfer_dir && $transfer_dir) {
if (unpack('@1 a1',$transfer_dir) eq ':') {
my ($drive,$path)=unpack('a1 @2 a*',$transfer_dir);
$path=~tr/\\/\//;
$transfer_dir="/cygdrive/$drive$path/";
}
my ($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,"cd \"$transfer_dir\"");
foreach my $line (split /^/, $output) {
print $line if !$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG $line
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
next if $line!~/^\d/;
if (unpack('a3',$line)!=250) {
my $warn="The FTP Service Cannot Change to "
."the Transfer Directory"
."\n\n -> $line\n";
warn "$warn $!";return 0;
}
} $Net::FullAuto::FA_Core::ftpcwd{$ftpFH->{_cmd_handle}}{cd}=$transfer_dir;
} return 1;
}
sub dup_Processes
{
my $cmd_handle=$_[0];
foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($cmd_handle
eq $Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}) {
return 1;
}
}
}
} return 0;
}
sub map_mirror
{
my $mirrormap=$_[0];
my $map='mirrormap';
my @keys=split '/',"$_[1]";
my $file="$_[3]";
my $reason="$_[4]";
my $num_of_levels=$#keys;
#print "REASON=$reason\n";
#print "KEYS=@keys\n";
#print "NUM_OF_LEVELS=$num_of_levels\n";
if ($_[1] eq '/') {
eval "\@{\${\$$map}[0]}[0,1,2]=(\'all\',\'/\',\'\')";
} elsif ($file ne '') {
if ("$_[2]" eq 'EXCLUDE') {
eval "push \@{\${\${\$$map}[0]}[4]}, [ \"\$file\",\"\$reason\" ]";
} else {
eval "push \@{\${\${\$$map}[0]}[3]}, [ \"\$file\",\"\$reason\" ]";
}
} else {
my $num_decrement=$num_of_levels;
my ($exclude,$num,$num_of_elem)='';
while (-1<$num_decrement--) {
$num_of_elem=eval "\$\#{$map}";
$num_of_elem=0 if $num_of_elem==-1;
$map.="\}\[$num_of_elem\]";
$map="\$\{$map";
$num++;
print "NUM=$num and KEYS=$#keys\n";
if ("$_[2]" eq 'EXCLUDE') {
print "MAPP1=$map and $keys[$num]\n";
eval "\@{\${\$$map}[0]}[0]=\'some\'";
print "MIRRORMAP=$mirrormap and THIS=${${${$mirrormap}[0]}[0]}[0]\n";<STDIN>;
print "GOT THE GOODS=",eval "\@{\${\$$map}[0]}[2]","\n";
if (eval "\${\${\$$map}[0]}[2]" eq 'EXCLUDE') {
$exclude='EXCLUDE';
}
} elsif ($#keys==$num) {
eval "\@{\${\$$map}[0]}[0,1,2]=(\'all\',\'$keys[$num]\',\'\')";
print "MIRRORMAP=$mirrormap and THIS=${${${$mirrormap}[0]}[0]}[0]\n";<STDIN>;
}
}
}
return $mirrormap;
}
#print "BFH=$baseFH and KEY=$key and FILE=\@files and DESTDR=$dest_fdr and LCD=$local_transfer_dir and TRANTAR=$trantar and BHOIS=$bhostlabel and DHOST=$dhostlabel\n";<STDIN>;
# $trantar=move_files($baseFH,"$key",
# \@files,$dest_fdr,
# $destFH,$bms_share,$dms_share,
# '',$local_transfer_dir,$trantar,
# $bhostlabel,$dhostlabel,'',
# $shortcut,\%desthash);
sub move_files
{
print "MOVE_FILESCALLER=",caller,"\n";<STDIN>;
my ($baseFH,$key,$file,$dest_fdr,
$destFH,$bms_share,$dms_share,$nosubs,
$local_transfer_dir,$trantar,$bhostlabel,
$dhostlabel,$parentkey,$shortcut) = @_;
print "BASEFH=$baseFH\n";
print "KEY=$key\n";
print "FILE=$file\n";
print "DEST_FDR=$dest_fdr\n";
print "DESTFH=$destFH\n";
print "BMS_SHARE=$bms_share\n";
print "DMS_SHARE=$dms_share\n";
print "NOSUBS=$nosubs\n";
print "LOCALTRANSFERDIR=$local_transfer_dir\n";
print "TRANTAR=$trantar\n";
print "BHOSTLABEL=$bhostlabel\n";
print "DHOSTLABEL=$dhostlabel\n";<STDIN>;
my $basefile='';my $basedir='';my $destdir='';my $msprxFH='';
my $w32copy='';my $output='';my $stderr='';my $destd='';my $baseprx='';
if ($bms_share || $baseFH->{_uname} eq 'cygwin') {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd};
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd}$key";
} $basedir.='/' if $file;
if ($dms_share || $destFH->{_uname} eq 'cygwin') {
if ((exists $destFH->{_smb})
&& (exists $baseFH->{_smb})) {
print "HEREEEEEEEEE1\n";
$msprxFH=$destFH;
} elsif (exists $baseFH->{_smb}) {
$msprxFH=$baseFH;
} elsif ($dhostlabel ne "__Master_${$}__") {
&Net::FullAuto::FA_Core::handle_error('NO Microsoft OS Proxy Host Defined');
}
if ($dhostlabel ne "__Master_${$}__") {
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$key";
} $destdir.='/' if $file;
} elsif (unpack('a1',$dest_fdr) eq '/') {
my $testd=&test_dir($destFH->{_cmd_handle},$dest_fdr);
if ($destFH->{_uname} eq 'cygwin') {
my $testd=&test_dir($destFH->{_cmd_handle},$dest_fdr);
if ($testd ne 'WRITE') {
if ($testd eq 'NODIR') {
my $destdir_mswin='';
($destdir,$destdir_mswin)
=&File_Transfer::get_drive($dest_fdr,'Destination',
'',$dhostlabel);
($output,$stderr)=$destFH->cwd($destdir);
my $die="Destination Directory $dest_fdr\n"
.' Does NOT Exist!:\n\n '
.$stderr;
if ($stderr) {
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
}
} else {
my $die="Destination Directory $dest_fdr\n"
.' is NOT Writable!';
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
}
}
$dest_fdr=&Net::FullAuto::FA_Core::attempt_cmd_xtimes($destFH,
'cmd /c chdir',$dhostlabel);
$dest_fdr=unpack('a2',$dest_fdr);
$dest_fdr=~tr/\\/\//;
} elsif ($testd ne 'WRITE') {
if ($testd eq 'NODIR') {
my $die="Destination Directory $dest_fdr\n"
.' Does NOT Exist!';
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
} else {
my $die="Destination Directory $dest_fdr\n"
.' is NOT Writable!';
if (wantarray) {
return '',$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die);
}
}
}
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$destdir/$key";
} $destdir.='/' if $file;
} elsif (unpack('x1 a1',$dest_fdr) eq ':') {
$destFH->{_work_dirs}->{_pre}=
$destFH->{_work_dirs}->{_cwd};
$destFH->{_work_dirs}->{_pre_mswin}=
$destFH->{_work_dirs}->{_cwd_mswin};
my ($drive,$path)=unpack('a1 x1 a*',$dest_fdr);
$path=~tr/\\/\//;
$destFH->{_work_dirs}->{_cwd_mswin}=$dest_fdr;
$destFH->{_work_dirs}->{_cwd}=$destFH->{_cygdrive}
.'/'.lc($drive).$path.'/';
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd};
} else {
$destdir="$destFH->{_work_dirs}->{_cwd}$key";
} $destdir.='/' if $file;
} else {
if ($key eq '/') {
$destdir=$destFH->cmd('pwd');
} else {
$destdir=$destFH->cmd('pwd')."/$key";
} $destdir.='/' if $file;
$destdir=~tr/\\/\//;
}
} else {
if ((exists $baseFH->{_smb}) ||
$baseFH->{_uname} eq 'cygwin') {
$msprxFH=$baseFH;
} elsif ($bhostlabel ne "__Master_${$}__") {
&Net::FullAuto::FA_Core::handle_error(
'NO Microsoft OS Proxy Host Defined');
}
if ($destFH->{_work_dirs}->{_tmp}) {
if ($key eq '/') {
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};
} else {
$destdir="$destFH->{_work_dirs}->{_cwd_mswin}$key";
} $destdir.='/' if $file;
} elsif ($key ne '/') {
$destdir=$key;
}
$trantar=1;
}
} elsif ($dms_share) {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd_mswin};
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd_mswin}$key";
$destdir="$destFH->{_work_dirs}->{_cwd_mswin}$key";
} $basedir.='/' if $file;
$destdir.='/' if $file;
$destdir=~tr/\//\\/;
$destdir=~s/\\/\\\\/g;
if (exists $destFH->{_smb}) {
$msprxFH=$destFH;
} elsif ($dhostlabel ne "__Master_${$}__") {
&Net::FullAuto::FA_Core::handle_error(
'NO Microsoft OS Proxy Host Defined');
}
} else {
if ($key eq '/') {
$basedir=$baseFH->{_work_dirs}->{_cwd_mswin};
} else {
$basedir="$baseFH->{_work_dirs}->{_cwd_mswin}$key";
} $basedir.='/' if $file;
$destdir=$key;$trantar=1;
}
my $b_OS='';my $m_OS='';my $d_OS='';my $FH='';
if ($^O eq 'cygwin') {
if ($bms_share || ($baseFH->{_uname} eq 'cygwin' &&
$bhostlabel eq "__Master_${$}__")) {
if ($dms_share || $destFH->{_uname} eq 'cygwin') {
$b_OS=$m_OS=$d_OS='cygwin';
} else {
$b_OS=$m_OS='cygwin';
$d_OS='Unix';
} $msprxFH=$Net::FullAuto::FA_Core::localhost;
} elsif ($dms_share) {
$m_OS=$d_OS='cygwin';
$b_OS='Unix';
print "HEREEEEEEEEE7\n";
$msprxFH=$Net::FullAuto::FA_Core::localhost;
$Net::FullAuto::FA_Core::tran[1]="__Master_${$}__";
if ($msprxFH->{_work_dirs}->{_tmp}) {
my ($output,$stderr)=$msprxFH->cwd(
$msprxFH->{_work_dirs}->{_tmp});
if ($stderr) {
@FA_Core::tran=();
my $die="Cannot cd to TransferDir -> "
."$msprxFH->{_work_dirs}->{_tmp}\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die,'-6');
} $Net::FullAuto::FA_Core::tran[0]=$msprxFH->{_work_dirs}->{_tmp};
} else {
$Net::FullAuto::FA_Core::tran[0]=$msprxFH->cmd('pwd');
}
} else {
$m_OS='cygwin';
$b_OS=$d_OS='Unix';
}
} else {
if ($bms_share || $baseFH->{_uname} eq 'cygwin') {
if ($dms_share || $destFH->{_uname} eq 'cygwin') {
$b_OS=$d_OS='cygwin';
$m_OS='UNIX';
print "HEREEEEEEEEE8\n";
$msprxFH=$baseFH;
} else {
$b_OS='cygwin';
$m_OS=$d_OS='Unix';
}
} elsif ($dms_share) {
$d_OS='cygwin';
$b_OS=$m_OS='Unix';
print "HEREEEEEEEEE9\n";
$destdir=$destFH->{_work_dirs}->{_cwd_mswin};
} else {
$b_OS=$m_OS=$d_OS='Unix';
}
}
#if ($msprxFH) {
# ($output,$stderr)=$msprxFH->cmd('cp','__notrap__');
# if (unpack('a11',$stderr) ne 'cp: missing') {
# $w32copy=1;
# }
#}
&move_file_list($file,$basedir,
$destdir,$msprxFH,$baseFH,
$destFH,$key,$w32copy,
$local_transfer_dir,
$b_OS,$m_OS,$d_OS,
$parentkey)
if !$shortcut || !$msprxFH || $b_OS ne 'cygwin';
return $trantar;
}
sub move_file_list
{
my @topcaller=caller;
print "MOVEFILELISTCALLER=",(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
my ($file,$basedir,$destdir,$msprxFH,$baseFH,
$destFH,$key,$w32copy,$local_transfer_dir,
$b_OS,$m_OS,$d_OS,$parentkey,$shortcut)=@_;
print "BASEDIR=$basedir<===\n";#<STDIN>;
my $farg='';my $filearg='';my $proxydir='';
my $output='';my $stderr='';
if ($msprxFH) { ### if MS Proxy Needed
if ($b_OS eq 'cygwin') { ### if Base Needs Proxy
if ($d_OS eq 'cygwin') { ### Dest Does Not Need Proxy
foreach my $fil (@{$file}) {
$fil=~s/%/\\%/g;
$farg.="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";
if (1500<length "$farg$destdir") {
$filearg=~tr/\\/\//;
$destdir.=$key if $key;
$destdir=~tr/\\/\//;
chop $filearg;
my $td="--target-directory=$destdir";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap_');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
'',$msprxFH,'')
}
}
$farg="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";
} $filearg=$farg;
}
if ($filearg) {
$filearg=~tr/\\/\//;
$destdir=~tr/\\/\//;
chop $filearg;
my $td="--target-directory=$destdir";
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$destdir,$msprxFH,'')
}
}
} #else {
# &move_MSWin_stderr('','',$destdir,$msprxFH,'')
#}
} else { ### Dest Needs Proxy
if ($key && $key ne '/' && ($file
|| $parentkey eq ')DIRONLY')) {
$proxydir="\".\\transfer$Net::FullAuto::FA_Core::tran[3]\\$key\"";
} else {
$proxydir="\".\\transfer$Net::FullAuto::FA_Core::tran[3]$parentkey\"";
}
$proxydir=~tr/\\/\//;
my $td="--target-directory=$proxydir";
if ($file) {
foreach my $fil (@{$file}) {
$fil=~s/%/\\%/g;
$farg.="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";
if (1500<length "$farg$proxydir") {
$filearg=~tr/\\/\//;
chop $filearg;
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$proxydir,$msprxFH,'')
}
}
$farg="\'$baseFH->{_work_dirs}->{_cwd}$basedir$fil\' ";
} $filearg=$farg;
}
if ($filearg) {
$filearg=~tr/\\/\//;
chop $filearg;
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -fpv $filearg $td",'__notrap__');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$proxydir,$msprxFH,'')
}
}
} #else {
# &move_MSWin_stderr('','',$proxydir,$msprxFH,'')
#}
} elsif ($parentkey ne ')DIRONLY') {
my $fdot='';
$fdot='/.' if $key eq '/';
#$filearg.="\'$baseFH->{_work_dirs}->[0]$basedir$fdot\'";
$filearg.="\'$baseFH->{_work_dirs}->{_cwd}$fdot\'";
$filearg=~tr/\\/\//;
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -Rfpv $filearg $td",'__notrap__');
if ($stderr) {
&clean_process_files($msprxFH);
if (-1==index $stderr,'already exists') {
&move_MSWin_stderr($stderr,$filearg,
$proxydir,$msprxFH,'R')
}
}
} else {
&move_MSWin_stderr('','',$proxydir,$msprxFH,'')
}
}
} else { ### Dest Needs Proxy
$destdir=~tr/\\/\//;
my $td.=$destdir;
$td="--target-directory=$td";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
($output,$stderr)=$msprxFH->cmd(
"cmd /c cp -Rfpv ./transfer$Net::FullAuto::FA_Core::tran[3]/* \"$td\"");
if ($stderr) {
my $die="Could not Execute the Command :"
."\n\n cmd /c cp -Rfpv ./transfer"
."$Net::FullAuto::FA_Core::tran[3]/* \"$td\"\n\n "
. $stderr;
&Net::FullAuto::FA_Core::handle_error($die,'-7');
}
}
}
}
sub clean_process_files
{
my @topcaller=caller;
print "CLEAN_PROCESS_FILES-CALLER=",
(join ' ',@topcaller),"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
my $self=$_[0];
my $pid_ts=pop @FA_Core::pid_ts;
$pid_ts||='';return '','' if !$pid_ts;
my $str="echo \"del rm${pid_ts}.bat\"";
my $output='';my $stderr='';
$str.=" >> rm${pid_ts}.bat";
($output,$stderr)=$self->cmd($str);
if ($stderr) {
push @FA_Core::pid_ts, $pid_ts;
my $die= "$stderr\n\n From Command -> " . "\"$str\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
if ($self->{_uname} eq 'cygwin') {
$output=join '',$self->{_cmd_handle}->cmd(
"cmd /c rm${pid_ts}.bat");
} else {
$output=join '',$self->{_cmd_handle}->{_cmd_handle}->cmd(
"cmd /c rm${pid_ts}.bat");
}
if ($stderr) {
push @FA_Core::pid_ts, $pid_ts;
my $die="$stderr\n\n From Command -> "
."\"cmd /c rm${pid_ts}.bat\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
#($output,$stderr)=$localhost->cmd(
# "rm -f ${trandir}out${pid_ts}.txt");
if (0 && $^O ne 'cygwin') {
print "WHAT THE HECK IS LOCALDIR=",$localhost->cmd("pwd"),"\n";
($output,$stderr)=$localhost->cmd(
"rm -f out${pid_ts}.txt");
if ($stderr) {
push @FA_Core::pid_ts, $pid_ts;
my $die="$stderr\n\n From Command -> "
."\"rm -f out${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
#($output,$stderr)=$localhost->cmd(
# "rm -f ${trandir}err${pid_ts}.txt");
($output,$stderr)=$localhost->cmd(
"rm -f err${pid_ts}.txt");
if ($stderr) {
push @FA_Core::pid_ts, $pid_ts;
my $die="$stderr\n\n From Command -> "
."\"rm -f err${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
}
}
sub move_MSWin_stderr
{
#print "MSWin_stderrCALLER=",caller,"\n";
my ($stderr,$filearg,$destdir,$FH,$option)=@_;
my $output='';
if (!$stderr || (-1<index $stderr,"No such file")
|| (-1<index $stderr,"not a directory")) {
my $destd='';
if (unpack('a10',$destdir) eq '/cygdrive/') {
$destd=unpack('x10 a*',$destdir);
$destd=~s/^(.)/$1:/;
} else { $destd=$destdir }
$destd=~tr/\//\\/;
$stderr='';
($output,$stderr)=$FH->cmd(
"cmd /c mkdir \"$destd\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr
&& (-1==index $stderr,'already exists');
if (!$Net::FullAuto::FA_Core::tran[4] &&
17<length $destd &&
-1<index $destd,"transfer$Net::FullAuto::FA_Core::tran[3]") {
$Net::FullAuto::FA_Core::tran[0]="transfer$Net::FullAuto::FA_Core::tran[3]";
$Net::FullAuto::FA_Core::tran[1]= ($FH->{_hostlabel}->[1]) ?
$FH->{_hostlabel}->[1] : $FH->{_hostlabel}->[0];
$Net::FullAuto::FA_Core::tran[4]=1;
} return if !$filearg;
$stderr='';
my $td="--target-directory=$destdir";
my $e_cnt=0;
($output,$stderr)=$FH->cmd(
"cmd /c cp -${option}fpv $filearg $td");
if ($stderr) {
my $subwarn="WARNING! COPY ERROR";
my %mail=(
'Body' => "$stderr",
'Subject' => "$subwarn AND \$filearg=$filearg"
);
&Net::FullAuto::FA_Core::send_email(\%mail);
print $Net::FullAuto::FA_Core::MRLOG $stderr
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($stderr,'-12') if $stderr
&& (-1==index $stderr,'already exists');
}
} else {
print $Net::FullAuto::FA_Core::MRLOG $stderr
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($stderr,'-1');
}
}
sub build_mirror_hashes
{
my $hostlabel='';
my $timehash={};my $num_of_files=0;my $num_of_basefiles=0;
my $timekey='';my $deploy_needed=0;my $output='';
my $baseFH=$_[0];
my $destFH=$_[1];
my $bhostlabel=$_[2];
my $dhostlabel=$_[3];
my $verbose=$_[4];
my $base_uname='';
my $dest_uname='';
my $base_windows_daylight_savings=0;
my $dest_windows_daylight_savings=0;
my $stdout='';
my $stderr='';
my $deploy_empty_dir=0;
my $dest_dir_status='';
my $deploy_info='';
my $debug_info='';
eval {
$num_of_files=${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"}
if exists ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"};
delete ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFFILES"};
$num_of_basefiles=
${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"}
if exists ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"};
delete ${$baseFH->{_bhash}}{"___%EXCluD%E--NUMOFBASEFILES"};
delete ${$destFH->{_dhash}}{"___%EXCluD%E--NUMOFFILES"};
delete ${$destFH->{_dhash}}{"___%EXCluD%E--NUMOFBASEFILES"};
if ($num_of_files) {
print "mirror() NUM_OF_FILES=$num_of_files\n",
"mirror() NUM_OF_BASEFILES=$num_of_basefiles\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"mirror() NUM_OF_FILES=$num_of_files\n",
"mirror() NUM_OF_BASEFILES=$num_of_basefiles\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
foreach my $key (sort keys %{$baseFH->{_bhash}}) {
next if ${$baseFH->{_bhash}}{$key}[0] eq 'EXCLUDE';
my @keys=();
if (${$baseFH->{_bhash}}{$key}[2] eq 'DEPLOY_NOFILES_OF_CURDIR') {
${$baseFH->{_bhash}}{$key}[0]='SOME';
if (-1<index $key,'/') {
my $chkkey=$key;
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;
last if -1==index $chkkey,'/';
}
} unshift @keys, '/';
foreach my $key (@keys) {
${$baseFH->{_bhash}}{$key}[0]='SOME';
} next
}
my $dest_dir_status='';
if ($key ne '/') {
if (-1==$#keys) {
if (-1<index $key,'/') {
my $chkkey=$key;
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;
last if -1==index $chkkey,'/';
}
} unshift @keys, '/';
}
if (!exists ${$destFH->{_dhash}}{$key}) {
print "mirror() ERROR: WHAT IS THE BAD KEY==>$key<==\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"mirror() ERROR: WHAT IS THE BAD KEY==>$key<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
${$baseFH->{_bhash}}{$key}[3]='NOT_ON_DEST';
$dest_dir_status='DIR_NOT_ON_DEST';
$deploy_info.="DEPLOY EMPTY DIR $key - DIR_NOT_ON_DEST\n";
$debug_info.="DEPLOY EMPTY DIR $key - DIR_NOT_ON_DEST\n";
$deploy_empty_dir=$deploy_needed=1;
} else {
${$baseFH->{_bhash}}{$key}[3]='DIR_ON_DEST';
$dest_dir_status='DIR_ON_DEST';
}
}
my $skip=0;my $deploy=0;
foreach my $file (sort keys %{${$baseFH->{_bhash}}{$key}[1]}) {
#if ($key=~/yglasa/) {
#print "DEST_DIR_STATUS=$dest_dir_status and KEY=$key\n";
#print "FILE=$file and BASEHASH=",
# @{${$baseFH->{_bhash}}{$key}[1]{$file}},"<==\n";
#print "DESTHASH=",${$destFH->{_dhash}}{$key}[1]{$file},"\n" if exists
# ${$destFH->{_dhash}}{$key}[1]{$file};<STDIN>;
#}
if (${$baseFH->{_bhash}}{$key}[1]{$file}[0] eq 'EXCLUDE') {
print "mirror() SKIP1=> KEY=$key and FILE=$file\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"mirror() SKIP1=> KEY=$key and FILE=$file\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($key eq '/') {
$debug_info.="SKIP FILE $file - EXCLUDED_BY_FILTER\n";
} else {
$debug_info.="SKIP FILE $key/$file - EXCLUDED_BY_FILTER\n";
}
$skip=1;next;
} my $dchmod='';my $dtime='';my $dyear='';my $dsize='';
my $dtime1='';my $dtime2='';my $dtime3='';
if (exists ${$destFH->{_dhash}}{$key}[1]{$file}) {
print "mirror() STRING_DEST=",
${${$destFH->{_dhash}}{$key}[1]{$file}}[1],
" and FILE=$file AND KEY=$key\n"
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose;
print $Net::FullAuto::FA_Core::MRLOG
"mirror() STRING_DEST=",
${${$destFH->{_dhash}}{$key}[1]{$file}}[1],
" and FILE=$file AND KEY=$key\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $y=qr(\d\d\d\d);
${${$destFH->{_dhash}}{$key}[1]{$file}}[1]=~
/^(\d+\s+)(\d+)(\s+\d+\s+\d+)\s+($y)\s+(\d+)\s*(\d*)*\s*$/;
$dtime1=$1;$dtime2=$2;$dtime3=$3;
$dyear=$4;$dsize=$5;$dchmod=$6;
$dtime2="0$dtime2" if length $dtime2==1;
$dtime=$dtime1.$dtime2.$dtime3;
$dchmod||='';
}
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1]=~
/^(\d+\s+)(\d+)(\s+\d+\s+\d+)\s+(\d\d\d\d)\s+(\d+)\s*(\d*)*\s*$/;
unless ($base_uname) {
$base_uname=$baseFH->{_uname};
if ($base_uname eq 'cygwin') {
my $key_dir=($key ne '/')?"$key/":'/';
($stdout,$stderr)=$baseFH->cmd("stat \".$key$file\"");
my $isto=(index $stdout,'Modify: ')+19;
$stdout=unpack("x$isto a2",$stdout);
my $st=unpack('x6 a2',
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1]);
$base_windows_daylight_savings=1 if $st!=$stdout;
}
}
print "mirror() STRING_BASE=",
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1],
" and FILE=$file AND KEY=$key\n"
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) || $verbose;
print $Net::FullAuto::FA_Core::MRLOG
"mirror() STRING_BASE=",
${${$baseFH->{_bhash}}{$key}[1]{$file}}[1],
" and FILE=$file AND KEY=$key\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $btime1=$1;my $btime2=$2;my $btime3=$3;
my $byear=$4;my $bsize=$5;my $bchmod=$6;
$btime2="0$btime2" if length $btime2==1;
my $btime=$btime1.$btime2.$btime3;
$bchmod||='';
if ($dest_dir_status eq 'DIR_NOT_ON_DEST') {
if ($key eq '/') {
$deploy_info.="DEPLOY FILE $file - DIR_NOT_ON_DEST\n";
$debug_info.="DEPLOY FILE $file - DIR_NOT_ON_DEST\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=$file;
}
} else {
$deploy_info.="DEPLOY FILE $key/$file - DIR_NOT_ON_DEST\n";
$debug_info.="DEPLOY FILE $key/$file - DIR_NOT_ON_DEST\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="NOT_ON_DEST $bsize $dsize";
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;
print "mirror() DEPLOY NEEDED for KEY=$key and ",
"FILE=$file because DIR_NOT_ON_DEST\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"mirror() DEPLOY NEEDED for KEY=$key and ",
"FILE=$file because DIR_NOT_ON_DEST\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$deploy_needed=$deploy=1;
$btime=~tr/ //;
if ($key ne '/') {
$timekey="$key/$file";
} else { $timekey=$file }
print "UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$timehash->{$timekey}=[$byear,$btime];
next;
}
if (exists ${$destFH->{_dhash}}{$key}[1]{$file}) {
if ($bsize ne $dsize) {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="DIFF_SIZE $bsize $dsize";
if ($key eq '/') {
$deploy_info.="DEPLOY(a) $file - DIFF_SIZE\n";
$debug_info.="DEPLOY $file - DIFF_SIZE\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;
}
} else {
$deploy_info.="DEPLOY(b) $key/$file - DIFF_SIZE\n";
$debug_info.="DEPLOY $key/$file - DIFF_SIZE\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
print "DEPLOY NEEDED for KEY=$key and FILE=$file ",
"because DIFF SIZE BSIZE=$bsize and DSIZE=$dsize\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"DEPLOY NEEDED for KEY=$key and FILE=$file ",
"because DIFF SIZE BSIZE=$bsize and DSIZE=$dsize\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$deploy_needed=$deploy=1;
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
$btime=~tr/ //;
if ($key ne '/') {
$timekey="$key/$file";
} else { $timekey=$file }
print "UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"UPDATEING TIMEHASH1=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
${$timehash}{$timekey}=[$byear,$btime];
next;
}
my ($bmndy,$bhr,$bmt)
=unpack('a5 x1 a2 x1 a2',$btime);
my ($dmndy,$dhr,$dmt)
=unpack('a5 x1 a2 x1 a2',$dtime);
if ($btime ne $dtime) {
unless ($dest_uname) {
$dest_uname=$destFH->{_uname};
if ($dest_uname eq 'cygwin') {
my $key_dir=($key ne '/')?"$key/":'/';
($stdout,$stderr)=$destFH->cmd(
"stat \".$key_dir$file\"");
my $isto=(index $stdout,'Modify: ')+19;
$stdout=unpack("x$isto a2",$stdout);
my $st=unpack('x6 a2',
${${$destFH->{_dhash}}{$key}[1]{$file}}[1]);
$dest_windows_daylight_savings=1 if $st!=$stdout;
}
}
my $btim=unpack('x6 a2',$btime);
my $dtim=unpack('x6 a2',$dtime);
my $btme=$btime;
my $dtme=$dtime;
substr($btme,6,2)='';
substr($dtme,6,2)='';
my $testnum='';
if ($dtim<$btim) {
$testnum=$btim-$dtim;
} else { $testnum=$dtim-$btim }
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;
my $testdhr=$dtime;
my $testbhr=$btime;
if ($dhr eq '23') {
substr($testdhr,6,2)='01';
} else {
my $ddhr=$dhr+1;
$ddhr='0'.$ddhr if length $ddhr==1;
substr($testdhr,6,2)=$ddhr;
}
if ($bhr eq '23') {
substr($testbhr,6,2)='01';
} else {
my $bbhr=$bhr+1;
$bbhr='0'.$bbhr if length $bbhr==1;
substr($testbhr,6,2)=$bbhr;
}
if ((!($base_windows_daylight_savings &&
$dest_windows_daylight_savings)) &&
(($base_windows_daylight_savings &&
($testbhr eq $dtime)) ||
($dest_windows_daylight_savings &&
($testdhr eq $btime)))) {
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
$skip=1;
if ($key eq '/') {
$debug_info.=
"SKIP FILE $file - SAME_SIZE_TIME_STAMP1\n";
} else {
$debug_info.=
"SKIP FILE $key/$file - SAME_SIZE_TIME_STAMP1\n";
}
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="SAME $btime $bsize";
next;
} elsif ($dtim<$btim &&
exists $Net::FullAuto::FA_Core::Hosts{
$dhostlabel}{'TimeStamp'}
&& lc($Net::FullAuto::FA_Core::Hosts{$dhostlabel}
{'TimeStamp'}) eq 'newer') {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="NEWR_TIME $btime $dtime";
if ($key eq '/') {
$deploy_info.="DEPLOY(c) $file - NEWR_TIME\n";
$debug_info.="DEPLOY $file - NEWR_TIME\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;
}
} else {
$deploy_info.="DEPLOY(d) $key/$file - NEWR_TIME\n";
$debug_info.="DEPLOY $key/$file - NEWR_TIME\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
$deploy_needed=$deploy=1;
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
} else {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="DIFF_TIME $btime $dtime";
if ($key eq '/') {
$deploy_info.="DEPLOY(e) $file - DIFF_TIME\n";
$debug_info.="DEPLOY $file - DIFF_TIME\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
$file;
}
} else {
$deploy_info.="DEPLOY(f) $key/$file - DIFF_TIME\n";
$debug_info.="DEPLOY $key/$file - DIFF_TIME\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
$deploy_needed=$deploy=1;
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
}
} else {
delete ${$destFH->{_dhash}}{$key}[1]{$file}
if $dest_dir_status ne 'DIR_NOT_ON_DEST';
${$baseFH->{_bhash}}{$key}[1]{$file}[0]
="SAME $btime $bsize";
if ($key eq '/') {
$debug_info.=
"SKIP FILE $file - SAME_SIZE_TIME_STAMP2\n";
} else {
$debug_info.=
"SKIP FILE $key/$file - SAME_SIZE_TIME_STAMP2\n";
}
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;
$skip=1;next;
}
} else {
${$baseFH->{_bhash}}{$key}[1]{$file}[0]='NOT_ON_DEST';
${$baseFH->{_bhash}}{$key}[1]{$file}[2]=$bchmod;
if ($key eq '/') {
$deploy_info.="DEPLOY(g) $file - NOT_ON_DEST\n";
$debug_info.="DEPLOY $file - NOT_ON_DEST\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{$file}=$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=$file;
}
} else {
$deploy_info.="DEPLOY(h) $key/$file - NOT_ON_DEST\n";
$debug_info.="DEPLOY $key/$file - NOT_ON_DEST\n";
if (99<length "$key/$file") {
my $tmp_file_name="X_".time."_"
.$Net::FullAuto::FA_Core::increment++
."_X.mvx";
$Net::FullAuto::FA_Core::file_rename{"$key/$file"}=
$tmp_file_name;
$Net::FullAuto::FA_Core::rename_file{$tmp_file_name}=
"$key/$file";
}
}
$deploy_needed=$deploy=1;
}
$btime=~tr/ //;
if ($key ne '/') {
$timekey="$key/$file";
} else { $timekey=$file }
${$timehash}{$timekey}=[$byear,$btime];
print $Net::FullAuto::FA_Core::MRLOG "UPDATEING TIMEHASH3=> TIMEKEY(FILE)=$timekey ",
"and BYEAR=$byear and BTIME=$btime\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
if ($skip) {
if ($deploy) {
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_SOMEFILES_OF_CURDIR';
${$baseFH->{_bhash}}{$key}[0]='SOME';
foreach my $key (@keys) {
${$baseFH->{_bhash}}{$key}[0]='SOME';
}
} else {
delete ${$destFH->{_dhash}}{$key}
if !keys %{${$destFH->{_dhash}}{$key}[1]};
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_NOFILES_OF_CURDIR';
${$baseFH->{_bhash}}{$key}[0]='EXCLUDE'
if ${$baseFH->{_bhash}}{$key}[0] ne 'SOME'
&& ${$baseFH->{_bhash}}{$key}[0] ne 'NOT_ON_DEST';
}
} elsif ($deploy) {
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_SOMEFILES_OF_CURDIR';
} else {
delete ${$destFH->{_dhash}}{$key}
if !keys %{${$destFH->{_dhash}}{$key}[1]};
${$baseFH->{_bhash}}{$key}[2]='DEPLOY_NOFILES_OF_CURDIR';
${$baseFH->{_bhash}}{$key}[0]='EXCLUDE'
if ${$baseFH->{_bhash}}{$key}[0] ne 'SOME'
&& ${$baseFH->{_bhash}}{$key}[0] ne 'NOT_ON_DEST'
&& !$deploy_empty_dir;
} $deploy_empty_dir=0;
} ${$baseFH->{_bhash}}{'/'}[0]='EXCLUDE' if !$deploy_needed;
};
if ($@) {
if (unpack('a10',$@) eq 'The System') {
return '','','','',$@;
} else {
print "XXXXXXXXXXXXXX\n";
my $die="The System $hostlabel Returned"
."\n the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]." "
."line ".(caller(0))[2]." :\n\n $@";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return '','','','',$die;
}
}
print $Net::FullAuto::FA_Core::MRLOG "KEYSBASEHASHTEST=",keys %{$baseFH->{_bhash}},"\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $baseFH, $destFH, $timehash, $deploy_info, $debug_info;
}
sub build_base_dest_hashes
{
#print "BBDH CALLER=",caller,"\n";
my $modifiers='';my $mod_dirs_flag='';
my $mod_files_flag='';my $s=0;
my $num_of_included=0;my $num_of_excluded=0;
my @modifiers=();
my $base_or_dest_folder=$_[0];
my $ms_share=$_[4];$ms_share||='';
my $ms_domain=$_[5];$ms_domain||='';
my $cygwin = (-1<index lc($_[6]),'cygwin') ? 1 : 0;
my $cmd_handle=$_[7];$cmd_handle||='';
my $base_dest=$_[8];
my $lsgnu=$_[9];
my $zipdir=$_[10]||'';
my $bd='';
$bd=($base_dest eq 'BASE')?'b':'d';
my ($stdout,$stderr)=('','');
my %navhash=();
eval {
if ($_[2]) { # If we have Directives
my @directives=@{$_[2]};my @delim=();
foreach my $directive (@directives) {
$s=0;$s=1 if $directive=~/^s/;
if ($s==1 || substr($directive,0,1) eq 'm') {
$delim[0]=substr($directive,1,1);
} else { $delim[0]=substr($directive,0,1); }
if ($delim[0] eq '(') { $delim[1]=')' }
elsif ($delim[0] eq '[') { $delim[1]=']' }
elsif ($delim[0] eq '{') { $delim[1]='}' }
else { $delim[1]=$delim[0] }
my $rindex=rindex $directive,$delim[1];
my $modifiers=lc(substr($directive,$rindex+1));
my $regex=substr($directive,(index $directive,$delim[0])+1,
$rindex-1);
my $perl_mods='';
my $mods='';
if ($directive=~/^s/) {
$s=1;
$perl_mods.='g' if -1<index $modifiers,'g';
$perl_mods.='e' if -1<index $modifiers,'e';
} elsif (-1<index $modifiers,'e') { $mods.='e' }
$perl_mods.='i' if -1<index $modifiers,'i';
if (-1<index $modifiers,'d') {
if ($s) {
push @modifiers, [ qr/$regex/,$perl_mods,"s$mods",'d' ];
} elsif (-1<index $modifiers,'e') {
push @modifiers, [ qr/$regex/,$perl_mods,$mods,'d' ];
} else {
push @modifiers, [ qr/$regex/,$perl_mods,"${mods}i",'d' ];
} $mod_dirs_flag=1;
} else {
if ($s) {
push @modifiers, [ qr/$regex/,$perl_mods,"s$mods",'f' ];
} elsif (-1<index $modifiers,'e') {
push @modifiers, [ qr/$regex/,$perl_mods,$mods,'f' ];
} else {
push @modifiers, [ qr/$regex/,$perl_mods,"${mods}i",'f' ];
} $mod_files_flag=1;
}
}
sub regx_prog
{
my @topcaller=caller;
print "regx_prog() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "regx_prog() CALLER=",
(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $ex=$_[0];my $type=$_[1];
my $sub = sub {
my $result=0;my $string='';$_[1]||='';
if ($type eq 'f' && $_[1] ne ''
&& -1<index ${$ex}[0],'/') {
if ($_[1] eq '/') {
$string=$_[0];
} else {
$_[1]=~s/\/+$//;
$string="$_[1]/$_[0]";
}
} else { $string=$_[0] }
if (-1<index ${$ex}[1],'s') {
if (-1<index ${$ex}[1],'g') {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#sgi;
} else {
$result=1 if $string=~m#${$ex}[0]#sg;
}
} else {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#si;
} else {
$result=1 if $string=~m#${$ex}[0]#s;
}
}
} elsif (-1<index ${$ex}[1],'m') {
if (-1<index ${$ex}[1],'g') {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#mgi;
} else {
$result=1 if $string=~m#${$ex}[0]#mg;
}
} else {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#mi;
} else {
$result=1 if $string=~m#${$ex}[0]#m;
}
}
} elsif (-1<index ${$ex}[1],'g') {
if (-1<index ${$ex}[1],'i') {
$result=1 if $string=~m#${$ex}[0]#gi;
} else {
$result=1 if $string=~m#${$ex}[0]#g;
}
} else {
$result=1 if $string=~m#${$ex}[0]#;
} return $result,${$ex}[2]||'';
};
$sub; # Save Pound Sign
}
}
my $len_dir='';my $archive_flag=0;
if ($zipdir) {
my $ln=substr(${$_[1]},0,(index ${$_[1]},"\n"));
$zipdir=~s/\/+$//;
$len_dir=length " xx-xx-xx 00:00 $zipdir";
} elsif (!$ms_share && !$ms_domain && !$cygwin) {
$len_dir=(length $base_or_dest_folder)+2;
} elsif ($base_or_dest_folder=~/$cmd_handle->{_cygdrive_regex}/) {
my $tmp_basedest=$base_or_dest_folder;
$tmp_basedest=~s/$cmd_handle->{_cygdrive_regex}//;
substr($tmp_basedest,0,1)=unpack('a1',$tmp_basedest).':';
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length ".Directory.of${d}$tmp_basedest/";
} elsif ($ms_share) {
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length
".Directory.of$d$_[3].$_[4].$base_or_dest_folder";
$len_dir=$len_dir-2
if substr($base_or_dest_folder,-2) eq '/.';
} elsif ($base_or_dest_folder=~/^\w:/) {
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length ".Directory.of${d}$base_or_dest_folder/";
} elsif ($cygwin) {
my $tmp_bd=unpack('x1 a*',$base_or_dest_folder);
$tmp_bd=substr($tmp_bd,(index $tmp_bd,'/'));
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length ".Directory.of${d}$tmp_bd/";
} else {
my $d=${$_[1]};
my $i=index $d,'Directory of';
$i+=12;
$d=unpack("x$i a5",$d);
$d=~s/^(\s+).*$/$1/;
$len_dir=length ".Directory.of${d}$base_or_dest_folder/";
}
my $time='';my $files_flag='';my $mn=0;my $dy=0;
my $yr=0;my $hr=0;my $mt=0;my $pm='';my $size='';
my $file='';my $fchar='';my $u='';my $tm='';
my $g='';my $o='';my $topkey='';my $lchar_flag='';
my $excluded_parent_dir=0;my $included_parent_dir=0;
my $fileyr=0;my $bit=0;my $chmod='';
my $cur_dir_excluded=0;my $file_count=0;my $dofiles=0;
my @keys=();my $addbytes=0;my $nt5=0;
my $prevkey='';my $savekey='';my $savetotal=0;
${$cmd_handle->{"_${bd}hash"}}{'/'}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
my $key='/';my $bytesize=0;my $total=0;
#$xxxnext=0;
#if (!$cygwin) {
#open(BK,">brianout.txt");
#print BK ${$_[1]};
#CORE::close BK;
#}
my @sublines=();my $lenflag=0;my $bs=0;my $bl=0;
FL: foreach my $line (split /^/, ${$_[1]}) {
my $parse=1;my $trak=0;
if ($savekey) {
print "SAVEKEY=$savekey and LINE=$line<==\n";<STDIN>;
$key=$savekey;
$total=$savetotal;
$dofiles=0;
$savekey='';
$savetotal=0;
}
next if $line=~/^\s*$/;
WH: while ($parse || ($line=pop @sublines)) {
$parse=0;
$mn=0;$dy=0;$yr=0;$hr=0;
$mt='';$pm='';$size='';$file='';
if ($ms_share || $ms_domain
|| $cygwin) { # If Base is MSWin
unless ($lenflag) {
if (unpack('a1',$line) ne ' ') {
if (unpack('x24 a1',$line) eq '<') {
$bs=23;$bl=38;
} else {
$bs=24;$bl=39;
}
$lenflag=1;
} else { next }
}
chomp($line=~tr/\0-\37\177-\377//d);
if ($bl<length $line) {
if ($bs==23) {
if (unpack('x6 a4',$line)=~/^\d\d\d\d$/) {
$line=~s/\s+PM/PM/;
$line=~s/\s+AM/AM/;
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x3 a2 x2 a2 x1 a2 a1 @23 a14 @38 a*'
,$line);
$nt5=1;
} else {
$line=~s/\s+PM/PM/;
$line=~s/\s+AM/AM/;
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x1 a2 x2 a2 x1 a2 a1 @23 a14 @38 a*'
,$line);
}
} else {
if (unpack('x6 a4',$line)=~/^\d\d\d\d$/) {
$line=~s/\s+PM/PM/;
$line=~s/\s+AM/AM/;
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x3 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,$line);
$nt5=1;
} else {
$line=~s/\s+PM/PM/;
$line=~s/\s+AM/AM/;
($mn,$dy,$yr,$hr,$mt,$pm,$size,$file)=
unpack('a2 x1 a2 x1 a2 x2 a2 x1 a2 a1 @24 a14 @39 a*'
,$line);
}
}
} else { $mn=unpack('a2',$line) }
#if ($key=~/careers/) {
#print "MSWin_LINE=$line and KEY=$key and MN=$mn and file=$file and MT=$mt and SIZE=$size\n";
#}
next if $mn eq '' || $mn eq ' '
|| unpack('a1',$size) eq '<';
foreach my $pid_ts (@FA_Core::pid_ts) {
next FL if $file eq "rm${pid_ts}.bat"
|| $file eq "cmd${pid_ts}.bat"
|| $file eq "end${pid_ts}.flg"
|| $file eq "err${pid_ts}.txt"
|| $file eq "out${pid_ts}.txt";
}
if ($file eq '' && $mn ne ' D') { next }
} else { # Else Base is UNIX
#if ($line=~/entry_flash.swf/s && !$cygwin) {
#print "UNIX_LINE=$line<-- and KEY=$key and ZIPDIR=$zipdir\n";<STDIN>;
#}
$fchar='';$u='';$g='';$o='';$chmod='';
chomp($line);
next if $line eq '';
my $lchar=substr($line,-1);
if ($lchar eq '*' || $lchar eq '/' || $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;
$lchar_flag=1;
} chop $line;
}
my $endofline=substr($line,-2);
if ($line=~s/^\s*([0-9]+)\s//) {
print "LS OUTPUT LINE=$line<==\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"LS OUTPUT LINE=$line<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$bytesize=$1;
unless ($zipdir) {
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);
} elsif ($bytesize==0) {
$fchar='/';
}
print "ADDING BYTES TO TOTAL ==>$bytesize<==\n",
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"ADDING BYTES TO TOTAL ==>$bytesize<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$addbytes+=$bytesize;
print "TOTAL BYTESIZE==>$addbytes<==\n",
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"TOTAL BYTESIZE==>$addbytes<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$dofiles=1;
if ($endofline eq '..' || $endofline eq ' .') { next }
} else {
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);
if ($fchar eq 't') {
print "TOTAL=$total and ADDBYTES=$addbytes and PREVKEY=$prevkey\n";
#print $Net::FullAuto::FA_Core::MRLOG "TOTAL=$total and ADDBYTES=$addbytes and "
# "PREVKEY=$prevkey\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($dofiles && $total!=$addbytes) {
print "WE HAVE A PROBLEM HOUSTON and KEY=$prevkey<--\n";
print $Net::FullAuto::FA_Core::MRLOG "WE HAVE A PROBLEM HOUSTON and KEY=$prevkey<--\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
@sublines=();
$savekey=$key;
$savetotal=unpack('x6 a*',$line);
$key=$prevkey;
die 'redo ls' if $key eq '/';
$addbytes=0;
my $ls_path='';
if ($cmd_handle->{_hostlabel}->[0] eq
"__Master_${$}__" &&
exists $Hosts{"__Master_${$}__"}{'ls'}) {
$ls_path=$Hosts{"__Master_${$}__"}{'ls'};
$ls_path.='/' if $ls_path!~/\/$/;
}
while (1) {
print "LOOPING IN WHILE TO CORRECT LS -> KEY=$key\n";
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls --version") unless $lsgnu;
if ($lsgnu || (-1<index $stdout,'GNU')) {
$lsgnu=1;
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls -lRs --block-size=1 \'$key\'");
} else {
($stdout,$stderr)=$cmd_handle->cmd(
"${ls_path}ls -lRs \'$key\'");
}
&Net::FullAuto::FA_Core::handle_error($stderr)
if $stderr;
my $add_bytes=0;
print "LS LOOPING STDOUT=$stdout\n";
foreach my $line (split /^/, $stdout) {
chomp($line);
next if $line eq '';
if ($line=~/^total /) {
$total+=unpack('x6 a*',$line);
next;
}
my $lchar=substr($line,-1);
if ($lchar eq '*' || $lchar eq '/'
|| $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;
$lchar_flag=1;
} chop $line;
}
my $endofline=substr($line,-2);
if ($line=~s/^\s*([0-9]+)\s//) {
my $bytesize=$1;
next if $bytesize!~/\d+/;
($fchar,$u,$g,$o)=unpack('a1 a3 a3 a3',$line);
$add_bytes+=$bytesize;
if ($endofline eq '..'
|| $endofline eq ' .') { next }
push @sublines, $line;
}
} last if $add_bytes==$total;
$total=0;
} next WH;
} else {
print "ARE WE HERE AND LINE=$line<==\n";
$total=unpack('x6 a*',$line);
print "TOTAL BYTES FINAL TALLY==>$total<==\n";
print "TOTAL BYTES FINAL TALLY==>$total<==\n",
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"TOTAL BYTES FINAL TALLY ==>$total<==\n",
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (-1<index $total,'stdout:') {
$total=~s/^(\d+)(stdout:.*)$/$1/;
push @sublines, $2;
}
$addbytes=0;
}
}
}
my $per=lc("$u$g$0");
if ($fchar=~/[-dl]/ && (-1<index $per,'s'
|| -1<index $per,'t')) {
if (-1<index lc($u),'s') {
if (-1<index lc($g),'s') {
if (-1<index lc($o),'t') {
$bit=7;
} else {
$bit=6;
}
} else {
if (-1<index lc($o),'t') {
$bit=5;
} else {
$bit=4;
}
}
}
if ($bit<6 && -1<index lc($g),'s') {
if (-1<index lc($o),'t') {
$bit=3;
} else {
$bit=2;
}
} elsif ($bit<2 && -1<index lc($o),'t') {
$bit=1;
} else {
$bit=0;
}
$chmod=$bit.$Net::FullAuto::FA_Core::perms{$u};
$chmod.=$Net::FullAuto::FA_Core::perms{$g}.
$Net::FullAuto::FA_Core::perms{$o};
}
}
#if ($key=~/careers/) {
#if ($excluded_parent_dir) {
# print "KEY=$key and MODS=@modifiers and EXCLUDE_PARENT_DIR=$excluded_parent_dir\n";
#} elsif ($included_parent_dir) {
# print "KEY=$key and MODS=@modifiers and INCLUDE_PARENT_DIR=$included_parent_dir\n";
#}
#print "CYGWINNNNN=$cygwin and FCHAR=$fchar and MN=$mn and SIZE=$size and KEY=$key\n";<STDIN>;
#}
if ((!$cygwin && $fchar eq '/') || ($mn eq ' D')) {
#if ($key=~/bmicalculator/) {
# print "VERYGOOGGDDDDD - WE ARE HERE and MOD=$mod_dirs_flag and LINE=$line\n";<STDIN>;
#}
if ($mod_dirs_flag) {
foreach my $modif (@modifiers) {
@keys=();
next if ${$modif}[3] eq 'f';
if (${$modif}[3] eq 'd') {
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;
$key=unpack("x$len_dir a*",$line);
if ($ms_share || $ms_domain || $cygwin) {
$key=~tr/\\/\//;
}
$file_count=0;
$cur_dir_excluded=0;
}
if ($key ne '/') {
if (-1<index $key,'/') {
my $chkkey=$key;
while ($chkkey=substr($chkkey,0,
(rindex $chkkey,'/'))) {
unshift @keys, $chkkey;
last if -1==index $chkkey,'/';
}
} else { unshift @keys, $key }
} unshift @keys, '/';
$Net::FullAuto::FA_Core::d_sub=regx_prog($modif,'d');
my $return=0;my $returned_modif='';
#if ($key eq '/') {
#print "KEY=$key and KEYSNOW33=@keys\n";
#}
($return,$returned_modif)=&$d_sub($key);
#if ($key eq '/') { # && $file=~/index/) {
#print "KEY=$key RETURN=$return and RETURNED_MODIF=$returned_modif\n";<STDIN>;
#}
if ($return) {
if (-1<index $returned_modif,'e') {
${$cmd_handle->{"_${bd}hash"}}{$key}
=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];
print "BASE_DEST=$base_dest and EXCLUDEDKEY=$key\n";<STDIN>;
if ($base_dest eq 'BASE') {
$Net::FullAuto::FA_Core::base_excluded_dirs{$key}='-';
}
$excluded_parent_dir=$key;
$included_parent_dir='';
} else {
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
foreach my $key (@keys) {
if (${$cmd_handle->{"_${bd}hash"}}{$key}[0]
eq 'EXCLUDE') {
print "HERE I AMMM777 AND KEY=$key\n";<STDIN>;
${$cmd_handle->{"_${bd}hash"}}{$key}[0]
='SOME';
}
}
$excluded_parent_dir='';
$included_parent_dir=$key;
}
} elsif ($excluded_parent_dir &&
length $excluded_parent_dir<length
$key && unpack("a".length $excluded_parent_dir,
$key) eq $excluded_parent_dir) {
#if ($key=~/bmicalculator/) {
#print "OUTHASH_EXCLUDED_PARENT_KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];
$included_parent_dir='';
} elsif ($included_parent_dir &&
length $included_parent_dir<length
$key && unpack("a".length $included_parent_dir,
$key) eq $included_parent_dir) {
#if ($key=~/bmicalculator/) {
#print "OUTHASH_INCLUDED_PARENT_KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
$excluded_parent_dir='';
} elsif ((-1<index ${$modif}[2],'i') &&
(-1==index ${$modif}[2],'e')) {
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'EXCLUDE', {},
'DEPLOY_NOFILES_OF_CURDIR' ];
$excluded_parent_dir='';
$included_parent_dir='';
} else {
#if ($key=~/bmicalculator/) {
#print "OUTHASH_ELSE_KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
$excluded_parent_dir='';
$included_parent_dir='';
}
} else {
#if ($key=~/bmicalculator/) {
#print "YEERRRRR=$key\n";<STDIN>;
#}
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;
$key=unpack("x$len_dir a*",$line);
#print "KEYYYYYYYYYYYYYY=$key and LINE=$line and LENDIR=$len_dir\n";sleep 2;
#print "KEYHERERERERER2222222 and LINE=$line\n" if $key eq 'member/my_health/calculators/bmicalculator/images';
#<STDIN> if $key eq 'member/my_health/calculators/bmicalculator/images';
if ($ms_share || $ms_domain) {
$key=~tr/\\/\//;
}
$file_count=0;
$cur_dir_excluded=0;
}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
}
}
} else {
if ($mod_files_flag &&
${$cmd_handle->{"_${bd}hash"}}{$key}[2]
eq 'DEPLOY_SOMEFILES_OF_CURDIR') {
#if ($key=~/bmicalculator/) {
#print "HERE I AMMM888 AND KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[0]='SOME';
}
print "WHAT IS THE LEN_DIR=$len_dir and LINE=$line<==\n";
if ($len_dir<length $line) {
# Get New Directory Key
$prevkey=$key;
$key=unpack("x$len_dir a*",$line);
#print "KEYHERERERERER33333 and LINE=$line and len_dir=$len_dir and KEY=$key<==\n";sleep 5;# if $key eq 'member/my_health/calculators/bmicalculator/images';
#<STDIN> if $key eq 'member/my_health/calculators/bmicalculator/images';
if ($ms_share || $ms_domain) {
$key=~tr/\\/\//;
}
$file_count=0;
$cur_dir_excluded=0;
}
${$cmd_handle->{"_${bd}hash"}}{$key}=[ 'ALL', {},
'DEPLOY_SOMEFILES_OF_CURDIR' ];
}
} elsif ((!$cygwin && $fchar eq '-' || $zipdir) ||
($cygwin && $mn ne ' D' && unpack('a5',$size) ne '<DIR>')) {
$file_count++;
#if ($key eq '/') {
#print "UNIXXXYYLINE=$line and CYGWINNNN=$cygwin and MN=$mn and SIZE=$size and FILE=$file and KEY=$key and ZIPDIR=$zipdir\n";<STDIN>;
#}
if (!$cygwin && ($fchar eq '-' || $fchar eq 'l')) {
my $up=unpack('x10 a*',$line);
$up=~s/^[.+ ]\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)$/$1/;
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;
my $yr='';
if ($mn=~/(\d\d\d\d)-(\d\d)-(\d\d)/) {
$file=$tm;
$tm=$dy;
$yr=$1;$mn=$2;$dy=$3;
} elsif (-1==index 'JanFebMarAprMayJunJulAugSepOctNovDec',
$mn) {
($file=$up)=~s/^.*\d+\s+\w\w\w\s+\d+\s+
(?:\d\d:\d\d\s+|\d\d\d\d\s+)+(.*)$/$1/x;
($stdout,$stderr)=$cmd_handle->cmd("ls -l $file");
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
my $lchar=substr($stdout,-1);
if ($lchar eq '*' || $lchar eq '/'
|| $lchar eq ':') {
if ($lchar eq ':' && !$lchar_flag) {
$len_dir--;
$lchar_flag=1;
} chop $line;
}
push @sublines, $stdout;
next WH;
}
$mn=$Net::FullAuto::FA_Core::month{$mn} if length $mn==3;
$fileyr=0;$hr=0;$mt=0;
if (length $tm==4) {
$fileyr=$tm;$hr=12;$mt='00';
} elsif ($yr) {
($hr,$mt)=unpack('a2 @3 a2',$tm);
$fileyr=$yr;
} else {
($hr,$mt)=unpack('a2 @3 a2',$tm);
$yr=unpack('x1 a2',"$Net::FullAuto::FA_Core::thisyear");
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
} elsif ($Net::FullAuto::FA_Core::thismonth==$mn-1) {
my $filetime=timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);
if (time()<$filetime) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
}
}
}
$file=s/ -> .*$// if -1<index $file,' -> ';
} elsif ($zipdir) {
$line=~s/^\s//;
my $fullfile='';
($dy,$tm,$fullfile)=split / +/, $line;
($mn,$dy,$yr)=split '-', $dy;
($hr,$mt)=split ':', $tm;
$file=substr($fullfile,(rindex $fullfile,'/')+1);
if ($fullfile ne $zipdir.'/'.$key.'/'.$file) {
my @kdirs=($key);
if (-1<index $key,'/') {
@kdirs=split '/',$key;
}
if ($#kdirs==0) {
$key='/';
} else {
while (pop @kdirs) {
my $di=join '/', @kdirs;
if ($fullfile eq $zipdir.'/'.$di.'/'.$file) {
$key=$di;
last;
}
}
}
}
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
$size=$bytesize;
}
#if ($key eq '/') {
#print "CYGWINNNNN\n" if $cygwin;
#print "WITH CAREER AND FILE DIR=$key and FILE=$file and MODFILEFLAG=$mod_files_flag\n";#<STDIN>;
#}
if ($mod_dirs_flag && ${$cmd_handle->{"_${bd}hash"}}{$key}[0]
eq 'EXCLUDE') {
#if ($key eq '/') {
#print "HERE WE ARE EXCLUDING and MODDIR=$mod_dirs_flag and OUTHASHENTRY=",${$cmd_handle->{"_${bd}hash"}}{"$key"}[0],"\n";
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];
$num_of_excluded++;
} elsif ($mod_files_flag) {
foreach my $modif (@modifiers) {
if (${$modif}[3] eq 'f') {
$Net::FullAuto::FA_Core::f_sub=regx_prog($modif,'f');
my $return=0;my $returned_modif='';
($return,$returned_modif)=
&$Net::FullAuto::FA_Core::f_sub($file,$key);
my $fileyr=0;
#if ($key eq '/') {
# print "FILE=$file and RETURN=$return and MODIF=$returned_modif\n";
# <STDIN>;
#}
if ($return || (-1<index $returned_modif,'e')) {
if ($return && (-1<index $returned_modif,'e')) {
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];
$Net::FullAuto::FA_Core::base_excluded_files{$key}
{$file}='-';
if (${$cmd_handle->{"_${bd}hash"}}{$key}[2] eq
'DEPLOY_SOMEFILES_OF_CURDIR') {
${$cmd_handle->{"_${bd}hash"}}{$key}[2]
='DEPLOY_NOFILES_OF_CURDIR';
}
$num_of_excluded++;
$cur_dir_excluded++;
} else {
if (!$ms_share && !$ms_domain && !$cygwin) {
my $up=unpack('x10 a*',$line);
my $rx=qr/\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)/;
$up=~s/^[.+ ]$rx$/$1/;
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;
$mn=$Net::FullAuto::FA_Core::month{$mn}
if length $mn==3;
$fileyr=0;my $hr=0;my $mt='';
if (length $tm==4) {
$fileyr=$tm;$hr=12;$mt='00';
} else {
($hr,$mt)=unpack('a2 @3 a2',$tm);
my $yr=unpack('x1 a2',
$Net::FullAuto::FA_Core::thisyear);
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
if ($Net::FullAuto::FA_Core::thismonth <
$mn-1) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=
$Net::FullAuto::FA_Core::curcen.$yr;
} elsif ($Net::FullAuto::FA_Core::thismonth
==$mn-1) {
my $filetime=timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);
if (time()<$filetime) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=
$Net::FullAuto::FA_Core::curcen
.$yr;
}
}
}
$file=~s/\s*$//g;
next if !$file;
} else {
$size=~s/^\s*//;
my $testyr=100+$yr;
$fileyr=$Net::FullAuto::FA_Core::curyear;
if ($testyr <
$Net::FullAuto::FA_Core::thisyear) {
#$hr=12;$mt='00';
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
} #elsif ($hr<13) {
$hr=$Net::FullAuto::FA_Core::hours{
$hr.lc($pm)};
#}
} $chmod=" $chmod" if $chmod;
my $dt=(3==length $mn)?$Net::FullAuto::FA_Core::month{$mn}:$mn;
#if ($key eq '/') {
#print "GOOOOOOODDDDDFILE===$file and KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}=
[ '',"$dt $dy $hr $mt $fileyr $size$chmod" ];
#if ($key eq '/') {
#print "WE JUST DID OUTHASH and KEY=$key and $#{[keys %{$cmd_handle->{"_${bd}hash"}}]}\n";
#}
if (${$cmd_handle->{"_${bd}hash"}}{$key}[2] eq
'DEPLOY_NOFILES_OF_CURDIR') {
${$cmd_handle->{"_${bd}hash"}}{$key}[2]=
'DEPLOY_SOMEFILES_OF_CURDIR';
}
$num_of_included++;
}
} else {
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}
=[ 'EXCLUDE','' ];
if (${$cmd_handle->{"_${bd}hash"}}{$key}[2] eq
'DEPLOY_SOMEFILES_OF_CURDIR') {
if ($file_count==++$cur_dir_excluded) {
#if ($key eq '/') {
print "HERE WE ARE and KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[2]
='DEPLOY_NOFILES_OF_CURDIR'
}
}
$num_of_excluded++;
}
}
}
} else {
my $fileyr=0;
if (!$cygwin) {
if ($zipdir) {
$line=~s/^\s//;
($dy,$tm,$file)=split / +/, $line;
($mn,$dy,$yr)=split '-', $dy;
($hr,$mt)=split ':', $tm;
$file=substr($file,(rindex $file,'/')+1);
print "DY=$dy and MON=$mn and YR=$yr and HR=$hr and MT=$mt and FILE=$file<==\n";;
} else {
my $up=unpack('x10 a*',"$line");
$up=~s/^[.+ ]\s+\d+\s+\S+\s+\S+\s+(\d+\s+.*)$/$1/;
($size,$mn,$dy,$tm,$file)=split / +/, $up, 5;
my $yr='';$fileyr='';
if ($mn=~/(\d\d\d\d)-(\d\d)-(\d\d)/) {
$fileyr=$1;
$file=$tm;
$tm=$dy;
$mn=$2;$dy=$3;
}
}
$mn=$Net::FullAuto::FA_Core::month{$mn}
if length $mn==3;
my ($hr,$mt)='';
if (length $tm==4) {
$fileyr=$tm;$hr=12;$mt='00';
} elsif (!$fileyr) {
($hr,$mt)=unpack('a2 @3 a2',$tm);
$yr=unpack('x1 a2',$Net::FullAuto::FA_Core::thisyear);
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
if ($Net::FullAuto::FA_Core::thismonth<$mn-1) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
} elsif ($Net::FullAuto::FA_Core::thismonth==$mn-1) {
my $filetime=timelocal(
0,$mt,$hr,$dy,$mn-1,$fileyr);
if (time()<$filetime) {
--$yr;
$yr="0$yr" if 1==length $yr;
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
}
}
}
$file=~s/\s*$//g;
$file=s/ -> .*$// if -1<index $file,' -> ';
} else {
$size=~s/^\s*//;
my $testyr="1$yr";
$fileyr=$Net::FullAuto::FA_Core::curyear;
if ($testyr<$Net::FullAuto::FA_Core::thisyear) {
#$hr=12;$mt='00';
$fileyr=$Net::FullAuto::FA_Core::curcen.$yr;
} #elsif ($hr<13) {
$hr=$Net::FullAuto::FA_Core::hours{$hr.lc($pm)};
#}
} $chmod=" $chmod" if $chmod;
my $dt=(3==length $mn)?$Net::FullAuto::FA_Core::month{$mn}:$mn;
#if ($key eq '/') {
#print "GOOOOOOODDDDDFILE222===$file and KEY=$key\n";<STDIN>;
#}
${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}=
[ '',"$mn $dy $hr $mt $fileyr $size$chmod" ];
#if ($key=~/pdf|common|stylesheet|header/ && $file=~/index/ && !$cygwin) {
#print "JUST UPDATED OUTHASH=",@{${$cmd_handle->{"_${bd}hash"}}{$key}[1]{$file}},"\n";<STDIN>;
#}
$num_of_included++;
}
}
}
}
};
if ($@) {
#print "DO WE HAVE AN ERROR AND WHAT IS IT=$@\n";<STDIN>;
return '','redo ls' if unpack('a7',$@) eq 'redo ls';
if (unpack('a10',$@) eq 'The System') {
return '',$@;
} else {
my $hostlabel='localhost' if ${$cmd_handle->{_hostlabel}}[0]
eq "__Master_${$}__";
my $die="FATAL ERROR! - The System $hostlabel Returned"
."\n the Following Unrecoverable Error "
."Condition\n at ".(caller(0))[1]." "
."line ".(caller(0))[2]." :\n\n ".$@;
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return '', $die;
}
} ${$cmd_handle->{"_${bd}hash"}}{"___%EXCluD%E--NUMOFFILES"}=$num_of_included;
${$cmd_handle->{"_${bd}hash"}}{"___%EXCluD%E--NUMOFBASEFILES"}
=$num_of_included+$num_of_excluded;
return '','';
}
package Rem_Command;
# Handle INT SIGNAL interruption
# local $SIG{ INT } = sub{ print "I AM HERE" };
sub new {
print "Rem_Command::new CALLER=",caller,"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"Rem_Command::new CALLER=",(caller),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
our $timeout=$Net::FullAuto::FA_Core::timeout;
our $test=$Net::FullAuto::FA_Core::test;
my $self = { };
my $class=ref $_[0]||$_[0];
my $hostlabel=$_[1];
my $new_master=$_[2]||'';
my $_connect=$_[3]||'';
my $override_login_id=$_[4]||'';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
my $chk_id='';
if ($su_id) { $chk_id=$su_id }
elsif ($login_id) { $chk_id=$login_id }
else { $chk_id=$Net::FullAuto::FA_Core::username }
my $cmd_handle='';my $work_dirs='';my $cmd_type='';
my $ftm_type='';my $stderr='';my $cmd_pid='';my $shell='';
my $shell_pid=0;my $cygdrive='';my $smb='';
($cmd_handle,$work_dirs,$uname,$cmd_type,
$ftm_type,$smb,$stderr,$ip,$hostname,
$cmd_pid,$shell_pid,$cygdrive,$shell)=&cmd_login(
$hostlabel,$new_master,$_connect,$override_login_id);
if ($stderr) {
$stderr=~s/(at .*)$/\n\n $1/s;
my $die="\n FATAL ERROR! - $stderr";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return $cmd_handle,$die if wantarray;
&Net::FullAuto::FA_Core::handle_error($die);
}
if ($smb) {
$self->{_hostlabel}=[ $hostlabel,
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0] ];
$self->{_smb}=1;
} else {
$self->{_hostlabel}=[ $hostlabel,'' ];
}
$self->{_cmd_handle}=$cmd_handle;
$self->{_cmd_type}=$cmd_type;
$self->{_connect}=$_connect;
$self->{_ftm_type}=$ftm_type;
$self->{_work_dirs}=$work_dirs;
$self->{_ip}=$ip;
$self->{_uname}=$uname;
$self->{_luname}=$^O;
$self->{_cmd_pid}=$cmd_pid;
$self->{_sh_pid}=$shell_pid;
$self->{_shell}=$shell;
if ($cygdrive) {
$self->{_cygdrive}=$cygdrive;
$self->{_cygdrive_regex}=qr/^$cygdrive\//;
}
bless($self,$class);
$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$chk_id"}=$self;
return $self,''
}
sub handle_error
{
my @topcaller=caller;
print "Rem_Command::handle_error() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "Rem_Command::handle_error() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return &Net::FullAuto::FA_Core::handle_error(@_);
}
sub close
{
my @topcaller=caller;
print "Rem_Command::close() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "Rem_Command::close() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self=$_[0];
my $kill_arg=($^O eq 'cygwin')?'f':9;
if (defined fileno $self->{_cmd_handle}) {
my $gone=1;my $was_a_local=0;
eval { # eval is for error trapping. Any errors are
# handled by the "if ($@)" block at the bottom
# of this routine.
CM: while (defined fileno $self->{_cmd_handle}) {
$self->{_cmd_handle}->print($Net::FullAuto::FA_Core::printfpath.
"printf $funkyprompt");
while (my $line=$self->{_cmd_handle}->get) {
print $Net::FullAuto::FA_Core::MRLOG "cleanup() LINE_3=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last if $line=~/logout|221\sGoodbye/sx;
if ($line=~/_funkyPrompt_$/s) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});
$self->{_cmd_handle}->print("exit");
} elsif (($line=~/Killed|_funkyPrompt_/s) ||
($line=~/[:\$%>#-] ?$/s) ||
($line=~/sion denied.*[)][.]\s*$/s)) {
print $Net::FullAuto::FA_Core::MRLOG "cleanup() SHOULD BE LAST CM=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$gone=0;last CM;
} elsif (-1<index $line,
'Connection to localhost closed') {
$was_a_local=1;
last CM;
} elsif ($line=~/Connection.*closed/s) {
last CM;
}
if ($line=~/^\s*$|^\s*exit\s*$/s) {
last CM if $count++==20;
} else { $count=0 }
if (-1<index $line,'assword:'
|| -1<index $line,'Permission denied') {
$self->{_cmd_handle}->print("\004");
}
}
}
};
if ($@) {
if ((-1<index $@,'read error: Connection aborted')
|| (-1<index $@,'read timed-out')
|| (-1<index $@,'filehandle isn')
|| (-1<index $@,'input or output error')) {
$@='';
} else { $self->{_cmd_handle}->close();die "$@ $!" }
}
} $self->{_cmd_handle}->close();
delete $self->{_cmd_handle};
return 0;
}
sub get
{
my @topcaller=caller;
print "Rem_Command::get() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "Rem_Command::get() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self=$_[0];
my $stderr="ERROR MESSAGE! :"
."\n\n The $self->{_connect} method does"
."\n not enable file transfer get()"
."\n functionality. To do file transfer"
."\n transfer use a method such as"
."\n \'connect_secure\' or \'connect_host\'"
."\n etc.\n\n";
if (wantarray) {
return '',"\n\n ".(caller(1))[3]." $stderr at ".
$topcaller[1]." - Line $topcaller[2].\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
}
sub put
{
my @topcaller=caller;
print "Rem_Command::put() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "Rem_Command::put() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self=$_[0];
my $stderr="ERROR MESSAGE! :"
."\n\n The $self->{_connect} method does"
."\n not enable file transfer put()"
."\n functionality. To do file transfer"
."\n transfer use a method such as"
."\n \'connect_secure\' or \'connect_host\'"
."\n etc.\n\n";
if (wantarray) {
return '',"\n\n ".(caller(1))[3]." $stderr at ".
$topcaller[1]." - Line $topcaller[2].\n";
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
}
sub cmd_login
{
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;
print "\nINFO: Rem_Command::cmd_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $hostlabel=$_[0];
my $new_master=$_[1]||0;
my $_connect=$_[2]||'';
my $override_login_id=$_[3]||'';
my $kill_arg=($^O eq 'cygwin')?'f':9;
my $timeout=$_[4]||$Net::FullAuto::FA_Core::timeout;
print "WE GOT HOSTLABEL=$hostlabel<==\n" if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "WE GOT HOSTLABEL=$hostlabel<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$cdtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$hostlabel,$_connect);
if ($override_login_id) {
$login_id=$override_login_id;
$su_id='';
}
print "WE ARE BACK FROM LOOKUP and HOSTNAME=$hostname<==\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "WE ARE BACK FROM LOOKUP<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$cdtimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$cdtimeout) {
$cdtimeout=$timeout if !$cdtimeout;
}
$login_id=$Net::FullAuto::FA_Core::username if !$login_id;
my $cmd_handle='';my $work_dirs='';my $cmd_type='';my $smb=0;
my $ftm_type='';my $use_su_login='';my $id='';my $cygwin='';
my $su_login='';my $die='';my $login_passwd='';my $ms_su_id='';
my $ms_ms_domain='';my $ms_ms_share='';my $ms_login_id='';
my $ms_hostlabel='';my $ms_host='';my $smb_type='';
my $cmd_errmsg='';my $host='';my $output='';my $shell_pid=0;
my $retrys=0;my $login_tries=0;my $cmd_pid='';my $shell='';
my $su_scrub='';my @connect_method=();
my ($stdout,$stderr)=('','');
if (lc(${$ftr_cnct}[0]) eq 'smb') {
$smb=1;
if ($use eq 'hostname') {
$ms_host=$hostname;
} else {
$ms_host=$ip;
}
$ms_hostlabel=$hostlabel;
$ms_su_id=$su_id;
$ms_login_id=$login_id;
$ms_ms_domain=$ms_domain;
$ms_ms_share=$ms_share;
my $smbtimeout=$cdtimeout;
($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$cdtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]);
$host=($use eq 'ip')?$ip:$hostname;
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$cdtimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$cdtimeout) {
$cdtimeout=$timeout if !$cdtimeout;
}
$cdtimeout=$smbtimeout if $cdtimeout<$smbtimeout;
$hostlabel=$Net::FullAuto::FA_Core::DeploySMB_Proxy[0];
if (!$login_id && !$su_id) {
$ms_login_id=$login_id=$Net::FullAuto::FA_Core::username;
}
my $loginid = ($su_id) ? $su_id : $login_id;
$use_su_login=1 if $su_id;
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0],
$loginid,$ms_domain,'','','smb');
#$loginid,$ms_domain,$cmd_errmsg,'','SMB_Proxy');
} else {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'','');
}
#&Net::FullAuto::FA_Core::acquire_semaphore(1234,,1);
$host=($use eq 'ip')?$ip:$hostname;
$host='localhost' if exists $same_host_as_Master{$host};
if ($host eq 'localhost' &&
exists $Hosts{"__Master_${$}__"}{'Local'}) {
my $loc=$Hosts{"__Master_${$}__"}{'Local'};
unless ($loc eq 'connect_ssh'
|| $loc eq 'connect_telnet'
|| $loc eq 'connect_ssh_telnet'
|| $loc eq 'connect_telnet_ssh') {
my $die="\n FATAL ERROR - \"Local\" has "
."*NOT* been Properly\n Defined in the "
."\"$Net::FullAuto::FA_Core::fa_host\" File.\n"
." This "
."Element must have one of the following\n"
." Values:\n\n "
." 'connect_ssh'or 'connect_telnet'\n "
." 'connect_ssh_telnet' or\n "
." 'connect_telnet_ssh'\n\n"
." \'$loc\' is INCORRECT.\n\n";
print $Net::FullAuto::FA_Core::MRLOG $die
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&Net::FullAuto::FA_Core::handle_error($die,'__cleanup__');
} elsif ($loc eq 'connect_ssh') {
$_connect=$loc;
@connect_method=('ssh');
} elsif ($loc eq 'connect_telnet') {
$_connect=$loc;
@connect_method=('telnet');
} elsif ($loc eq 'connect_ssh_telnet') {
$_connect=$loc;
@connect_method=('ssh','telnet');
} else {
$_connect=$loc;
@connect_method=('telnet','ssh');
}
} else { @connect_method=@{$cmd_cnct} }
my $previous_method='';my $sshloginid='';
my $ignore='';my $preferred=0;my $outpt='';my $cygdrive='';my $prompt='';
while (1) {
undef $@;
eval {
if ($hostlabel eq "__Master_${$}__" && !$new_master) {
$cmd_handle=$Net::FullAuto::FA_Core::localhost->{_cmd_handle};
$cmd_pid=$Net::FullAuto::FA_Core::localhost->{_cmd_pid};
$shell_pid=$Net::FullAuto::FA_Core::localhost->{_sh_pid};
#&Net::FullAuto::FA_Core::release_semaphore(1234);
} else {
print $Net::FullAuto::FA_Core::MRLOG
"GOINGKKK FOR NEW CMD_HANDLE and CONNECT_METH=@connect_method<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $w2loop=0;
WH: while (1) {
my $rm_cnt=-1;
CM3: foreach my $connect_method (@connect_method) {
$rm_cnt++;
if ($previous_method && !$preferred) {
print "Warning, Preferred Connection ",
"$previous_method Failed\n"
if ((!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) &&
!$Net::FullAuto::FA_Core::quiet);
$preferred=1;
} else { $previous_method=$connect_method }
$previous_method=$connect_method;
if (lc($connect_method) eq 'telnet') {
eval {
my $telnetpath='';
if (exists $Hosts{"__Master_${$}__"}{'telnet'}) {
$telnetpath=$Hosts{"__Master_${$}__"}{'telnet'};
$telnetpath.='/' if $telnetpath!~/\/$/;
}
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
["${telnetpath}telnet",$host])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch telnet subprocess");
#print "CMD_PIDTELNETNNNNNNN=$cmd_pid<====\n";
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cdtimeout);
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];
}
$cmd_handle->telnetmode(0);
$cmd_handle->binmode(1);
$cmd_handle->output_record_separator("\r");
$cmd_handle->timeout($cdtimeout);
};
if ($@) {
#if ($rm_cnt==$#connect_method) {
if (1<=$#connect_method) {
undef $@;next;
} else {
my $die=$@;undef $@;
die $die;
}
}
while (my $line=$cmd_handle->get) {
#print "TELNET_CMD_HANDLE_LINE=$line\n";
print $Net::FullAuto::FA_Core::MRLOG "TELNET_CMD_HANDLE_LINE=$line\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $showline=$line;
chomp($showline=~tr/\0-\11\13-\37\177-\377//d);
$showline=~tr/\12/\033/;
$showline=~tr/\33//s;
$showline=~tr/\33/\12/;
$showline=~s/^\12//s;
$showline=~s/login.*$//s;
print $showline if !$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG $showline
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
chomp($line=~tr/\0-\37\177-\377//d);
if (-1<index $line,'Connection refused') {
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($shell_pid);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg)
if &Net::FullAuto::FA_Core::testpid($cmd_pid);
if ($su_id) {
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.$Net::FullAuto::FA_Core::pcnt};
} else {
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.$Net::FullAuto::FA_Core::pcnt};
}
if (1<=$#connect_method) {
#if ($rm_cnt==$#connect_method) {
$stderr=$line;
next CM3;
} else {
#&Net::FullAuto::FA_Core::release_semaphore(1234);
&Net::FullAuto::FA_Core::handle_error($line);
}
}
if (-1<index $line,'CYGWIN') {
if ($su_id) {
if ($su_id ne $login_id) {
$login_id=$su_id;
} else { $su_id='' }
my $value=$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}=
$value;
}
$uname='cygwin';
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'Uname'}='cygwin';
$cygwin=1;
} elsif (-1<index $line,'AIX') {
$uname='aix';
$Net::FullAuto::FA_Core::Hosts{
$hostlabel}{'Uname'}='aix';
}
last if $line=~
/(?<!Last )login[: ]+$|username[: ]+$/i;
}
if ($cmd_errmsg &&
(-1==index $cmd_errmsg,'Cannot su to')) {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'',$cmd_errmsg)
} else {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'','')
}
$cmd_handle->print($login_id);
if ($cmd_handle->errmsg) {
#&Net::FullAuto::FA_Core::release_semaphore(1234);
&Net::FullAuto::FA_Core::handle_error(
$cmd_handle->errmsg);
} $cmd_type='telnet';
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
_connect=>$_connect });
if ($stderr && $rm_cnt!=$#connect_method) {
$cmd_handle->close;
next CM3;
} last
} elsif (lc($connect_method) eq 'ssh') {
$sshloginid=($use_su_login)?$su_id:$login_id;
my $sshpath=$Net::FullAuto::FA_Core::sshpath;
eval {
if (exists $Hosts{"__Master_${$}__"}{'ssh'}) {
$sshpath=$Hosts{"__Master_${$}__"}{'ssh'};
$sshpath.='/' if $sshpath!~/\/$/;
}
my $sshport='';
if (exists $Hosts{$hostlabel}{'sshport'}) {
$sshport=$Hosts{$hostlabel}{'sshport'};
}
if ($sshport) {
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
["${sshpath}ssh",'-v',"-p$sshport",
"$sshloginid\@$host",
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess");
} else {
($cmd_handle,$cmd_pid)=
&Net::FullAuto::FA_Core::pty_do_cmd(
["${sshpath}ssh",'-v',"$sshloginid\@$host",
$Net::FullAuto::FA_Core::slave])
or &Net::FullAuto::FA_Core::handle_error(
"couldn't launch ssh subprocess");
}
$cmd_handle=Net::Telnet->new(Fhopen => $cmd_handle,
Timeout => $cdtimeout);
if ($su_id) {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$su_id}
{'cmd_su_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];
} else {
$Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{'cmd_id_'.++$Net::FullAuto::FA_Core::pcnt}=
[ $cmd_handle,$cmd_pid,'','' ];
}
$cmd_handle->telnetmode(0);
$cmd_handle->binmode(1);
$cmd_handle->output_record_separator("\r");
$cmd_handle->timeout($cdtimeout);
};
if ($@) {
if ($rm_cnt==$#connect_method) {
undef $@;next;
} else {
my $die=$@;undef $@;
die $die;
}
}
if ($cmd_errmsg &&
(-1==index $cmd_errmsg,'Cannot su to')) {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'',$cmd_errmsg)
} else {
$login_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,'','')
} $cmd_type='ssh';
## Wait for password prompt.
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$cmd_type,
_connect=>$_connect },0,'_notnew_');
if ($stderr) {
if ($rm_cnt!=$#connect_method) {
$cmd_handle->close;
next CM3;
} else {
#&Net::FullAuto::FA_Core::release_semaphore(1234);
die $stderr;
}
}
} last
}
if ($stderr) {
if ((20<length $stderr && unpack('a21',$stderr)
eq 'A remote host refused') ||
(31<length $stderr && (unpack('a32',$stderr)
eq 'ftp: connect: Connection refused' ||
unpack('a32',$stderr) eq
'ftp: connect: Attempt to connect')) && (exists
$Net::FullAuto::FA_Core::Hosts{
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]})) {
$cmd_handle->close;
unless ($cmd_errmsg) {
if ($use eq 'hostname') {
$ms_host=$hostname;
} else {
$ms_host=$ip;
}
$ms_hostlabel=$hostlabel;
$ms_su_id=$su_id;
$ms_login_id=$login_id;
$ms_ms_domain=$ms_domain;
$ms_ms_share=$ms_share;
($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$cdtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]);
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$cdtimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$cdtimeout) {
$cdtimeout=$timeout if !$cdtimeout;
}
if (!$login_id && !$su_id) {
$ms_login_id=$login_id=
$Net::FullAuto::FA_Core::username;
}
} my $loginid = ($su_id) ? $su_id : $login_id;
$use_su_login=1 if $su_id;
$login_passwd=
&Net::FullAuto::FA_Core::getpasswd(
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0],
$loginid,$ms_domain,$cmd_errmsg,
'','smb');
#'','SMB_Proxy');
$cmd_errmsg='';$cmd_type='';
if ($_connect eq 'connect_ssh'
|| $_connect eq 'connect_secure') {
@{$cmd_cnct}=('ssh')
} elsif ($_connect eq 'connect_telnet'
|| $_connect eq 'connect_insecure') {
@{$cmd_cnct}=('telnet')
} elsif ($_connect eq 'connect_host') {
@{$cmd_cnct}=('ssh','telnet')
} else { @{$cmd_cnct}=('telnet','ssh') }
next;
} else { &Net::FullAuto::FA_Core::handle_error($@) }
} last
}
if (!$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::debug &&
!$Net::FullAuto::FA_Core::quiet &&
$hostlabel!~/^__Master/) {
# Logging (5)
print "\n Logging into $host ($hostlabel) via $cmd_type . . .\n\n";
} elsif ($Net::FullAuto::FA_Core::debug) {
print "\n Logging (5) into $host ($hostlabel) via $cmd_type . . .\n\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"\n Logging (5) into $host ($hostlabel) via $cmd_type . . .\n\n"
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
## Send password.
$cmd_handle->print($login_passwd);
###MMMMMMMMMMMMMMMMMMMMMMMM
$cmd_handle=&Rem_Command::wait_for_prompt(
$cmd_handle,$timeout,\@connect_method,$hostlabel);
if (0) {
$Net::FullAuto::FA_Core::uhray=&Net::FullAuto::FA_Core::get_prompt();
$cmd_handle->print('cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::printfpath.
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
my $output='';my $ct=0;my $tymeout=2;
while (1) {
if (($ct==1) && (5<$timeout)) {
$tymeout=5;
} elsif (($ct==2) && (10<$timeout)) {
$tymeout=10;
} elsif (2<$ct) {
$tymeout=$timeout;
}
eval {
print $Net::FullAuto::FA_Core::MRLOG
"\nINFO: Rem_Command::cmd_login() ",
"STARTING \$cmd_handle->get() LOOP inside eval COUNT=$ct",
"\n LOOKING FOR CMD PROMPT AFTER PASSWORD OUTPUT ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nINFO: Rem_Command::cmd_login() ",
"STARTING \$cmd_handle->get() LOOP inside eval COUNT=$ct",
"\n LOOKING FOR CMD PROMPT AFTER PASSWORD OUTPUT",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
while (my $line=$cmd_handle->get(Timeout=>$tymeout)) {
$SIG{ALRM} = sub { die "read timed-out\n" }; # \n required
alarm $timeout+1;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() $ct ",
"LOOKING FOR CMD PROMPT AFTER PASSWORD OUTPUT",
" (Timeout=$tymeout):\n ==>$line<==\n ",
"SEPARATOR=${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() $ct ",
"LOOKING FOR CMD PROMPT AFTER PASSWORD OUTPUT",
" (Timeout=$tymeout):\n ==>$line<==\n ",
"SEPARATOR=${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
$outpt.=$line;
$output.=$line;
$output=~s/login:.*//s;
if ($line=~/(?<!Last )login[: ]*$/m ||
unpack('a10',$line) eq 'Login inco'
|| (-1<index $line,'Perm')) {
#&Net::FullAuto::FA_Core::release_semaphore(1234);
while (1) {
last if $previous_method eq $connect_method[0];
shift @connect_method;
}
$output=~s/^\s*//s;
$output=~s/\s*//s;
alarm 0;
if ($output=~/^.*(Perm.*)$/s) {
my $one=$1;
if ($output=~/^.*(No more auth.*)$/s) {
die "$1\n";
} die "$one\n";
}
die "$output\n";
} elsif ($line=~/Connection (?:closed|reset)/s) {
alarm 0;
die "$output\n";
}
if ($outpt=~
/${$Net::FullAuto::FA_Core::uhray}[0]_-(.*)$/s) {
$prompt=$1;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() ",
"PROMPT DYNAMICALLY DERIVIED:\n ",
"==>$prompt<==\n SEPARATOR=".
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() ",
"PROMPT DYNAMICALLY DERIVED:\n ",
"==>$line<==\n SEPARATOR=",
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
alarm 0;
last;
} elsif ($outpt=~/^((?:bash)*[\$%#>])\s?cmd \//m) {
$prompt=$1;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() ",
"PROMPT DYNAMICALLY DERIVIED:\n ",
"==>$prompt<==\n SEPARATOR=cmd \/",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() ",
"PROMPT DYNAMICALLY DERIVED:\n ",
"==>$line<==\n SEPARATOR=cmd \/",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
alarm 0;
last;
}
alarm 0;
}
};
if ($@) {
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() (eval) ERROR \"set\" ",
"cmd:\n ==>$@<==\n SEPARATOR=",
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() (eval) ERROR \"set\" ",
"cmd:\n ==>$@<==\n SEPARATOR=",
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug;
my $ev_err=$@;
if ($ev_err=~/read timed-out/s && $ct++<3) {
$Net::FullAuto::FA_Core::uhray=
&Net::FullAuto::FA_Core::get_prompt();
$cmd_handle->print('cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::printfpath.
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
} elsif ($sshloginid &&
$ev_err=~/Permission denied/s) {
if ($ev_err=~/No more auth/s) {
die $ev_err;
} else {
$cmd_handle->print(&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$sshloginid,'',$@,
'__force__'));
$Net::FullAuto::FA_Core::uhray=
&Net::FullAuto::FA_Core::get_prompt();
$cmd_handle->print('cmd /Q /C "set /A '
.${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::printfpath.
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2]
.'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
}
} else { die $ev_err }
} else { last }
}
$cmd_handle->prompt('/_funkyPrompt_$/');
$cmd_handle->print(
"export PS1=_funkyPrompt_;unset PROMPT_COMMAND");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
}
# Find out what the shell is.
#$cmd_handle->print('set | ${greppath}grep SHELL=');
($shell,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
'set | ${greppath}grep SHELL=');
$shell=~s/SHELL=//;
$shell=~s/^['"]//;
$shell=~s/['"]$//;
# --CONTINUE-- print "WHAT IS THE SHELL=$shell<==\n";
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
# --CONTINUE-- print "GOING FOR UNAME\n";
my $ctt=2;
while ($ctt--) {
($uname,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'uname');
if (!$uname && !$stderr) {
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
} last if $uname;
}
die 'no-uname' if !$uname || $stderr;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() UNAME: ==>$uname<==",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() UNAME: ==>$uname<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug;
if (lc($uname)=~/cygwin/) {
$uname='cygwin';$cygwin=1;
} elsif ($uname eq 'AIX') {
$uname='aix';
}
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}=$uname;
($shell_pid,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'echo $$');
$shell_pid||=0;
$shell_pid=~/^(\d+)$/;
$shell_pid=$1;
if (!$shell_pid) {
$cmd_handle->print;my $ct=0;
$cmd_handle->print(
$Net::FullAuto::FA_Core::printfpath.
'printf \\\\041\\\\041;echo $$;'.
$Net::FullAuto::FA_Core::printfpath.
'printf \\\\045\\\\045');
my $allins='';$ct=0;
while (1) {
eval {
while (my $line=$cmd_handle->get(
Timeout=>5)) {
chomp($line=~tr/\0-\37\177-\377//d);
$allins.=$line;
print $Net::FullAuto::FA_Core::MRLOG "SHELLPIDLINEEEERRRRRRRR=$allins<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($allins=~/!!(.*)%%/) {
$shell_pid=$1;
print $Net::FullAuto::FA_Core::MRLOG "SHELLPIDRRRRR**AAAAA=$shell_pid<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last;
}
}
};
if ($@) {
$cmd_handle->print;
} elsif (!$shell_pid && $ct++<50) {
$cmd_handle->print;
} else {
print $Net::FullAuto::FA_Core::MRLOG "SHELL_PIDRRRRR**BBBB=$shell_pid<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
last
}
}
}
chomp($shell_pid=~tr/\0-\11\13-\37\177-\377//d);
#print "WHAT IS SHELLPID_CMD_LOGIN=$shell_pid<=**=**=**=**=**=**=**=**=\n";
print $Net::FullAuto::FA_Core::MRLOG
"SHELLPID_CMD_LOGIN=$shell_pid<=**=**=**=**=**=**=**=**=\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
if ($su_id) {
${$Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{'cmd_su_'.$Net::FullAuto::FA_Core::pcnt}}[2]=$shell_pid;
} else {
${$Net::FullAuto::FA_Core::Processes{$hostlabel}{$login_id}
{'cmd_id_'.$Net::FullAuto::FA_Core::pcnt}}[2]=$shell_pid;
}
if (!$cygwin) {
if ($su_id) {
$su_login=1;
my ($ignore,$su_err)=
&Net::FullAuto::FA_Core::su($cmd_handle,$hostlabel,$su_id,
$su_id,$hostname,$ip,$use,$uname,$_connect,$cmd_type,
[],$stderr);
&Net::FullAuto::FA_Core::handle_error($su_err) if $su_err;
if (0) {
# Make sure prompt won't match anything in send data.
$cmd_handle->prompt("/$prompt\$/");
$cmd_handle->print("export PS1=\'$prompt\';".
"unset PROMPT_COMMAND");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
}
}
} else {
&Net::FullAuto::FA_Core::acquire_semaphore(8712,
"mount -p at Line: ".__LINE__,1);
($cygdrive,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },
"${Net::FullAuto::FA_Core::mountpath}mount -p");
&Net::FullAuto::FA_Core::release_semaphore(8712);
$cygdrive=~s/^.*(\/\S+).*$/$1/s;
}
}
if (!$uname) {
print "JSUT CHECKING\n";<STDIN>;
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
($uname,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'uname');
$cmd_handle->print;
if (!$uname) {
$cmd_handle->print(
$Net::FullAuto::FA_Core::printfpath.
'printf \\\\041\\\\041;uname;'.
$Net::FullAuto::FA_Core::printfpath.
'printf \\\\045\\\\045');
my $allins='';my $ct=0;
while (my $line=$cmd_handle->get) {
chomp($line=~tr/\0-\37\177-\377//d);
$allins.=$line;
if ($allins=~/!!(.*)%%/) {
$uname=$1;
last;
} else {
$cmd_handle->print;
} last if $ct++==10;
}
}
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
if (lc($uname)=~/cygwin/) {
$uname='cygwin';$cygwin=1;
} elsif ($uname eq 'AIX') {
$uname='aix';
}
$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'Uname'}=$uname;
}
if ($smb && $ms_ms_share) {
my $msloginid = ($ms_su_id) ? $ms_su_id : $ms_login_id;
my $mspasswd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$msloginid,
$ms_share,$cmd_errmsg);
my $host=$ms_host;
my $mswin_cwd='';
($mswin_cwd,$smb_type,$stderr)=
&File_Transfer::connect_share($cmd_handle,
$ms_hostlabel);
&Net::FullAuto::FA_Core::handle_error($stderr,'-3') if $stderr;
if (!$FA_Core::tran[0] && defined $transfer_dir) {
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,$cmd_handle,$cmd_type,
$cygdrive,$_connect);
${$work_dirs}{_pre_mswin}=
${$work_dirs}{_cwd_mswin}=$mswin_cwd;
${$work_dirs}{_pre}=${$work_dirs}{_cwd}='';
($output,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0] ]
},'cd '.${$work_dirs}{_tmp});
if ($stderr) {
@FA_Core::tran=();
my $die="Cannot cd to TransferDir -> "
.${$work_dirs}{_tmp_mswin}
."\n $stderr";
&Net::FullAuto::FA_Core::handle_error($die);
}
$Net::FullAuto::FA_Core::tran[0]=${$work_dirs}{_tmp};
$Net::FullAuto::FA_Core::tran[1]=$hostlabel;
} else {
# ADD CODE HERE FOR DYNAMIC TMP DIR DISCOVERY
&Net::FullAuto::FA_Core::handle_error(
"No TransferDir Defined for $hostlabel");
}
} else {
print $Net::FullAuto::FA_Core::MRLOG
"FTM_TYPE=$ftm_type and CMD_TYPE=$cmd_type ".
"and CMD_HANDLE=$cmd_handle<====\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$work_dirs=&Net::FullAuto::FA_Core::work_dirs($transfer_dir,
$hostlabel,{ _cmd_handle=>$cmd_handle,
_uname=>$uname },$cmd_type,$cygdrive,
$_connect);
my $curdir='';
if ($uname eq 'cygwin') {
($curdir,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ]
},'pwd');
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;
my $cdr='';
if (exists $Net::FullAuto::FA_Core::cygpathw{$curdir}) {
$cdr=$Net::FullAuto::FA_Core::cygpathw{$curdir};
} else {
($cdr,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ]
},"cygpath -w \"$curdir\"");
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;
$cdr=~s/\\/\\\\/g;
}
${$work_dirs}{_pre_mswin}=
${$work_dirs}{_cwd_mswin}=$cdr.'\\\\';
${$work_dirs}{_pre}=${$work_dirs}{_cwd}=$curdir;
} else {
($curdir,$stderr)=Rem_Command::cmd(
{ _cmd_handle=>$cmd_handle,
_hostlabel=>[ $hostlabel,'' ] },'pwd');
&handle_error("$stderr at Line ".__LINE__,'-1') if $stderr;
$curdir.='/' if $curdir ne '/';
${$work_dirs}{_pre}=${$work_dirs}{_cwd}=$curdir;
print $Net::FullAuto::FA_Core::MRLOG "CURDIRDETERMINED!!!!!!=$curdir<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
}
};
if ($@) {
$cmd_errmsg=$@;
print "WHAT IS THE CMD_ERR=$@\n";<STDIN>;
print $Net::FullAuto::FA_Core::MRLOG
"\ncmd_login() Login ERROR!".
" - The Username or Password is INCORRECT\n",
" $cmd_errmsg -> Login Name Used: $use_su_login\n",
" at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\ncmd_login() Login ERROR!".
" - The Username or Password is INCORRECT\n",
" $cmd_errmsg -> Login Name Used: $use_su_login\n",
" at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
if ((-1<index $cmd_errmsg,'timed-out') ||
(-1<index $cmd_errmsg,'filehandle isn') ||
(-1<index $cmd_errmsg,'no-uname')) {
print "WHAT IS THE ERROR=$cmd_errmsg<===\n";
print $Net::FullAuto::FA_Core::MRLOG "WHAT IS THE ERROR=$cmd_errmsg<=== and RETRYS=$retrys\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#&Net::FullAuto::FA_Core::handle_error("$@ and LINE=$outpt",'__cleanup__') if $outpt;
#&Net::FullAuto::FA_Core::release_semaphore(1234);
if ($retrys<2) {
$retrys++;
if (($su_login || $use_su_login) &&
exists $Net::FullAuto::FA_Core::Processes{$hostlabel}
{$su_id}{"cmd_su_$Net::FullAuto::FA_Core::pcnt"}) {
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"}
} elsif (exists $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}) {
delete $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}
}
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if
$shell_pid && &Net::FullAuto::FA_Core::testpid($shell_pid);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);
$cmd_handle->close;next;
} else {
my $host= $hostname ? $hostname : $ip;
$cmd_errmsg="$@\n\n While Attempting "
. "Login to $host\n -> HostLabel "
. "\'$hostlabel\'\n\n";
if (-1<index $cmd_errmsg,'timed-out') {
$cmd_errmsg.=" \'$hostlabel\'\n\n Current Timeout "
."Setting is -> $cdtimeout seconds.";
} &Net::FullAuto::FA_Core::handle_error($cmd_errmsg);
}
} my $die_login_id='';
if (($su_login || $use_su_login) &&
exists $Net::FullAuto::FA_Core::Processes{$hostlabel}
{$su_id}{"cmd_su_$Net::FullAuto::FA_Core::pcnt"}) {
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$su_id}
{"cmd_su_$Net::FullAuto::FA_Core::pcnt"};
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if $shell_pid
&& &Net::FullAuto::FA_Core::testpid($shell_pid);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);
$cmd_handle->close;
} elsif (exists $Net::FullAuto::FA_Core::Processes{
$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"}) {
delete $Net::FullAuto::FA_Core::Processes{$hostlabel}{$login_id}
{"cmd_id_$Net::FullAuto::FA_Core::pcnt"};
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$shell_pid,$kill_arg) if $shell_pid
&& &Net::FullAuto::FA_Core::testpid($shell_pid);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(
$cmd_pid,$kill_arg) if
&Net::FullAuto::FA_Core::testpid($cmd_pid);
$cmd_handle->close;
}
if (!$Net::FullAuto::FA_Core::cron) {
if ($su_login || $use_su_login) {
&Net::FullAuto::FA_Core::scrub_passwd_file($hostlabel,$su_id,'');
$die_login_id=$su_id;
} else {
&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id,'');
$die_login_id=$login_id;
}
}
my $unam='';
if (-1<index $cmd_errmsg,'Cannot su to') {
@connect_method=@{$cmd_cnct};
if (2<=$retrys) {
$unam=$uname;
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$su_id);
} else { $retrys++;next }
} else { $retrys++;next }
} elsif ($cmd_errmsg=~/invalid log|ogin incor|sion den/s
&& $cmd_errmsg!~/No more auth/s) {
if ($ms_domain && 2<=$retrys) {
$cmd_errmsg.="\n WARNING! - You may be in"
." Danger of locking out MS Domain\n"
." ID - $login_id!\n\n";
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);
} else { $retrys++;next }
} elsif (2<=$retrys) {
$unam=$uname;
$unam='MS Windows' if $unam eq 'cygwin';
$cmd_errmsg.="\n WARNING! - You may be in"
." Danger of locking out $unam\n"
." $hostlabel ID - "
."$login_id!\n\n";
if ($retrys==3) {
$su_scrub=&Net::FullAuto::FA_Core::scrub_passwd_file(
$hostlabel,$login_id);
} else { $retrys++;next }
} else { $retrys++;next }
}
my $c_t=$cmd_type;$c_t=~s/^(.)/uc($1)/e;
if (-1<index $cmd_errmsg,'Could not resolve hostname') {
($die=$cmd_errmsg)=~s/: hostname/:\n\n hostname/s;
} else {
#print "IS THIS REALLY WHERE WE ARE DYINGMMMMMMMMMM and CMDERR=$cmd_errmsg<==\n";<STDIN>;
$die="The System $hostname Returned\n the "
."Following Unrecoverable Error Condition\,\n"
." Rejecting the $c_t Login Attempt "
."of the ID\n -> $die_login_id "
."at ".(caller(2))[1]." line ".(caller(2))[2]
." :\n\n $cmd_errmsg";
}
$die.="\n While Attempting "
. "Login to $host\n -> HostLabel "
. "\'$hostlabel\'\n\n";
$Net::FullAuto::FA_Core::fa_login.=$die;
if ($ms_domain
&& $cmd_errmsg=~/invalid log|ogin incor|ogon fail/) {
$die.="\nHint: Your MS Domain -> $ms_domain Login ID may be "
."locked out.\n Contact Your System "
."Administrator for Assistance.\n\n";
}
$cmd_handle=Bad_Handle->new($hostlabel,$die);
last;
} else { last }
last if $die;
}
print $Net::FullAuto::FA_Core::MRLOG
"GETTTING OUT OF HERE!!!!!==>cmd_login()\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#$Net::FullAuto::FA_Core::log=0 if $logreset;
return $cmd_handle,$work_dirs,$uname,$cmd_type,$ftm_type,$smb,
$die,$ip,$hostname,$cmd_pid,$shell_pid,$cygdrive,$shell;
} ## END of &cmd_login()
sub wait_for_prompt {
my $cmd_handle=$_[0];
my $timeout=$_[1];
my @connect_method=@{$_[2]};
my $hostlabel=$_[3];
my $from_su=$_[4]||'';
$Net::FullAuto::FA_Core::uhray=&Net::FullAuto::FA_Core::get_prompt();
unless ($from_su) {
$cmd_handle->print('cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::printfpath.
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
}
my $previous_method='';my $sshloginid='';my $ignore='';
my $preferred=0;my $outpt='';my $cygdrive='';my $prompt='';
my $output='';my $ct=0;my $tymeout=1;
while (1) {
if (($ct==1) && (5<$timeout)) {
$tymeout=5;
} elsif (($ct==2) && (10<$timeout)) {
$tymeout=10;
} elsif (2<$ct) {
$tymeout=$timeout;
}
eval {
print $Net::FullAuto::FA_Core::MRLOG
"\nINFO: Rem_Command::cmd_login() ",
"STARTING \$cmd_handle->get() LOOP inside eval COUNT=$ct",
"\n LOOKING FOR CMD PROMPT AFTER PASSWORD OUTPUT ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nINFO: Rem_Command::cmd_login() ",
"STARTING \$cmd_handle->get() LOOP inside eval COUNT=$ct",
"\n LOOKING FOR CMD PROMPT AFTER PASSWORD OUTPUT",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
while (my $line=$cmd_handle->get(Timeout=>$tymeout)) {
$SIG{ALRM} = sub { die "read timed-out\n" }; # \n required
alarm $timeout+1;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() $ct ",
"LOOKING FOR CMD PROMPT AFTER PASSWORD OUTPUT ",
"(Timeout=$tymeout):\n ==>$line<==\n ",
"SEPARATOR=${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() $ct ",
"LOOKING FOR CMD PROMPT AFTER PASSWORD OUTPUT ",
"(Timeout=$tymeout):\n ==>$line<==\n ",
"SEPARATOR=${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
$outpt.=$line;
$output.=$line;
$output=~s/login:.*//s;
if ($line=~/(?<!Last )login[: ]*$/m ||
unpack('a10',$line) eq 'Login inco'
|| (-1<index $line,'Perm')) {
while (1) {
if (-1<$#connect_method) {
last if $previous_method eq $connect_method[0];
shift @connect_method;
}
}
$output=~s/^\s*//s;
$output=~s/\s*//s;
alarm 0;
if ($output=~/^.*(Perm.*)$/s) {
my $one=$1;
if ($output=~/^.*(No more auth.*)$/s) {
die "$1\n";
} die "$one\n";
}
die "$output\n";
} elsif ($line=~/Connection (?:closed|reset)/s) {
alarm 0;
die "$output\n";
}
if ($outpt=~
/${$Net::FullAuto::FA_Core::uhray}[0]_-(.*)$/s) {
$prompt=$1;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() PROMPT DYNAMICALLY DERIVIED:",
"\n ==>$prompt<==\n SEPARATOR=".
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() PROMPT DYNAMICALLY DERIVED:",
"\n ==>$line<==\n SEPARATOR=",
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
alarm 0;
last;
} elsif ($outpt=~/^((?:bash)*[\$%#>])\s?cmd \//m) {
$prompt=$1;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() PROMPT DYNAMICALLY DERIVIED:",
"\n ==>$prompt<==\n SEPARATOR=cmd \/",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() PROMPT DYNAMICALLY DERIVED:",
"\n ==>$line<==\n SEPARATOR=cmd \/",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
alarm 0;
last;
}
alarm 0;
}
};
if ($@) {
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd_login() (eval) ERROR \"set\" cmd:\n ",
"==>$@<==\n SEPARATOR=",
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nRem_Command::cmd_login() (eval) ERROR \"set\" cmd:\n ",
"==>$@<==\n SEPARATOR=",
"${$Net::FullAuto::FA_Core::uhray}[0]_- ",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron
&& $Net::FullAuto::FA_Core::debug;
my $ev_err=$@;
if ($ev_err=~/read timed-out/s && $ct++<3) {
$Net::FullAuto::FA_Core::uhray=
&Net::FullAuto::FA_Core::get_prompt();
$cmd_handle->print('cmd /Q /C "set /A '.
${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::printfpath.
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2].
'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
} elsif ($sshloginid &&
$ev_err=~/Permission denied/s) {
if ($ev_err=~/No more auth/s) {
die $ev_err;
} else {
$cmd_handle->print(&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$sshloginid,'',$@,
'__force__'));
$Net::FullAuto::FA_Core::uhray=
&Net::FullAuto::FA_Core::get_prompt();
$cmd_handle->print('cmd /Q /C "set /A '
.${$Net::FullAuto::FA_Core::uhray}[1].'&echo _-"'.
'|| '.$Net::FullAuto::FA_Core::printfpath.
'printf \\\\'.${$Net::FullAuto::FA_Core::uhray}[2]
.'\\\\'.${$Net::FullAuto::FA_Core::uhray}[3].
'\\\\137\\\\055 2>/dev/null');
}
} else { die $ev_err }
} else { last }
}
$cmd_handle->prompt('/_funkyPrompt_$/');
$cmd_handle->print(
"export PS1=_funkyPrompt_;unset PROMPT_COMMAND");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$cmd_handle);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
return $cmd_handle;
} ## END OF &wait_for_prompt
sub ftpcmd
{
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
my @topcaller=caller;
print "\nINFO: Rem_Command::ftpcmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::ftpcmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $handle=$_[0];
my $cmd=$_[1];my $ftperr='';my $return_all=0;
if (1<$#_) {
if ($_[2] eq '__return_all_output__') {
$return_all=1;
}
}
my $hostlabel=$handle->{_hostlabel}->[1]
|| $handle->{_hostlabel}->[0];
my $ftm_type=$handle->{_ftm_type};
my $output='';my $nfound='';my $allbytes='';
my $ready='';my $more='';my $retrys=0;
my $stdout='';my $stderr='';my $hashcount=0;
my $keepcount=0;my $gpfile='';my $seen=0;
$gpfile=unpack('a3',$cmd) if 2<length $cmd;
my $prcnt=0;my $firstvisit=0;my $gf='';
if ($gpfile eq 'get' || $gpfile eq 'put') {
my $ex=($gpfile eq 'put')?'!':'';
($gpfile=$cmd)=~s/^...\s+(.*)$/$1/;
chomp $gpfile;my $lsline='';
($gf=$gpfile)=~s/^["']([^"']*)["'].*$/$1/;
if ($gf eq $gpfile && (-1<index $gpfile,' ')) {
$gf=substr($gf,0,(index $gf,' '));
}
$gf=~s/\+/\\\+/g;
my $gfp='';
if ($ftm_type eq 'sftp') {
$gfp=' '.substr($gf,0,(rindex $gf,'/'));
$gfp='' if (-1==index $gfp,'/');
}
($output,$stderr)=&ftpcmd($handle,"${ex}ls$gfp");
print "\nINFO: Rem_Command::ftpcmd() (S)FTP OUTPUT FROM (!)ls cmd:\n ",
"OUTPUT=$output<== and STDERR=$stderr<==\n\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::ftpcmd() (S)FTP OUTPUT FROM (!)ls cmd:\n ",
"OUTPUT=$output<== and STDERR=$stderr<==\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($stderr) {
if (wantarray) {
return $output,$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr,'-13','__cleanup__');
}
} my $gpf=substr($gf,(rindex $gf,'/')+1);
foreach my $line (split /^/, $output) {
if (-1<index $line,'total 0') {
if (wantarray) {
return '',"$cmd: No Files Found";
} else {
&Net::FullAuto::FA_Core::handle_error("$cmd: No Files Found");
}
}
next if unpack('a1',$line) ne '-';
chomp($line=~tr/\0-\37\177-\377//d);
if ($line=~s/$gpf$//) {
#print "LSLINE=$line and GPF=$gpf\n";
$lsline=$line;last;
}
}
if (!$lsline) {
#print "WHAT IS THE CMD=${ex}ls -l$gfp\n";
($output,$stderr)=&ftpcmd($handle,"${ex}ls -l$gfp");
#print "OUTPUT=$output and STDERR=$stderr\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
foreach my $line (split /^/, $output) {
#print "SFTPOUTPUTLINE=$line<==\n";
if (-1<index $line,'total 0') {
if (wantarray) {
return '',"$cmd: No Files Found";
} else {
&Net::FullAuto::FA_Core::handle_error("$cmd: No Files Found");
}
}
next if unpack('a1',$line) ne '-';
chomp($line=~tr/\0-\37\177-\377//d);
if ($handle->{_luname} eq 'cygwin') {
if ($line=~/$gf$/i) {
$lsline=$line;last;
}
} else {
if ($line=~/$gf$/) {
$lsline=$line;last;
}
}
}
}
my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;
#print "LSLINE1=$lsline<==\n";
$lsline=~s/^.*\s+($rx1|$rx2)$/$1/;
#print "LSLINE2=$lsline<==\n";
($allbytes)=$lsline=~/^(\d+)\s+[JFMASOND]\w\w\s+\d+\s+\S+\s+.*$/;
if ($ftm_type ne 'sftp') {
($output,$stderr)=&ftpcmd($handle,'hash');
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
#$allbytes||='';
#print "ALLBYTES=$allbytes<==\n";
} else { $gpfile='' }
eval {
$handle->{_ftp_handle}->print($cmd);
};
if ($@) {
&Net::FullAuto::FA_Core::handle_error(
"$@\n and COMMAND=$cmd and GPFILE=$gpfile".
"and FTP_HANDLE=$handle->{_ftp_handle}\n",'-4');
}
&Net::FullAuto::FA_Core::handle_error($handle->{_ftp_handle}->errmsg)
if $handle->{_ftp_handle}->errmsg;
my $cmdflag=0;my $tcmd='';my $loop=0;
while (1) {
my $starttime=time();
eval {
while (1) {
if (!$more) {
$nfound = select
$ready=${${*{$handle->{_ftp_handle}}}{net_telnet}}{fdmask},
'', '', $handle->{_ftp_handle}->timeout;
} $output='';
if ($nfound > 0 || $more) {
sysread $handle->{_ftp_handle},
$output,
${${*{$handle->{_ftp_handle}}}{net_telnet}}{blksize},
0;
$more='' if $more;
} elsif (!$stdout) {
$starttime=time();
}
chomp($output=~tr/\0-\11\13-\37\177-\377//d);
$stdout.=$output;
if ($gpfile && (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug)) {
$hashcount=$output;
$hashcount=($hashcount=~tr/#//);
if ($allbytes && (1<$hashcount) && ($ftm_type ne 'sftp')) {
if (!$firstvisit) {
print $Net::FullAuto::FA_Core::MRLOG "\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n";
$firstvisit=1;
}
$hashcount=$hashcount*1024;
$keepcount=$keepcount+$hashcount;
$keepcount=$allbytes if $allbytes<$keepcount;
my $plin="$keepcount bytes, ";
$prcnt=$keepcount/$allbytes;
if (unpack('a1',$prcnt) eq '1') {
$prcnt=100;
} else { $prcnt=substr($prcnt,2,2) }
substr($prcnt,0,1)='' if unpack('a1',$prcnt) eq '0';
$plin.="${prcnt}% of $gpfile transferred . . . ";
STDOUT->autoflush(1);
printf("\r% 0s",$plin);
STDOUT->autoflush(0);
print $Net::FullAuto::FA_Core::MRLOG "FTP STDOUT: ==>$plin<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
sleep 1;
print "\n" if $keepcount==$allbytes;
} elsif (!$keepcount) {
foreach my $line (split /\n+/, $output) {
chomp($line=~tr/\0-\11\13-\37\177-\377//d);
$line=~tr/#//d;
$line=~s/s*ftp> ?$//s if !($line=~s/^\s*$//m);
my $upcnt=$line=~/Upload/gs;
$upcnt||=0;
if ($upcnt) {
if ($seen) { next }
$seen=1
}
$line=~s/Upload.*$//s if 1<$upcnt;
my $ftcnt=$line=~/Fetch/gs;
$ftcnt||=0;
if ($ftcnt) {
if ($seen) { next }
$seen=1
}
$line=~s/Fetch.*$//s if 1<$ftcnt;
if ((-1==index $line,'421 Service not')
|| (-1==index $line,'421 Timeout')
|| (-1==index $line,'Not connected')
|| (-1==index $line,'file access p')
|| (-1==index $line,'421 User limit')
|| (-1==index $line,'421 You are not')
|| (-1==index $line,'421 Max con')
|| (-1==index $line,'426 Connection')) {
my $tl=$line;
$tl=~s/[\r|\n]*//sg;
if ($line=~s/^\n*Uploading/\n\nUploading/gs) {
STDOUT->autoflush(1);
print $line."\n\n";
STDOUT->autoflush(0);
print $Net::FullAuto::FA_Core::MRLOG
uc($ftm_type)." STDOUT: ==>$line<==\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
} elsif ($line=~s/^\n*Fetch/\n\nFetch/gs) {
STDOUT->autoflush(1);
print $line,"\n\n";
STDOUT->autoflush(0);
print $Net::FullAuto::FA_Core::MRLOG
uc($ftm_type)." STDOUT: ==>$line<==\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
} elsif ($line=~/(stalled -|\d\d:\d\d *E*T*A*)$/) {
STDOUT->autoflush(1);
printf("\r% 0s",$line);
STDOUT->autoflush(0);
print $Net::FullAuto::FA_Core::MRLOG
uc($ftm_type)." STDOUT: ==>$line<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
} elsif (!$cmdflag && $stdout=~/^((?:get|put) ["][^"]+["]).*/s) {
print $1;
$cmdflag=1;
} elsif ($cmd!~/$tl/) {
$cmdflag=1;
} else {
$tcmd=$line;
$cmdflag=1 if $cmd eq $tcmd;
}
}
if (!$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug) {
if (5<length $line) {
if (unpack('a6',$line) eq '150 Op') {
print $Net::FullAuto::FA_Core::MRLOG "\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n";last;
} elsif (unpack('a6',$line) eq '125 St') {
print $Net::FullAuto::FA_Core::MRLOG "\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n\n";
} elsif (unpack('a4',$line) eq '"get') {
print $Net::FullAuto::FA_Core::MRLOG "\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n";
} elsif (unpack('a4',$line) eq '"put') {
print $Net::FullAuto::FA_Core::MRLOG "\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n";
}
}
}
if ($allbytes && $line=~/(\d+) bytes/) {
my $bytestransferred=$1;
my $warn="WARNING! - The transfer of file $gf\n "
."size $allbytes bytes\, aborted at $bytestransferred "
."\n bytes transferred.";
&Net::FullAuto::FA_Core::handle_error($warn,'__return__','__warn__')
if $allbytes ne $bytestransferred;
}
}
}
}
if ($output || $stdout=~/s*ftp> ?$/s) {
if ((-1<index $stdout,'bash: ') || (-1<index $stdout,'age too lo')) {
print $Net::FullAuto::FA_Core::MRLOG "TOO MANY LOOPS - GOING TO RETRY11<=======\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$handle->{_ftp_handle}->print("\004");
die "421 Timeout - $ftm_type read timed out";
}
$loop=0;
chomp($output=~tr/\0-\11\13-37\177-\377//d);
$output=~tr/ //d;
if ($output=~/s*ftp> ?$/s || $stdout=~/s*ftp> ?$/s || $more) {
$nfound=select
$ready=${${*{$handle->{_ftp_handle}}}{net_telnet}}{fdmask},
'', '', 0;
if ($nfound) {
$more=1;next;
} else {
$stdout=~s/^(.*?)(\012|\013)+//s;
$stdout=~s/s*ftp> ?$//s;
$stdout=~tr/#//d;
last
}
} $starttime=time();
} elsif ((!$gpfile && $loop++==10) || (-1<index $stdout,'bash: ')) {
print $Net::FullAuto::FA_Core::MRLOG "TOO MANY LOOPS - GOING TO RETRY<22=======\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$handle->{_ftp_handle}->print("\004");
$stdout="421 Timeout - $ftm_type read timed out";die
} elsif ($handle->{_ftp_handle}->timeout<time()-$starttime) {
print $Net::FullAuto::FA_Core::MRLOG "$ftm_type read timed out<=======\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "$ftm_type read timed out1 and OUTPUT=$output<=======\n";
if ($retrys<2) {
$retrys++;
$handle->{_ftp_handle}->print("\004");
$stdout="421 Timeout - $ftm_type read timed out at Line ".
__LINE__;die
} else {
my $tmot="421 Timeout - $ftm_type read timed out\n"
." Timeout=".$handle->{_ftp_handle}->timeout."\n"
." at Line: ".__LINE__;
&Net::FullAuto::FA_Core::handle_error($tmot,'__cleanup__');
}
}
} print "\n" if $output && $gpfile
&& $keepcount && !$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug;
};
print $Net::FullAuto::FA_Core::MRLOG "FTP-STDOUT-COMPLETED=$stdout<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#print "FTP-STDOUT-COMPLETED=$stdout and FTM_TYPE=$ftm_type<==\n";
#sleep 15 if !defined $ftm_type;
if ($stdout=~/^5\d+\s+$/m && $stdout!~/^5\d+\s+bytes.*$/m) {
$stdout=~/^(5.*)$/m;
$stderr=$1;
chomp($stderr=~tr/\0-\37\177-\377//d);
print $Net::FullAuto::FA_Core::MRLOG "FTP-STDERR-500-DETECTED=$stderr<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
} elsif ((-1<index $stdout,":5") && $stdout=~/^(.*:5\d\d\s.*)$/m) {
my $line=$1;
chomp($line=~tr/\0-\37\177-\377//d);
$stderr="$line\n $!" if $line!~/^\d+\s+bytes/;
} elsif ((-1<index $stdout,'421 Service not')
|| (-1<index $stdout,'421 Timeout')
|| (-1<index $stdout,'Not connected')
|| (-1<index $stdout,'file access p')
|| (-1<index $stdout,'421 User limit')
|| (-1<index $stdout,'421 You are not')
|| (-1<index $stdout,'421 Max con')
|| (-1<index $stdout,'426 Connection')) {
print $Net::FullAuto::FA_Core::MRLOG
"$ftm_type 400 SERIES ERROR: ==>$stdout<==\n\n".
" and HOSTLABEL=$hostlabel\n\n"
if -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n\n$ftm_type 400 SERIES ERROR:\n\n".
" ==>$stdout<==\n\n".
"Attempting to reconnect and retry . . .\n\n"
if !$Net::FullAuto::FA_Core::cron &&
!$Net::FullAuto::FA_Core::quiet;
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fctimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,
$handle->{_connect});
if ($Net::FullAuto::FA_Core::cltimeout ne 'X') {
$fctimeout=$Net::FullAuto::FA_Core::cltimeout;
} elsif (!$fctimeout) {
$fctimeout=$timeout if !$fctimeout;
}
my $ftm_errmsg='';
my $host=($use eq 'ip') ? $ip : $hostname;
$handle->{_ftp_handle}->print('bye');
my $sav_ftp_handle='';my $ftp_handle='';
while (my $line=$handle->{_ftp_handle}->get) {
last if $line=~/_funkyPrompt_$/s;
if ($line=~/logout/s) {
$sav_ftp_handle=$handle->{_ftp_handle};
$handle->{_ftp_handle}->close;
($ftp_handle,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',$handle->{_connect});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
$handle->{_ftp_handle}=$ftp_handle->{_cmd_handle};
foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($sav_ftp_handle eq $Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
delete $Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
} elsif ($handle->{_ftp_handle} eq $Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
substr($type,0,3)='ftp';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$handle->{_ftp_handle};
}
}
}
}
}
}
if ( -1<index $stdout,'file access p') {
($handle->{_ftp_handle},$stderr)=
&login_retry($ftp_handle->{_cmd_handle},
$ftp_handle->{_connect},
$ftp_handle->{_cmd_type},$stdout);
if ($stderr) {
$stderr="$stdout\n $stderr";
if (wantarray) {
return '',$stderr;
} else {
&Net::FullAuto::FA_Core::handle_error($stderr);
}
} elsif (!$handle->{_ftp_handle}) {
if (wantarray) {
return '',$stdout;
} else {
&Net::FullAuto::FA_Core::handle_error($stdout);
}
}
} my $ftm_passwd='';
if ($su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$su_id,
$ms_share,$ftm_errmsg,'__su__');
#if ($ftm_passwd ne 'DoNotSU!') {
# $su_login=1;
#} else { $su_id='' }
$su_id=''
}
if (!$su_id) {
$ftm_passwd=&Net::FullAuto::FA_Core::getpasswd(
$hostlabel,$login_id,
$ms_share,$ftm_errmsg);
}
my $fm_cnt=-1;
foreach my $connect_method (@{$ftr_cnct}) {
$fm_cnt++;my $gotname=0;
if (lc($connect_method) eq 'ftp') {
my $go_next=0;
eval {
my $ftp__cmd="${Net::FullAuto::FA_Core::ftppath}ftp $host";
$handle->{_ftp_handle}->print(
"${Net::FullAuto::FA_Core::ftppath}ftp $host");
## Look for Name Prompt.
while (my $line=$handle->{_ftp_handle}->get) {
my $tline=$line;
$tline=~s/Name.*$//s;
if (-1<index $tline,'ftp: connect:') {
$tline=~/^.*connect:\s*(.*?\n).*$/s;
if ((-1==index $tline,'Address already in use')
&& (-1==index $tline,'Connection timed out'
)) {
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;
} else {
&Net::FullAuto::FA_Core::handle_error(
"ftp: connect: $1");
}
} else {
$handle->{_ftp_handle}->close
if defined fileno $handle->{_ftp_handle};
sleep int $handle->{_ftp_handle}->timeout/3;
($handle->{_ftp_handle},$stderr)=
&Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',
$handle->{_connect});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
$handle->{_ftp_handle}=$ftp_handle->{_cmd_handle};
$handle->{_ftp_handle}->print(
"${Net::FullAuto::FA_Core::ftppath}ftp $host");
FH1: foreach my $hlabel (
keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($handle->{_ftp_handle}
eq $Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
substr($type,0,3)='ftp';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}
{$type}=$handle->{_ftp_handle};
last FH1;
}
}
}
}
$tline=$line;
$tline=~s/Name.*$//s;
}
} elsif (-1<index $tline,'421 Service' ||
-1<index $tline,'No address associated with name'
|| (-1<index $tline,'Connection' &&
(-1<index $tline,'Connection closed' ||
-1<index $tline,
'ftp: connect: Connection timed out'))) {
$tline=~s/s*ftp> ?$//s;
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;
} else {
&Net::FullAuto::FA_Core::handle_error($tline);
}
}
print "TLIN=$tline"
if !$Net::FullAuto::FA_Core::cron || $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "TLIN=$tline"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (-1<index $tline,
'ftp: connect: Connection timed out') {
$tline=~s/s*ftp> ?\s*$//s;
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;
} else {
&Net::FullAuto::FA_Core::handle_error($tline);
}
} elsif ((-1<index $line,'A remote host refused')
|| (-1<index $line,
'ftp: connect: Connection refused')) {
my $host=($use eq 'ip') ? $ip : $hostname;
$line=~s/^(.*)?\n.*/$1/s;
my $die=$line;
if ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;last;
} else {
$die.="Destination Host - $host, HostLabel "
."- $hostlabel\n refused an "
."attempted connect operation.\n "
."Check for a running FTP daemon on "
.$hostlabel;
&Net::FullAuto::FA_Core::handle_error($die);
}
}
if ($line=~/Name.*[: ]+$/si) {
$gotname=1;last;
}
}
};
if ($@) {
if ($@=~/read timed-out/) {
my $die="&ftm_login() timed-out while\n "
."waiting for a login prompt from\n "
."Remote Host - $host,\n HostLabel "
."- $hostlabel\n\n The Current Timeout"
." Setting is ".$handle->{_ftp_handle}->timeout
." Seconds.";
&Net::FullAuto::FA_Core::handle_error($die);
} elsif ($fm_cnt==$#{$ftr_cnct}) {
$go_next=1;
} else {
&Net::FullAuto::FA_Core::handle_error($@);
}
} next if $go_next || !$gotname;
if ($su_id) {
$handle->{_ftp_handle}->print($su_id);
} else {
$handle->{_ftp_handle}->print($login_id);
}
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$handle->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$ftm_type,
_connect=>$handle->{_connect} });
$ftm_type='ftp';
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$handle->{_ftp_handle}->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$handle->{_ftp_handle});
next;
}
} last
} elsif (lc($connect_method) eq 'sftp') {
my $sftploginid=($su_id)?$su_id:$login_id;
my $sshport='';
if (exists $Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}) {
my $sp=$Net::FullAuto::FA_Core::sftpport;
$sshport=$sp.$Net::FullAuto::FA_Core::Hosts{$hostlabel}{'sshport'}.' ';
}
$handle->{_ftp_handle}->print("${Net::FullAuto::FA_Core::sftppath}sftp ".
"${sshport}$sftploginid\@$host");
FH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($handle->{_ftp_handle} eq $Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}) {
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type};
substr($type,0,3)='ftp';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$handle->{_ftp_handle};
last FH;
}
}
}
}
my $showsftp=
"\n LoggingL into $host via sftp . . .\n\n";
print $showsftp if (!$Net::FullAuto::FA_Core::cron
|| $Net::FullAuto::FA_Core::debug)
&& !$Net::FullAuto::FA_Core::quiet;
print $Net::FullAuto::FA_Core::MRLOG $showsftp
if $Net::FullAuto::FA_Core::log
&& -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
## Wait for password prompt.
my $ignore='';
($ignore,$stderr)=
&File_Transfer::wait_for_passwd_prompt(
{ _cmd_handle=>$handle->{_ftp_handle},
_hostlabel=>[ $hostlabel,'' ],
_cmd_type=>$ftm_type,
_connect=>$handle->{_connect} });
$ftm_type='sftp';
if ($stderr) {
if (!$fm_cnt || ($fm_cnt==$#{$ftr_cnct})) {
return '',$stderr;
} else {
$handle->{_ftp_handle}->print("bye");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$handle->{_ftp_handle});
next;
}
} last
}
}
my %ftp=(
_ftp_handle => $handle->{_ftp_handle},
_ftm_type => $ftm_type,
_hostname => $hostname,
_ip => $ip,
_uname => $uname,
_luname => $handle->{_uname},
_hostlabel => [ $hostlabel,$handle->{_hostlabel}->[0] ]
);
$handle->{_ftp_handle}->prompt("/s*ftp> ?\$/");
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,$ftm_passwd);
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'binary')
if $ftm_type ne 'sftp';
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
if (exists $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd}");
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{cd}=
$Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd};
delete $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{cd};
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
} elsif (exists $Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{cd}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"cd $Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{cd}");
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
}
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'pwd')
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "FTPCMD--PWD=$output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "DO WE HAVE LCD????=$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{lcd}<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (exists $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{lcd}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{lcd}");
$Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{lcd}=
$Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{lcd};
delete $Net::FullAuto::FA_Core::ftpcwd{$sav_ftp_handle}{lcd};
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
} elsif (exists $Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{lcd}) {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,
"lcd $Net::FullAuto::FA_Core::ftpcwd{$handle->{_ftp_handle}}{lcd}");
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
}
if ($gpfile && $ftm_type ne 'sftp') {
($output,$stderr)=&Rem_Command::ftpcmd(\%ftp,'hash');
if ($stderr) {
if (wantarray) {
return '',$stderr;
} else {
return $stderr;
}
}
}
$stdout='';$stderr='';
$handle->{_ftp_handle}->print($cmd);
next
} elsif ($ftm_type eq 'sftp') {
$stdout=~s/^$cmd\s*(.*)\s*sftp>\s*$/$1/s;
$stdout=~tr/\r//d;
$stdout=~s/\s*$//s;
if (exists $handle->{_cmd_handle}) {
if ($stdout=~/Couldn\'t canonicalise:/s) {
if ($cmd=~/^ls$|^ls /) {
($output,$stderr)=$handle->cmd($cmd);
if ($stderr) {
$stderr=$stdout;
} else { $stdout=$output }
} elsif ($cmd=~/^cd /) {
($output,$stderr)=$handle->cmd('pwd');
if ($stderr) {
$stderr=$stdout;
} else {
$output=~s/^.*direcotory: (.*)$/$1/;
my $out='';
($out,$stderr)=$handle->cmd($cmd);
if ($stderr) {
$stderr=$stdout;
} else {
chomp $output;
($out,$stderr)=$handle->cmd("cd $output");
if ($stderr) { $stderr=$stdout }
}
}
} else { $stderr=$stdout }
} elsif ((-1<index $stdout,'Permission denied') ||
(-1<index $stdout,'t stat remote file')) {
if ($cmd=~/^ls$|^ls /) {
if (!exists $GLOBAL{'nested_ls'}) {
$GLOBAL{'nested_ls'}=1;
($output,$stderr)=$handle->cmd($cmd);
} else {
delete $GLOBAL{'nested_ls'};
}
if ($stderr) {
$stderr=$stdout;
} elsif (-1<index $stdout,'t stat remote file') {
$stderr=$stdout;
} else { $stdout=$output }
} elsif (unpack('a4',$cmd) eq 'get ') {
if ((-1<index $stdout,'t stat remote file') ||
(-1<index $stdout,'t get handle')) {
my $stder='';
if ($cmd=~/^get\s+\"((?:\/|[A-Za-z]:).*)\"$/) {
my $path=$1;
$path=~/^(.*)[\/|\\]([^\/|\\]+)$/;
my $dir=$1;my $file=$2;my $getfile='';
my $testf=&Net::FullAuto::FA_Core::test_file($handle,
$path);
if ($testf eq 'WRITE' || $testf eq 'READ') {
if (exists $handle->{_work_dirs}->{_tmp}) {
($output,$stder)=$handle->cmd("cp -p $path ".
$handle->{_work_dirs}->{_tmp});
&Net::FullAuto::FA_Core::handle_error($stder) if $stder;
$getfile=$handle->{_work_dirs}->{_tmp}.
'/'.$file;
print "COPIED and GETFILE=$getfile<==\n";#<STDIN>;
} elsif (exists
$handle->{_work_dirs}->{_tmp_mswin}) {
print "COPIED and GETFILE222=$getfile<==\n";#<STDIN>;
($output,$stder)=$handle->cmd("cp -p $path ".
$handle->{_work_dirs}->{_tmp_mswin});
&Net::FullAuto::FA_Core::handle_error($stder) if $stder;
$getfile=$handle->{_work_dirs}->{_tmp_mswin}.
'\\'.$file;
}
($output,$stderr)=
&Rem_Command::ftpcmd($handle,"get $getfile");
if (!$stderr) {
($output,$stderr)=$handle->cmd(
"rm -f $getfile");
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
} $stdout=$output;
}
}
}
} elsif (unpack('a4',$cmd) eq 'put ') {
if (-1<index $stdout,'Uploading') {
if (-1<index $stdout,'t get handle') {
} #elsif (-1<index $stdout,'t open local file') {
#}
}
}
}
}
} elsif ($stdout=~/^4\d+\s+/m && $stdout!~/^4\d+\s+bytes.*$/m) {
my $line='';
foreach my $lin (split /^/, $stdout) {
$line.=" $lin" if unpack('a1',$lin) eq '4';
}
$stdout='';
$stderr=$line;
} elsif ($stdout=~/ftp: \w+: /) {
my $line='';
foreach my $lin (split /^/, $stdout) {
$line.=" $lin";
}
$stdout='';
$stderr=$line;
} else {
my $c='';
($c=$cmd)=~s/\+/\\\+/sg;
$stdout=~s/^$c\s*(.*)\s+s*ftp>\s*$/$1/s;
my $tmpso=$stdout;$stdout='';
}
if (!$stderr && $gpfile) {
($output,$stderr)=&ftpcmd($handle,'hash')
if $ftm_type ne 'sftp';
print "\n";
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
}
print "\nINFO: Rem_Command::ftpcmd() <<<<<<<RETURNING>>>>>>>:\n ",
"STDOUT=$stdout<== and STDERR=$stderr<==\n\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::ftpcmd() <<<<<<<RETURNING>>>>>>>:\n ",
"STDOUT=$stdout<== and STDERR=$stderr<==\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#$Net::FullAuto::FA_Core::log=0 if $logreset;
if (wantarray) {
return $stdout,$stderr;
} elsif (!$stdout && $stderr) {
return $stderr;
} else { return $stdout }
}
}
sub cmd
{
my @topcaller=caller;
print "\nINFO: Rem_Command::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self=$_[0];
my $kill_arg=($^O eq 'cygwin')?'f':9;
my @args=@_;shift @args;shift @args;
my $command=$_[1];$command||='';my $delay=0;
my $ftp=0;my $live=0;my $display=0;my $log=0;
my $wantarray= wantarray ? wantarray : '';
my $cmtimeout='X';my $svtimeout='X';my $sem='';
my $notrap=0;my $ignore='';my $login_retry=0;
my ($stdout,$stderr)=('','');
if (defined $_[2] && $_[2]) {
if ($_[2]=~/^[0-9]+/) {
$cmtimeout=$_[2];
} else {
my $arg=lc($_[2]);
if ($arg eq '__ftp__') {
$ftp=1;
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;
} elsif ($arg eq '__log__') {
$log=1;
} elsif ($arg eq '__notrap__') {
$notrap=1;
} elsif ($arg eq '__delay__') {
$delay=1;
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;
} elsif ($wantarray) {
return 0,'Third Argument for Timeout Value is not Whole Number';
} else {
&Net::FullAuto::FA_Core::handle_error(
'Third Argument for Timeout Value is not Whole Number')
}
}
} my $login_id='';
if (defined $_[3] && $_[3]) {
my $arg=lc($_[3]);
if ($arg eq '__ftp__') {
$ftp=1;
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;
} elsif ($arg eq '__log__') {
$log=1;
} elsif ($arg eq '__notrap__') {
$notrap=1;
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;
} else {
$login_id=$_[3];
}
}
while (1) {
my $cmd_prompt='';my $cmdprompt='';my $ms_cmd_prompt='';
if (defined $_[4] && $_[4]) {
my $arg=lc($_[4]);
if ($arg eq '__ftp__') {
$ftp=1;
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;
} elsif ($arg eq '__log__') {
$log=1;
} elsif ($arg eq '__notrap__') {
$notrap=1;
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;
} elsif (0) {
my $tmp_cmd_prompt=$cmd_prompt=$_[4];
if (unpack('a2',$cmd_prompt) ne '(?' &&
($cmd_prompt=~/\|\|/s || $cmd_prompt=~/\|[Mm]\|/s)) {
$cmd_prompt=~s/^(.*)(?:\|\||\|[Mm]\|)//s;
$tmp_cmd_prompt=$1;
pos($cmd_prompt)=0;
while ($cmd_prompt=~/(\|\||\|[Mm]\|)(.*)/g) {
if ($1 eq '||') {
$tmp_cmd_prompt.="|$2";
} else {
$ms_cmd_prompt.="|$2";
}
}
}
$cmd_prompt=
qr/$tmp_cmd_prompt/ if unpack('a2',$cmd_prompt) ne '(?';
}
} elsif (!$ftp) {
$cmd_prompt=substr($self->{_cmd_handle}->prompt,1,-2);
}
if (defined $_[5] && $_[5]) {
my $arg=lc($_[5]);
if ($arg eq '__ftp__') {
$ftp=1;$arg='';
} elsif ($arg eq '__live__' || $arg eq '__LIVE__') {
$live=1;$arg='';
} elsif ($arg eq '__display__' || $arg eq '__DISPLAY__') {
$display=1;
} elsif ($arg eq '__log__') {
$log=1;
} elsif ($arg eq '__notrap__') {
$notrap=1;
} elsif ($arg eq '__delay__') {
$delay=1
} elsif ($arg eq '__retry_on_error__') {
$login_retry=-1;
} else {
if (&Net::FullAuto::FA_Core::test_semaphore($_[5])) {
if ($wantarray) {
return 0,"Semaphore Blocking Command";
} else { return 'Semaphore Blocking Command' }
} else {
&Net::FullAuto::FA_Core::acquire_semaphore($_[5],,1);
$sem=$_[5];
}
}
}
if (!$ftp && (grep{lc($_) eq '__ftp__'}@_)) {
$ftp=1;
} elsif (!$live && (grep{lc($_) eq '__live__'}@_)) {
$live=1;
} elsif (!$display && (grep{lc($_) eq '__display__'}@_)) {
$ftp=1;
} elsif (!$log && (grep{lc($_) eq '__log__'}@_)) {
$log=1;
} elsif (!$notrap && (grep{lc($_) eq '__notrap__'}@_)) {
$notrap=1;
} elsif (!$delay && (grep{lc($_) eq '__delay__'}@_)) {
$delay=1;
} elsif ($login_retry==0 && (grep{lc($_) eq '__retry_on_error__'}@_)) {
$login_retry=-1;
}
if ($cmtimeout eq 'X') {
if ($ftp) {
$cmtimeout=$self->{_ftp_handle}->timeout;
$svtimeout=$self->{_ftp_handle}->timeout;
} else {
$cmtimeout=$self->{_cmd_handle}->timeout;
$svtimeout=$self->{_cmd_handle}->timeout;
}
} elsif ($ftp) {
$svtimeout=$self->{_ftp_handle}->timeout;
$self->{_ftp_handle}->timeout($cmtimeout);
} else {
$svtimeout=$self->{_cmd_handle}->timeout;
$self->{_cmd_handle}->timeout($cmtimeout);
}
my $caller=(caller(1))[3];
$caller='' unless defined $caller;
my $fullerror='';my $allines='';
my $hostlabel=$self->{_hostlabel}->[0];
if ($login_id) {
my $new_cmd='';
($new_cmd,$stderr)=
Rem_Command::new('Rem_Command',$hostlabel,
'__new_master__',
$self->{_connect});
&Net::FullAuto::FA_Core::handle_error($stderr,'-1') if $stderr;
($stdout,$stderr)=$new_cmd->cmd($command,@args);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($new_cmd->{_cmd_pid},$kill_arg) if
&Net::FullAuto::FA_Core::testpid($new_cmd->{_cmd_pid});
$new_cmd->{_cmd_handle}->close;
&Net::FullAuto::FA_Core::release_semaphore($sem) if $sem;
return $stdout,$stderr if $wantarray;
return $stdout if !$stderr;
return $stderr;
}
my $output='';my $stdout='';my $stderr='';my $pid_ts='';
my $end=0;my $newtel='';my $restart='';my $syntax=0;
my $doeval='';my $dots='';my $dcnt=0;
print $Net::FullAuto::FA_Core::MRLOG
"\nccccccc UNMODIFIED COMMAND as RECEIVED by Rem_Command::cmd() ccccccc: ".
"==>$command<== and LIVE=$live and THIS=$_[$#_-1]\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nccccccc UNMODIFIED COMMAND as RECEIVED by Rem_Command::cmd() ccccccc: ".
"==>$command<== and LIVE=$live and THIS=$_[$#_-1]\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
eval {
$stdout='';
$stderr='';
$end=0;
my $line='';my $testline='';
my $testcmd='';my $ms_cmd='';
($ms_cmd=$command)=~tr/ //s;
$ms_cmd=(-1<index lc($command),'cmd /c') ? 1 : 0;
if (0 && !$live && $ms_cmd) {
print $Net::FullAuto::FA_Core::MRLOG "WEVE GOT WINDOWSCOMMAND=$command\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($self->{_uname} ne 'cygwin') {
($output,$stderr)=Rem_Command::cmd($self,
'uname',@args);
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
$stderr="remote OS is $output - NOT a cygwin system!\n";
&Net::FullAuto::FA_Core::handle_error($stderr);
}
$pid_ts=$self->{_cmd_pid}.'_'.$Net::FullAuto::FA_Core::invoked[0]
.'_'.$Net::FullAuto::FA_Core::increment++;
push @FA_Core::pid_ts, $pid_ts;
my $t=$self->{_work_dirs}->{_tmp_mswin}.'\\';
$t=~s/\\/\\\\/g;
$t=~s/\\$//mg;
my $str="echo \"del ${t}end${pid_ts}.flg ${t}cmd${pid_ts}.bat"
." ${t}out${pid_ts}.txt ${t}err${pid_ts}.txt\""
." > ${t}rm${pid_ts}.bat";
$self->{_cmd_handle}->print($str);
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{_cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my $cmmd='';
if (-1<index $command,"\n") {
my @command=split /\n/,$command;my $ccnt=0;
foreach my $cmd (@command) {
($cmmd=$cmd)=~s/^\s*[cC][mM][dD]\s+\/[cC]\s+(.*)$/$1/;
$cmmd=~tr/\'/\"/;
$cmmd=~s/\\/\\\\/g;
$cmmd=~s/\\$//mg;
$cmmd=~s/\"/\\\"/g;
if (!$ccnt++) {
if (unpack('a4',$cmmd) eq 'set ') {
$str="echo \"$cmmd\""
." > ${t}cmd${pid_ts}.bat";
} else {
$str="echo \"$cmmd 2>${t}err${pid_ts}.txt "
."1>${t}out${pid_ts}"
.".txt\" > ${t}cmd${pid_ts}.bat";
}
$self->{_cmd_handle}->print($str);
my $lastDB7=0;
DB7: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB7=1;last
} last if $line=~/$cmd_prompt$/s;
}
}; last if $lastDB7;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
$output=join '',$self->{_cmd_handle}->cmd(
String => $str,
Timeout => $cmtimeout
);
} else {
if (unpack('a4',$cmmd) eq 'set ') {
$str="echo \"$cmmd\""
." >> ${t}cmd${pid_ts}.bat";
} else {
$str="echo \"$cmmd 2>>${t}err${pid_ts}.txt "
."1>>${t}out${pid_ts}"
.".txt\" >> ${t}cmd${pid_ts}.bat";
}
$self->{_cmd_handle}->print($str);
my $lastDB8=0;
DB8: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB8=1;last
} last if $line=~/$cmd_prompt$/s;
}
}; last if $lastDB8;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
}
}
} else {
($cmmd=$command)=~s/^\s*[cC][mM][dD]\s+\/[cC]\s+(.*)$/$1/;
$cmmd=~tr/\'/\"/;
$cmmd=~s/\\/\\\\/g;
$cmmd=~s/\\$//mg;
$cmmd=~s/\"/\\\"/g;
$str="echo \"$cmmd 2>${t}err${pid_ts}.txt 1>${t}out${pid_ts}"
.".txt\" > ${t}cmd${pid_ts}.bat";
$self->{_cmd_handle}->print($str);
my $lastDB9=0;
DB9: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB9=1;last
} last if $line=~/$cmd_prompt$/s;
}
}; last if $lastDB9;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
}
$str="echo \"echo \"DONE\" > ${t}end${pid_ts}.flg\" >>"
." ${t}cmd${pid_ts}.bat";
$self->{_cmd_handle}->print($str);
my $lastDB10=0;
DB10: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB10=1;last
} last if $line=~/$cmd_prompt$/s;
}
}; last if $lastDB10;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
$self->{_cmd_handle}->
print("echo \"exit\" >> ${t}cmd${pid_ts}.bat");
my $lastDB11=0;
DB11: while (1) {
$self->{_cmd_handle}->print;
eval {
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/^$cmd_prompt$/) {
$lastDB11=1;last
} last if $line=~/$cmd_prompt$/s;
}
};
if ($lastDB11) {
$self->{_cmd_handle}->print("echo ECHO");
eval {
my $echo=0;
while (my $line=$self->{_cmd_handle}->get(
Timeout=>$cmtimeout)) {
$line=~s/\s//g;
if ($line=~/ECHO/s) {
last if $line=~/$cmd_prompt$/s;
$echo=1;
} elsif ($echo==1) {
last if $line=~/$cmd_prompt$/s;
}
}
};
} last if $lastDB11;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
#print "RUNNING COMMANDBAT $cmmd\n";
$self->{_cmd_handle}->print("cmd /c start ${t}cmd${pid_ts}.bat");
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
KC: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($self->{_cmd_handle} eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[3]=
"cmd /c start cmd${pid_ts}.bat";
last KC;
}
}
}
}
my $err_cownt=0;my $nowerr_cownt=0;
my $err_size=0;my $err_size_save=0;
($output,$stderr)=$self->cmd('pwd');
print "BIGGOOOPUTPUT=$output<== and PRE=$self->{_work_dirs}->{_pre} and TMP=$self->{_work_dirs}->{_tmp} and CWD=$self->{_work_dirs}->{_cwd}\n";
my $c=$self->{_work_dirs}->{_tmp}||
$self->{_work_dirs}->{_tmp_mswin};
my $loop_time=0;
LK: while (1) {
#$loop_time=time() if !$loop_time;
#if ($cmtimeout<time()-$loop_time) {
# ($output,$stderr)=$self->cmd("ls -l err${pid_ts}.txt");
# &Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
# my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
# my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;
# $output=~s/^.*\s+($rx1|$rx2)$/$1/;
# $output=~/^(\d+)\s+[JFMASOND]\w\w\s+\d+\s+\S+\s+.*$/;
# my $size=$1;
#print "CMDOUTPUTSIZE=$size<==\n";
# last if $size;
# $loop_time=0;
#}
my $shell_cmd="if\n[[ -f ${c}end${pid_ts}.flg ]]\nthen" .
"\necho END\nelse\necho LOOKING\nfi\n";
$self->{_cmd_handle}->print($shell_cmd);
if ($self->{_cmd_handle}->errmsg) {
my $err=$self->{_cmd_handle}->errmsg;
&Net::FullAuto::FA_Core::handle_error($err);
} my $looptime=0;$allines='';
while (1) {
my $line=$self->{_cmd_handle}->
get(Timeout=>$cmtimeout);
$allines.=$line;
last if $allines=~/^(END|LOOKING)/m;
$self->{_cmd_handle}->print;
$looptime=time() if !$looptime;
if ($cmtimeout<time()-$looptime) {
my $lv_errmsg="read timed-out for command :"
."\n\n -> $cmmd"
."\n\n invoked on \'$hostlabel\'"
."\n\n Current Timeout "
."Setting is -> $cmtimeout seconds.\n\n";
$self->{_cmd_handle}->timeout($svtimeout);
if ($wantarray) {
die $lv_errmsg;
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
}
}
$allines=~s/\s*$//s;
if ($allines=~/^END/m) {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my $err_outt='';
($err_outt,$stderr)=$self->cmd("ls -l ${c}err${pid_ts}.txt");
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
$err_size='';
($err_size=$err_outt)
=~s/^\S+\s+\d+\s+\S+\s+\S+\s+(\d+).*$/$1/s;
if ($err_size!~/^\d+$/) {
($err_size=$err_outt)
=~s/^\S+\s+\d+\s+\S+\s+\S+\s+\S+\s+(\d+).*$/$1/s;
}
if ($err_size=~/^\d+$/) {
if ($err_size==$err_size_save &&
$nowerr_cownt+3<$err_cownt++) {
#my $cat_err='';
#($cat_err,$stderr)=$self->cmd(
# "cat ${c}err${pid_ts}.txt");
#print "CATERRRRRR=$cat_err<==\n";
&Net::FullAuto::FA_Core::handle_error($stderr) if $stderr;
last LK;
#&Net::FullAuto::FA_Core::handle_error($cat_err);
} else { $err_size_save=$err_size }
}
last LK;
}
if (!$Net::FullAuto::FA_Core::cron ||
$Net::FullAuto::FA_Core::debug) {
print $Net::FullAuto::FA_Core::blanklines;
print "\n Gathering MSWin Output $dots";
if ($dcnt++<5) {
$dots.=" .";
} else { $dots='';$dcnt=0 }
print "\n\n From Command => $cmmd\n\n";
} sleep 1;
}
print "GETTING THIS=${c}out${pid_ts}.txt\n";
my $trandir='';
if (($self->{_hostlabel}->[1] ne
$Net::FullAuto::FA_Core::DeploySMB_Proxy[0]
|| $Net::FullAuto::FA_Core::DeploySMB_Proxy[0]
ne "__Master_${$}__")
&& !($self->{_uname} eq 'cygwin' &&
($Net::FullAuto::FA_Core::DeploySMB_Proxy[0]
eq "__Master_${$}__"
|| $self->{_hostlabel}->[0] eq "__Master_${$}__"))) {
if ($self->{_work_dirs}->{_lcd} ne
$self->{_work_dirs}->{_tmp_lcd}) {
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_tmp_lcd}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
($output,$stderr)=&ftpcmd($self,
"get \"${c}out${pid_ts}.txt\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-3')
if $stderr;
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_lcd}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
} else {
($output,$stderr)=&ftpcmd($self,
"get \"${c}out${pid_ts}.txt\"");
}
if ($err_size) {
if ($self->{_work_dirs}->{_lcd} ne
$self->{_work_dirs}->{_tmp_lcd}) {
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_tmp_lcd}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
($output,$stderr)=&ftpcmd($self,
"get \"${c}err${pid_ts}.txt\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-3')
if $stderr;
($output,$stderr)=&ftpcmd($self,
"lcd \"$self->{_work_dirs}->{_lcd}\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-2')
if $stderr;
} else {
($output,$stderr)=&ftpcmd($self,
"get \"${c}err${pid_ts}.txt\"");
&Net::FullAuto::FA_Core::handle_error($stderr,'-1')
if $stderr;
}
}
}
if ($Net::FullAuto::FA_Core::localhost->{_work_dirs}->{_tmp}) {
$trandir=$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp'};
if (substr($trandir,-1) ne '/') {
$trandir.='/';
}
}
($stdout,$stderr)=$localhost->cmd(
"cat ${trandir}out${pid_ts}.txt");
if ($stderr) {
my $die="$stderr\n\n From Command -> "
."\"cat ${trandir}out${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
my $cmd_error='';my $error='';
if ($err_size) {
($cmd_error,$stderr)=$localhost->cmd(
"cat ${trandir}err${pid_ts}.txt");
if ($stderr) {
my $die="$stderr\n\n From Command -> "
."\"cat ${trandir}err${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die,'-4');
}
}
my $out='';
if ($^O eq 'cygwin') {
($out,$error)=$localhost->cmd(
"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp_mswin'}
."\\\\out${pid_ts}.txt",
'__live__');
if ($error) {
my $die="$error\n\n From Command -> "
."\"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}-{'_tmp_mswin'}
."\\\\out${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
($out,$error)=$localhost->cmd(
"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp_mswin'}
."\\\\err${pid_ts}.txt",
'__live__');
if ($error) {
my $die="$error\n\n From Command -> "
."\"cmd /c del /S /Q "
.$Net::FullAuto::FA_Core::localhost->{
'_work_dirs'}->{'_tmp_mswin'}
."\\\\err${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
&Net::FullAuto::FA_Core::handle_error(
"$cmd_error\n\n From Command -> $cmmd",'-8')
if $cmd_error && !$wantarray;
} else {
($out,$error)=$localhost->cmd(
"rm -rf ${trandir}out${pid_ts}.txt");
if ($error) {
my $die="$error\n\n From Command -> "
."\"rm -rf ${trandir}out${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
($out,$error)=$localhost->cmd(
"rm -rf ${trandir}err${pid_ts}.txt");
if ($error) {
my $die="$error\n\n From Command -> "
."\"rm -rf ${trandir}err${pid_ts}.txt\"";
&Net::FullAuto::FA_Core::handle_error($die);
}
}
$str="echo \"del ${t}rm${pid_ts}.bat\""
." >> ${t}rm${pid_ts}.bat";
$self->{_cmd_handle}->print($str);
$allines='';
while (my $line=$self->{_cmd_handle}->
get(Timeout=>$cmtimeout)) {
$allines.=$line;
last if $allines=~/$cmd_prompt$/s;
}
$self->{_cmd_handle}->print("cmd /c ${t}rm${pid_ts}.bat");
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
if ($cmd_error) {
my $error="$cmd_error\n\n From Command -> $cmmd";
&Net::FullAuto::FA_Core::handle_error($error) if !$wantarray;
die "$error\n\n at $topcaller[0] "
."$topcaller[1] line ".__LINE__.".\n";
}
} elsif ($ftp) {
($stdout,$stderr)
=&ftpcmd($self->{_cmd_handle},$command);
if ($stderr) {
my $host=($self->{_hostlabel}->[1])
? $self->{_hostlabel}->[1]
: $self->{_hostlabel}->[0];
my $die="$stderr\n\n From Command -> "
."\"$command\"\n for \'$host\'\.";
&Net::FullAuto::FA_Core::handle_error($die,'-10');
}
} else {
my $bckgrd=0;
$bckgrd=1 if $command=~s/[\t ][&](?>\s*)$//s;
my $live_command='';
if ($command=~/^cd[\t ]/) {
$live_command="$command 2>&1";
if (-1<$#{$self->{_hostlabel}} &&
$self->{_hostlabel}->[$#{$self->{_hostlabel}}]
eq "__Master_${$}__") {
my $lcd=$command;$lcd=~s/^cd[\t ]*//;
chdir $lcd;
}
} else {
$live_command='('.$command.')'." | sed -e 's/^/stdout: /' 2>&1";
}
$live_command.=' &' if $bckgrd;
print $Net::FullAuto::FA_Core::MRLOG
"\n+++++++ RUNNING FULLAUTO MODIFIED COMMAND +++++++: ".
"==>$live_command<==\n and ",
"SELECT_TIMEOUT=$cmtimeout and KEYSSELF=",
(join ' ',@{[keys %{$self}]}),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n+++++++ RUNNING FULLAUTO MODIFIED COMMAND +++++++: ".
"==>$live_command<==\n ",
"and ", "SELECT_TIMEOUT=$cmtimeout and KEYSSELF=",
(join ' ',@{[keys %{$self}]}),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
$self->{_cmd_handle}->timeout($cmtimeout);
$live_command=~s/\\\\/\\/g;
$live_command=~s/\\/\\\\/g;
$live_command=~s/\\$//mg;
$self->{_cmd_handle}->print($live_command);
my $growoutput='';my $ready='';my $firstout=0;
my $fulloutput='';my $lastline='';my $errflag='';
my $test_out='';my $first=-1;#my $starttime=0;
my $starttime=time();my $restart_attempt=1;my $nl='';
my $select_timeout=2;my $appendout='';my $retry=0;
my $command_stripped_from_output=0;
my $test_stripped_output='';
$self->{_cmd_handle}->autoflush(1);my $save='';
my $loop_count=0;my $loop_max=5;my $fetchflag=0;
FETCH: while (1) {
my $output='';$nl='';$loop_count++;
my $tim=time()-$starttime;
if (!$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug) {
print "INFO: ======= AT THE TOP OF MAIN OUTPUT LOOP =======;".
" at Line ".__LINE__."\n" if $first || $starttime;
print "INFO: STARTTIME=$starttime and TIMENOW=",time(),
" and TIMEOUT=$cmtimeout and Diff=$tim\n";
}
print $Net::FullAuto::FA_Core::MRLOG
"INFO: ======= AT THE TOP OF MAIN OUTPUT LOOP =======;".
" at Line ".__LINE__."\n",
"INFO: STARTTIME=$starttime and TIMENOW=",time(),
" and TIMEOUT=$cmtimeout and Diff=$tim and ",
"SELECT_TIMEOUT=$select_timeout\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($select_timeout!=2 && $select_timeout==$tim) {
$self->{_cmd_handle}->print("\003");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle},$tim);
&Net::FullAuto::FA_Core::handle_error(
$cfh_error,'-2','__cleanup__')
if $cfh_error;
my $errhost='';
if ($hostlabel eq "__Master_${$}__") {
$errhost=$Net::FullAuto::FA_Core::local_hostname;
} else { $errhost=$hostlabel }
my $lv_errmsg=$growoutput
."\n\n read timed-out for command :"
."\n\n -> $live_command"
."\n\n invoked on \'$errhost\'"
."\n\n Current Timeout "
."Setting is -> $cmtimeout seconds.\n\n";
$self->{_cmd_handle}->timeout($svtimeout);
if ($wantarray) {
die $lv_errmsg;
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
} elsif (select
$ready=${${*{$self->{_cmd_handle}}}{net_telnet}}{fdmask},
'', '', $select_timeout) {
alarm($select_timeout+10);
sysread $self->{_cmd_handle},$output,
${${*{$self->{_cmd_handle}}}{net_telnet}}{blksize},0;
alarm(0);
print $Net::FullAuto::FA_Core::MRLOG
"INFO: Got past the Timeout Alarm; at Line ".__LINE__."\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$output=~s/[ ]*\015//g;
$output=~tr/\0-\11\13-\37\177-\377//d;
print $Net::FullAuto::FA_Core::MRLOG
"\nCMD RAW OUTPUT: ==>$output<== at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\nCMD RAW OUTPUT: ==>$output<== at Line ",
__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
$first=1 if $first==0;
if (!$firstout) {
$firstout=1;
if ($output=~/^\s*$cmd_prompt$/) {
print "INFO: Got PROMPT - $cmd_prompt; ".
"Setting \$firstout=1 and next FETCH\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
next;
} else {
print "INFO: Setting \$firstout=1 and CONTINUING\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
}
}
if ($first<0) {
print "\nOUTPUT BEFORE NEW LINE ENCOUNTERED: ",
"==>$output<== :\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nOUTPUT BEFORE NEW LINE ENCOUNTERED: ==>$output<== :",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($appendout) {
$output="$appendout$output";
$appendout='';
}
$test_stripped_output.=$output;
$test_stripped_output=~s/\s*//gs;
my $stripped_live_command=$live_command;
$stripped_live_command=~s/\s*//gs;
my $lslc=length $stripped_live_command;
my $ltso=length $test_stripped_output;
if (($test_stripped_output eq $stripped_live_command) ||
(($lslc<$ltso) &&
(substr($test_stripped_output,-$lslc) eq
$stripped_live_command))) {
print "\nSTRIPPED OUTPUT equals STRIPPED LIVE COMMAND",
" at Line ",__LINE__,"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nSTRIPPED OUTPUT equals STRIPPED LIVE COMMAND",
" at Line ",__LINE__,"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$command_stripped_from_output=1;
$output='';
$first=0;next;
} elsif ($output=~/\n/s) {
print "\nNNNNNNN OUTPUT HAS NEW LINE CHAR NNNNNNN ".
"RAW OUTPUT: ==>$output<== ".
"\n\n TEST_STRIPPED_OUTPUT=$test_stripped_output".
"\n\n STRIPPED_LIVE_COMMAND=$stripped_live_command".
"\n\n at Line ",__LINE__,"\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nNNNNNNN OUTPUT HAS NEW LINE CHAR NNNNNNN RAW ".
"OUTPUT: ==>$output<== ".
"\n\n TEST_STRIPPED_OUTPUT=$test_stripped_output".
"\n\n STRIPPED_LIVE_COMMAND=$stripped_live_command".
"\n\n at Line ",__LINE__,"\n"
if $Net::FullAuto::FA_Core::log &&
(-1<index $Net::FullAuto::FA_Core::MRLOG,'*') &&
$loop_count<$loop_max;
die 'logout' if $output=~/imed out/s
|| $output=~/logout$|closed\.$/mg;
my $last_line='';
$output=~/^.*\n(.*)$/s;
$last_line=$1;
$last_line||='';
my $ptest=substr($output,(rindex $output,'|'),-1);
$ptest=~s/\s*//g;$ptest||='';
if ($last_line && ($last_line=~/$cmd_prompt$/s
|| $bckgrd)) {
print "LAST_LINE=$last_line and OUTPUT=$output<=\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "LAST_LINE=$last_line and OUTPUT=$output<=\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print $Net::FullAuto::FA_Core::MRLOG "LSLC=$lslc and LTSO=$ltso and UNPACK=",unpack("a$lslc",$test_stripped_output)," and STIPPEDLIVECMD=$stripped_live_command\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (($lslc<$ltso) &&
(unpack("a$lslc",$test_stripped_output) eq
$stripped_live_command)) {
print $Net::FullAuto::FA_Core::MRLOG "LSLC_in=$lslc and LTSO_in=$ltso and UNPACK=",unpack("a$lslc",$test_stripped_output),"_in and STIPPEDLIVECMD_in=$stripped_live_command\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $llc=length $live_command;
my $oup=unpack("a$llc",$output);
if ($oup ne $live_command) {
print $Net::FullAuto::FA_Core::MRLOG "OUPPPPPPPPPPPP=$oup\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $o=$output;my $c=0;
while (1) {
last if $c++==5;
$o=~s/^(.*?)\n(.*)$/$1$2/s;
print $Net::FullAuto::FA_Core::MRLOG "ONNNNNNNNNN=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $op=unpack("a$llc",$o);
print $Net::FullAuto::FA_Core::MRLOG "OPPPPPPPPPPP=$op<== and LC=$live_command<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($op eq $live_command) {
print $Net::FullAuto::FA_Core::MRLOG "OOOOOOOOOOOO=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$op=unpack("x$llc a*",$o);
$output=$op;last;
}
}
} else {
$output=unpack("x$llc a*",$output);
}
$first=0;$growoutput=$output;
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;
print $Net::FullAuto::FA_Core::MRLOG "GRO_OUT_AFTER_MEGA_STRIP=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*');
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
$growoutput=$output;
$output='';
$command_stripped_from_output=1;
}
$output='';
} elsif (($lslc<$ltso) &&
(-1<index $test_stripped_output,
$stripped_live_command)) {
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
$growoutput=$output;
$output='';
#$growoutput
# =~s/^.*$live_command(.*)$cmd_prompt$/$1/s;
$command_stripped_from_output=1;
}
$output='';
} elsif ((-1<index $output,'stdout:') &&
$output=~s/^\s*(stdout.*
\n$cmd_prompt)$/$1/sx) {
&display($output,$cmd_prompt,$save)
if $display;
$growoutput.=$output;$output='';
print $Net::FullAuto::FA_Core::MRLOG "FIRST_EIGHT_AND_A_HALF\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=0;
} else {
my $tsst=unpack("a$lslc",$test_stripped_output);
print $Net::FullAuto::FA_Core::MRLOG "FIRST_NINE and 1=$lslc and 2=$ltso and ",
"ONE=$tsst<== and TWO=$stripped_live_command<==",
"(ONE SHOULD EQ TWO but didn't)\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
&display($last_line,$cmd_prompt,$save)
if $display;
$first=0;$growoutput.=$last_line;
$growoutput=~s/^.*($cmd_prompt)$/$1/s;
$output='';
}
} elsif ($ptest eq
"|sed-e's/^/stdout:/'2>&1") {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_TEN\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=0;next;
} elsif (unpack('a7',$output) eq 'stdout:') {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_ELEVEN\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=0;
} else {
print $Net::FullAuto::FA_Core::MRLOG "HERE WE ARE AT A PLACE3 and GO=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
$appendout=$output;next
}
if (!$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug) {
print "WE DID NOTHING TO STDOUT - $output\n";#sleep 2;
}
print $Net::FullAuto::FA_Core::MRLOG "WE DID NOTHING TO STDOUT - $output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#open(BK,">brianout.txt");
#print BK "$output";
#CORE::close BK;
#print "OPUT=$output<== and ",`od -a brianout.txt`,"\n";
#unlink "brianout.txt";
#open(BK,">brianout.txt");
#print BK "$lv_cmd";
#CORE::close BK;
#print "LV_CMD=$lv_cmd<== and ",`od -a brianout.txt`,"\n";
#unlink "brianout.txt";
#print "EXAMINERR=>OPUT=$output<= and LV_CMD=$lv_cmd<=\n";
} else { $appendout=$output;next }
}
print $Net::FullAuto::FA_Core::MRLOG "PAST THE ALARM3\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "OUTPUT ***After First-Line Loop***=$output<== and COMSTROUT=$command_stripped_from_output and GROWOUTPUT=$growoutput<==\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;
print $Net::FullAuto::FA_Core::MRLOG "OUTPUTNOWWWWWWWWWWW=$output<== and STRIPPED=$command_stripped_from_output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($command_stripped_from_output) {
print $Net::FullAuto::FA_Core::MRLOG "GOT STRIPPED_COMMAND_FLAG AND GROWOUTPUT=$growoutput<==\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
my $lcp=length $cmd_prompt;
$lcp+=18;
unless ($growoutput) {
print $Net::FullAuto::FA_Core::MRLOG "NO GROWOUTPUTTTTTTTTTTTTT\n" if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*');
if ($output && unpack('a1',$output) eq '[') {
if ($output=~/^\[A(\[C)+\[K1\s*/s) {
next FETCH;
}
}
if ($output=~/^\s?$cmd_prompt/) {
print $Net::FullAuto::FA_Core::MRLOG
"\nGOT $cmd_prompt AND EMPTY \$growoutput ",
"and OUTPUT ==>$output<==\n",
" at Line ",__LINE__,
" -> DETERMINE FETCH\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $tou=$output;
$tou=~s/^\s?$cmd_prompt\s*//;
my $ltu=length $tou;
$test_stripped_output=$tou;
$test_stripped_output=~s/\s*//gs;
my $stripped_live_command=$live_command;
$stripped_live_command=~s/\s*//gs;
my $lslc=length $stripped_live_command;
my $ltso=length $test_stripped_output;
if (($lslc<$ltso) &&
(unpack("a$lslc",$test_stripped_output) eq
$stripped_live_command)) {
my $llc=length $live_command;
$growoutput=unpack("x$llc a*",$tou);
print $Net::FullAuto::FA_Core::MRLOG "KKKKKKKSSSSSSSSSSSSKKKKKKKK\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=0;$output='';$fulloutput='';
$command_stripped_from_output=1;
if ($growoutput=~/$cmd_prompt$/s) {
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;
chomp($growoutput);
$growoutput.="\n".$cmd_prompt;
$lastline=$cmd_prompt;
} else {
$growoutput='';
next FETCH;
}
} elsif ($output ne $cmd_prompt &&
$output!~/^\s*($cmd_prompt\s*)+$/s) {
print $Net::FullAuto::FA_Core::MRLOG "PPPPPPPPPPPPPPPPPPPPPPPPPPPTOU=$tou and FETCHFLAG=$fetchflag\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=-1;
$fulloutput='';
$command_stripped_from_output=0;
$appendout=$tou;
$fetchflag=1;
next FETCH;
} last FETCH;
} elsif (-1<index $output,'Connection reset by peer') {
$fullerror.=$output;
last FETCH;
} elsif ($output=~/^\s?$/) {
next FETCH;
} elsif ($output=~/^(stdout: .*)$cmd_prompt$/) {
$growoutput=$1."\n".$cmd_prompt;
$lastline=$cmd_prompt;
$output='';$fulloutput='';
} elsif ($fetchflag) {
print $Net::FullAuto::FA_Core::MRLOG "FETCHFLAGGGGGGGGGG=$fetchflag\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$growoutput.=$output;
next FETCH
}
} elsif (($output=~/^stdout: (?!\/')/) &&
($growoutput=~/ 2\>&1\s?$/)) {
$growoutput=$output;
next FETCH if $output!~/$cmd_prompt$/s;
$output='';$fulloutput='';
} elsif ($growoutput && $output eq $cmd_prompt) {
chomp $growoutput;
$growoutput.="\n".$cmd_prompt;
$lastline=$cmd_prompt;
$output='';$fulloutput='';
} elsif ($output=~/$cmd_prompt$/s) {
$growoutput.=$output;
$lastline=$cmd_prompt;
$output='';$fulloutput='';
} elsif (unpack("a$lcp",$output) eq
$cmd_prompt.'cmd /Q /C "set /A ') {
$lastline=$cmd_prompt;
$output='';$fulloutput='';
}
} elsif ($output eq 'Connection closed') {
if ($wantarray) {
return 0,$output;
} else {
&Net::FullAuto::FA_Core::handle_error($output)
}
} elsif ($output eq '>') {
if (substr($growoutput,-1) eq '2') {
$growoutput.=$output;
$first=-1;
next FETCH;
}
my $die="The Command:\n\n $command"
."\n\nHas a Syntax Error. The Command "
."Shell\n Entered Interacive Mode '>'";
if ($wantarray) {
return 0,$die;
} else {
&Net::FullAuto::FA_Core::handle_error($die)
}
}
$output=~s/^[ |\t]+(stdout:.*)$/$1/m if !$fullerror;
&display($output,$cmd_prompt,$save)
if $display;
$growoutput.=$output;
#if ($Net::FullAuto::FA_Core::debug) {
#open(BK,">brianout.txt");
#print BK "$growoutput";
#CORE::close BK;
#print "OD_GROWOUTPUT=$growoutput<== and ",`od -a brianout.txt`,"\n";
#unlink "brianout.txt";
#}
$test_out="\$growoutput";
if (!$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug) {
print "THISEVALLL=",($test_out=~/$cmd_prompt$/s),
" and OUT=$output and CMD_PROMPT=$cmd_prompt\n";
}
if (15<length $growoutput &&
unpack('a16',$growoutput) eq '?Invalid command') {
$self->{_cmd_handle}->timeout($svtimeout);
&Net::FullAuto::FA_Core::handle_error(
"?Invalid Command ftp> -> $live_command");
} elsif (-1<index lc($growoutput),'killed by signal 15') {
die 'Connection closed';
} elsif ((-1==index $growoutput,'stdout:') &&
(-1<index $growoutput,' sync_with_child: ')) {
&Net::FullAuto::FA_Core::handle_error(
$growoutput,'__cleanup__');
} elsif (1<($growoutput=~tr/\n//) ||
$growoutput=~/($cmd_prompt)$/s) {
my $oneline=$1;$oneline||=0;
($lastline=$growoutput)=~s/^.*\n(.*)$/$1/s;
print "NOWLASTLINE=$lastline<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "NOWLASTLINE=$lastline<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($lastline eq $growoutput &&
$growoutput=~/$cmd_prompt$/s
&& (length $growoutput<7 ||
unpack('a7',$growoutput) ne 'stdout:')) {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_THIRTEEN\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=0;
$growoutput='';
} else {
if ($growoutput=~/$cmd_prompt/s) {
print "GROWOUTPUT2=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "GROWOUTPUT2=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
if ($growoutput=~/stdout: PS1=/m) {
($lastline=$growoutput)=~s/^.*\n(.*)$/$1/s;
} elsif ($growoutput=~s/^\n*$cmd_prompt\n*//s) {
my $test_stripped_output=$growoutput;
my $stripped_live_command=$live_command;
$stripped_live_command=~s/\s*//gs;
my $testgrow=$test_stripped_output;
$testgrow=~s/^(.*?2>&1\n?)(.*)$/$1/s;
my $thisout=$2;
$testgrow=~s/\s*//gs;
if ($testgrow eq $stripped_live_command) {
$growoutput=$thisout;
}
last FETCH if !$growoutput &&
$live_command=~/^cd /;
next FETCH if !$growoutput;
if (-1<index $growoutput,'stdout: /') {
my $stub=substr($growoutput,0,
(index $growoutput,'stdout: /'));
if (substr($live_command,0,(length $stub))
eq $stub) {
my $go=$growoutput;
$growoutput=substr($go,(length $stub));
}
} elsif ((-1<index $live_command, $growoutput) &&
(substr($live_command,0,
(length $growoutput)) eq $growoutput)) {
$growoutput='';next FETCH;
}
if ($growoutput) {
if ($growoutput=~/^\s*$cmd_prompt$/s) {
$growoutput='';
last FETCH;
} elsif ($growoutput!~/$cmd_prompt$/) {
next FETCH;
}
}
print "CLEANEDGROWOUT=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;
print $Net::FullAuto::FA_Core::MRLOG "CLEANEDGROWOUT=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
}
} elsif (!$lastline) {
my $tmp_grow=$growoutput;
chomp $tmp_grow;
($lastline=$tmp_grow)=~s/^.*\n(.*)$/$1/s;
$lastline.="\n";
}
my $l=length $live_command;
if ($first<0) {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FOURTEEN and GROW=$growoutput<===\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
if ($growoutput=~/2\s*>\s*&1\s*$/s) {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FOURTEENa\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=0;$growoutput='';
$output='';
} elsif ($oneline) {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FOURTEENb\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($growoutput=~s/^$live_command//) {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FOURTEENc\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=0;
}
} else {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FOURTEENd\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$growoutput=~s/^(.*?)\012//s;
my $f_line=$1;
if ($f_line=~/[2]\s*[>]\s*[&][1]\s*$/s) {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FOURTEENe\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$first=0;
}
}
} elsif ($command_stripped_from_output==0) {
print $Net::FullAuto::FA_Core::MRLOG "FIRST_TEENeeee and GO=$growoutput\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $test_stripped_output=$growoutput;
$test_stripped_output=~s/\s*//gs;
my $stripped_live_command=$live_command;
$stripped_live_command=~s/\s*//gs;
my $lslc=length $stripped_live_command;
my $ltso=length $test_stripped_output;
print $Net::FullAuto::FA_Core::MRLOG "TEEN1=",substr($test_stripped_output,-$lslc),"<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print $Net::FullAuto::FA_Core::MRLOG "TEEN2=$stripped_live_command<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (($lslc<$ltso) &&
(unpack("a$lslc",$test_stripped_output) eq
$stripped_live_command)) {
print $Net::FullAuto::FA_Core::MRLOG "LSLC_TEEN=$lslc and LTSO_TEEN=$ltso and UNPACK=",unpack("a$lslc",$test_stripped_output),"_TEEN and STIPPEDLIVECMD_TEEN=$stripped_live_command\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*
';
my $llc=length $live_command;
my $oup=unpack("a$llc",$output);
if ($oup ne $live_command) {
print $Net::FullAuto::FA_Core::MRLOG "OUPPPPPPPPPPPPTTTTTTT=$oup\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $o=$output;my $c=0;
while (1) {
last if $c++==5;
$o=~s/^(.*?)\n(.*)$/$1$2/s;
print $Net::FullAuto::FA_Core::MRLOG "ONNNNNTTTT=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $op=unpack("a$llc",$o);
print $Net::FullAuto::FA_Core::MRLOG "OPPPPPPTTTTP=$op<== and LC=$live_command<==\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($op eq $live_command) {
print $Net::FullAuto::FA_Core::MRLOG "OOOOOOOOTTTT=$o\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$op=unpack("x$llc a*",$o);
$output=$op;last;
}
}
} else {
$output=unpack("x$llc a*",$output);
}
$first=0;$growoutput=$output;
$growoutput=~s/^(.*)($cmd_prompt)*$/$1/s;
print $Net::FullAuto::FA_Core::MRLOG "GRO_OUT_AFTER_MEGA_STRIPTTTTTTTTTT=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*');
$command_stripped_from_output=1;
if ($output=~/$cmd_prompt$/s &&
$growoutput!~/$cmd_prompt$/s) {
$growoutput=$output;
$lastline=$cmd_prompt;
} else {
next FETCH;
}
}
#if (substr($test_stripped_output,-$lslc) eq
# $stripped_live_command) {
# my @slc=split '',$stripped_live_command;
# my @gop=split '',$growoutput;
# GS: foreach my $s (shift @slc) {
# my $g=shift @gop;
# my $c=0;
# while (1) {
# if ($g eq $s) {
# next GS;
# } elsif (-1<$#gop) {
# $g=shift @gop;
# } last if $c++==100;
# }
# }
# $growoutput=join '', @gop;
print $Net::FullAuto::FA_Core::MRLOG "FIRST_FifTEENe and GO=$growoutput\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
# $command_stripped_from_output=1;
# next FETCH;
#}
}
}
#print "DONE TRIMMING GROWOUTPUT=$growoutput\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
#print $Net::FullAuto::FA_Core::MRLOG "DONE TRIMMING GROWOUTPUT=$growoutput<==\n".
# "and FULLOUT=$fulloutput<==\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($growoutput) {
if ($wantarray) {
my @strings=split /^/, $growoutput;
my $str_cnt=$#strings;
foreach my $line (@strings) {
print "LETS LOOK AT LINE=$line<== and LASTLINE=$lastline<==\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;
print $Net::FullAuto::FA_Core::MRLOG "LETS LOOK AT LINE=$line<== and LASTLINE=$lastline<==\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
if ($line ne $lastline || 0<$str_cnt) {
$str_cnt--;
if ($line=~s/^stdout: ?//) {
$fulloutput.=$line;
$errflag='';
} elsif (($line!~/^\[[AK]$|^\n$/s &&
$line ne $live_command &&
$line!~/\s-e\s\'s\/\^\/stdout
\:\s*\/\'\s2\>\&1\s*$/sx) ||
($fullerror && $line=~/^\n$/s)) {
#print "DOIN FULLERROR1==>$line<== and STRCNT=$str_cnt\n";# if $Net::FullAuto::FA_Core::debug;
#print $Net::FullAuto::FA_Core::MRLOG "DOIN FULLERROR1==>$line<==\n"
# if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (!$line) {
my $lastDB43=0;my $testline='';
DB43: while (1) {
print $Net::FullAuto::FA_Core::MRLOG "WE ARE INSIDE DB43\n";
$self->{_cmd_handle}->autoflush(1);
$self->{_cmd_handle}->print("echo FAECHO");
eval {
while (my $line=$self->{_cmd_handle}->get) {
$line=~tr/\0-\11\13-\37\177-\377//d;
($testline=$line)=~s/\s//g;
print "DB43output=$testline<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "DB43output=$testline<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($testline=~/^$cmd_prompt$/) {
$lastDB43=1;last
}
if ($testline=~s/$cmd_prompt$//s) {
$line=~s/$cmd_prompt$//s;
$output.=$line;last;
} else { $output.=$line }
}
#print "DONEWITHDB43WILE and OUTPUTNOW=$output\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "DONEWITHDB43WHILE and OUTPUTNOW=$output\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}; $self->{_cmd_handle}->autoflush(0);
last if $lastDB43;
if ($@) {
if (-1<index $@,'read timed-out') {
next;
} else { die "$@ $!" }
}
}
my $tst_out=$output;
$tst_out=~s/\s*//gs;
print "TST_OUTTTTT=$tst_out<==\n";
print $Net::FullAuto::FA_Core::MRLOG "TST_OUTTTT=$tst_out<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
if ($fullerror && !$errflag) {
$fullerror.="\n";
} $errflag=1;
$fullerror.=$line;
&display($line,$cmd_prompt,$save)
if $display;
} elsif ($fulloutput || $line!~/^\s*$/s) {
$fulloutput.=$line;
&display($line,$cmd_prompt,$save)
if $display;
$errflag='';
}
}
}
} elsif ($fulloutput || $line!~/^\s*$/s) {
print "HOW OFTEN IS FULL GETTINNG IT?=$loop_count\n";
$fulloutput.=$growoutput;
}
}
print "GROW_ADDED_TO_FULL=$growoutput<==\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug && $loop_count<$loop_max;
print $Net::FullAuto::FA_Core::MRLOG "GROW_ADDED_TO_FULL=$growoutput\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
if ($growoutput) {
if ($log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*') {
print $Net::FullAuto::FA_Core::MRLOG $growoutput if $loop_count<$loop_max;
}
#&display($output,$cmd_prompt,$save) if $display;
}
if ($loop_count<$loop_max) {
my $lcntt=0;my $newline='';
foreach my $line (reverse split /^/, $fulloutput) {
$newline=$line.$newline;
last if $lcntt++==5;
}
print $Net::FullAuto::FA_Core::MRLOG "DOIN FULLOUTPUTMAYBE==>$newline<==",
" and LASTLINE=$lastline<== and CMD_PROMPT=$cmd_prompt<== and FO=$fulloutput<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
if (!$lastline) {
if ($retry++<3) {
my $forcedoutput='';
DB18: while (1) {
if ($retry<2) {
$self->{_cmd_handle}->print;
} else {
print "THIRTEEN003\n";
$self->{_cmd_handle}->print("\003");
}
my $oline='';
while (my $line=$self->{_cmd_handle}->get) {
$oline=$line;
$line=~s/\s//g;
last DB18 if $line=~/^$cmd_prompt$/;
$forcedoutput.=$oline;
last if $line=~/$cmd_prompt$/s;
}
} $forcedoutput||='';
$forcedoutput=~s/^$cmd_prompt$//gm;
foreach my $line (split /^/, $forcedoutput) {
if ($line=~s/^stdout: ?// &&
($fulloutput || $line!~/^\s*$/s)) {
$fulloutput.=$line;
&display($line,$cmd_prompt,$save)
if $display;
$errflag='';
} elsif ($line!~/^\s*$/ &&
$line ne "$live_command\n" &&
$line ne " -e 's/^/stdout:/' 2>&1\n"
|| $fullerror && $line=~/^\n$/s) {
print "DOIN FULLERROR2222==>$line<==\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "DOIN FULLERROR2222==>$line<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($fullerror && !$errflag) {
$fullerror.="\n";
} $errflag=1;
$fullerror.=$line;
if ($fullerror) {
if ($log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*') {
print $Net::FullAuto::FA_Core::MRLOG $fullerror;
}
&display($line,$cmd_prompt,$save)
if $display;
}
}
}
if ($ms_cmd) {
$stdout=$fullerror;
} else {
$stdout=$fulloutput;
$stderr=$fullerror;
}
chomp $stdout if $stdout;
chomp $stderr if $stderr;
last FETCH;
}
my $warng="\n WARNING! The Command\n\n"
." ==>$live_command\n\n "
."Appears to be Hanging\,in an "
."Infinite Loop\,\n or Stopped.\n"
." Press <CTRL>-C to Quit.\n\n";
print $Net::FullAuto::FA_Core::MRLOG $warng
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (exists $email_defaults{Usage} &&
lc($email_defaults{Usage}) eq
'notify_on_error') {
my $subwarn="WARNING! Command Appears "
."to be Hanging or Stopped";
my %mail=(
'Body' => "$warng",
'Subject' => "$subwarn"
);
&Net::FullAuto::FA_Core::send_email(\%mail);
}
if ($ms_cmd) {
$stdout=$fullerror;
} else {
$stdout=$fulloutput;
$stderr=$fullerror;
}
chomp $stdout if $stdout;
chomp $stderr if $stderr;
last;
} elsif (-1<index $lastline, $cmd_prompt) {
print "WE HAVE LASTLINE CMDPROMPT AND ARE GOING TO EXIT and FO=$fulloutput and MS_CMD=$ms_cmd<==\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
$stdout=$fulloutput;
$stderr=$fullerror;
chomp $stdout if $stdout;
chomp $stderr if $stderr;
last;
} elsif ($lastline=~/^\s*$/) {
$growoutput.=$lastline;
} elsif (!$command_stripped_from_output) {
$growoutput=$lastline;
}
print $Net::FullAuto::FA_Core::MRLOG "GRO_GONNA_LOOP==>$growoutput<==\n"
if $Net::FullAuto::FA_Core::log && (-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
$starttime=0;$select_timeout=0;
} else {
$starttime=time();$select_timeout=$cmtimeout;
$restart_attempt=1;
}
$command_stripped_from_output=1;
print $Net::FullAuto::FA_Core::MRLOG "PAST THE ALARM4\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print $Net::FullAuto::FA_Core::MRLOG "GRO_OUT AT THE BOTTOM==>$growoutput<==\n"
if $Net::FullAuto::FA_Core::log &&
(-1<index $Net::FullAuto::FA_Core::MRLOG,'*') && $loop_count<$loop_max;
} elsif ($starttime && (($cmtimeout<time()-$starttime)
|| ($select_timeout<time()-$starttime))) {
#print $Net::FullAuto::FA_Core::MRLOG "ELSFI AT THE BOTTOM==>$growoutput<==\n";
if (!$restart_attempt) {
print "FOURTEEN003\n";
$self->{_cmd_handle}->print("\003");
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self->{cmd_handle});
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my $lv_errmsg="read timed-out for command :"
."\n\n -> $live_command"
."\n\n invoked on \'$hostlabel\'"
."\n\n Current Timeout "
."Setting is -> $cmtimeout seconds.\n\n";
$self->{_cmd_handle}->timeout($svtimeout);
if ($wantarray) {
die $lv_errmsg;
} else {
&Net::FullAuto::FA_Core::handle_error($lv_errmsg)
}
} else {
$restart_attempt=0;
$starttime=time();$select_timeout=$cmtimeout;
$self->{_cmd_handle}->print;
}
} elsif (!$starttime) {
$starttime=time();$select_timeout=$cmtimeout;
$restart_attempt=1;
}
}
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEE\n";
$stderr=$lastline if $lastline=~/Connection to.*closed/s;
print $Net::FullAuto::FA_Core::MRLOG "cmd() STDERRBOTTOM=$stderr<== and LASTLINE=$lastline<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($stderr!~s/^\s*$//s && $stderr ne '_funkyPrompt_') {
chomp($stderr);
&Net::FullAuto::FA_Core::handle_error($stderr) if !$wantarray;
}
$stderr='' if $stderr eq '_funkyPrompt_';
}
};
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEXXXXXXXXXXX\n";
$self->{_cmd_handle}->autoflush(0)
if defined fileno $self->{_cmd_handle};
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEUUUUUUUUUUU\n";
my $eval_error='';
if ($@) {
print "\nEEEEEEE *just thrown* EEEEEEE RAW ERROR: $@".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Contents of \$stderr if any (raw error could be different):".
"\n $stderr\n".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nEEEEEEE *just thrown* EEEEEEE RAW ERROR: $@".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Contents of \$stderr if any (raw error could be different):".
"\n $stderr\n".
(join ' ',@topcaller)."\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$eval_error=$@;undef $@;
}
if ($ftp) {
$self->{_ftp_handle}->timeout($svtimeout);
} else {
$self->{_cmd_handle}->timeout($svtimeout);
}
$eval_error=$stderr if $stderr && !$eval_error;
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEOOOOOOOOOOOOO\n";
if ($eval_error) {
chomp($eval_error=~tr/\0-\11\13-\37\177-\377//d);
$eval_error=~s/^\s+//;
print $Net::FullAuto::FA_Core::MRLOG
"\n",(caller(2))[3]," CLEANED (eval) ERROR:\n ",
"==>$eval_error<==",
"\n at Line ",__LINE__,"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "\n",(caller(2))[3]," CLEANED (eval) ERROR:\n ",
"==>$eval_error<==",
"\n at Line ",__LINE__,"\n\n"
if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
&Net::FullAuto::FA_Core::release_semaphore($sem) if $sem;
if ((-1<index $command,"kill ") &&
(-1<index $eval_error,"eof")) {
my $prc=substr($command,-3);
if ($wantarray) {
return "process \#$prc killed","";
} else { return "process \#$prc killed" }
} $login_retry++;
print $Net::FullAuto::FA_Core::MRLOG "LOGINRETRY=$login_retry and ",
"ERROR=$eval_error<== and FTP=$ftp and NOTRAP=$notrap\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ((-1<index $eval_error,'logout') ||
(-1<index $eval_error,'Connection closed')
&& !$login_retry && !$cleanup) {
print $Net::FullAuto::FA_Core::MRLOG "MADE IT TO LOGOUT ERROR HANDLING\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $sav_self=$self->{_cmd_handle};
my $curdir=$self->{_work_dirs}->{_cwd}
|| $self->{_work_dirs}->{_cwd_mswin};
print $Net::FullAuto::FA_Core::MRLOG "CURDIR=$curdir\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill($self->{_cmd_pid},$kill_arg) if
&Net::FullAuto::FA_Core::testpid($self->{_cmd_pid});
$self->{_cmd_handle}->close;
if (!exists $same_host_as_Master{$self->{_hostlabel}->[0]}) {
($self,$stderr)=&Net::FullAuto::FA_Core::connect_host(
$self->{_hostlabel}->[0],$cmtimeout);
} else {
($self,$stderr)=
Rem_Command::new('Rem_Command',
"__Master_${$}__",'__new_master__',
$self->{_connect});
}
print $Net::FullAuto::FA_Core::MRLOG "GOT NEW SELF=$self and CURDIR=$curdir\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$self->cwd($curdir);
CH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($sav_self
eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
my $value=$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
delete $Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type};
substr($type,0,3)='cmd';
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}=
$value;
last CH;
}
}
}
} next if $self;
} elsif (!$ftp && !$login_retry && !$notrap && !$cleanup
&& (-1==index $eval_error,'space in the')) {
print "\nrrrrrrr RECOVERING rrrrrrr from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Attempting to retrieve new handle with &login_retry()\n".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nrrrrrrr RECOVERING rrrrrrr from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Attempting to retrieve new handle with &login_retry()\n".
(join ' ',@topcaller)."\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $save_cwd='';
if (exists $self->{_work_dirs}->{_cwd_mswin}
&& $self->{_work_dirs}->{_cwd_mswin}=~/^\\\\/) {
$save_cwd=$self->{_work_dirs}->{_tmp}||'';
} else {
$save_cwd=$self->{_work_dirs}->{_cwd}||'';
}
print $Net::FullAuto::FA_Core::MRLOG
"WHAT HANDLE IS GOING INTO LOGIN_RETRY???=$self->{_cmd_handle}\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($self->{_cmd_handle},$eval_error)=
&login_retry($self->{_cmd_handle},
$self->{_connect},
$self->{_cmd_type},$eval_error);
print $Net::FullAuto::FA_Core::MRLOG
"WHAT HANDLE COMES BACK FROM LOGIN_RETRY???=",
"$self->{_cmd_handle} AND LOGIN_RETRY=$login_retry\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($self->{_cmd_handle}) {
print "\nrrrrrrr RECOVERING rrrrrrr from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Attempting to use new handle to change to saved cwd:".
"\n $save_cwd".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nrrrrrrr RECOVERING rrrrrrr from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
"\n Attempting to use new handle to change to saved cwd:".
"\n $save_cwd".
(join ' ',@topcaller)."\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
($output,$stderr)=$self->cwd($save_cwd);
print $Net::FullAuto::FA_Core::MRLOG "WHAT IS CWD SAVE_CWD STDERR OUTPUT=$stderr<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($stderr && (-1==index $stderr,'command success')) {
if (wantarray) {
return '',$eval_error;
} else { &Net::FullAuto::FA_Core::handle_error($eval_error) }
} else {
print "\nRRRRRRR recovered RRRRRRR from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
(join ' ',@topcaller)."\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nRRRRRRR recovered RRRRRRR from ERROR: $eval_error".
"\n at Line ",__LINE__,"\n ".
"\n Running cmd: $command\n".
(join ' ',@topcaller)."\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
next
}
}
}
print $Net::FullAuto::FA_Core::MRLOG "LOGINRETRY2=$login_retry and ",
"ERROR=$eval_error<== and FTP=$ftp and NOTRAP=$notrap\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($wantarray) {
print $Net::FullAuto::FA_Core::MRLOG "WE ARE RETURNING ERROR=$eval_error\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
$stdout||='';
return $stdout,$eval_error;
} else { &Net::FullAuto::FA_Core::handle_error($eval_error) }
}
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEEMMMMMMMMMM\n";
pop @FA_Core::pid_ts if $pid_ts;
$stdout||='';$stderr||='';
&Net::FullAuto::FA_Core::release_semaphore($sem) if $sem;
print $Net::FullAuto::FA_Core::MRLOG "DO WE EVER REALLY GET HERE? ".
"and STDOUT=$stdout<== and STDERR=$stderr<==\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#print "DO WE GET HEREEEEEEEEEEEEEEEEEEEEEEENNNNNNNNNN\n";
if ($wantarray) {
return $stdout,$stderr;
} else { return $stdout }
}
}
sub display
{
#print "DISPLAY_CALLER=",caller,"\n";
my $line=$_[0];
my $cmd_prompt=$_[1];
my $save=$_[2];
######## CHANGED LINE BELOW AND ADDED THE ? AFTER stdout: ? 080107
$line=~s/^stdout: ?//mg;
if (length $line<length $cmd_prompt) {
if (-1<index $cmd_prompt,substr($line,(rindex $line,'_'))) {
$save.=$line;
return $save;
} else {
$save='';
print $line;
return $save;
}
} elsif ($line=~s/\n*$cmd_prompt//gs) {
$save='';
print $line;
return $save;
} elsif (-1<index $cmd_prompt,substr($line,(rindex $line,'_'))) {
$save.=$line;
return $save;
} else {
$save='';
print $line;
return $save;
}
}
sub login_retry
{
my @topcaller=caller;
print "\nINFO: Rem_Command::login_retry() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nRem_Command::login_retry() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self=$_[0];my $_connect=$_[1];
my $cmd_type=$_[2];my $error=$_[3];
my $sid='';my $hostlabel='';
if ($self eq $localhost->{_cmd_handle}) {
$hostlabel=$localhost->{_hostlabel}->[0];
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,
$localhost->{_connect});
$sid=($su_id)?$su_id:$login_id;
} else {
LR: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $slid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$slid}}) {
if ($self eq ${$Net::FullAuto::FA_Core::Processes{$hlabel}{$slid}{$type}}[0]) {
$hostlabel=$hlabel;$sid=$slid;
last LR;
}
}
}
}
}
#print "ONEEE=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"},"\n";
#print "TWOOO=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"}->{_work_dirs},"\n";
#print "LOGINRETRYHOSTLABEL=$hostlabel<== and SID=$sid<== and CWD=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"}->{_work_dirs}->{_cwd},"\n";
#print $Net::FullAuto::FA_Core::MRLOG "LOGINRETRYHOSTLABEL=$hostlabel<== and SID=$sid<== and CWD=",$Net::FullAuto::FA_Core::Connections{"${hostlabel}__%-$sid"}->{_work_dirs}->{_cwd},"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $new_handle='';my ($stdout,$stderr)=('','');
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$sdtimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel);
print $Net::FullAuto::FA_Core::MRLOG "WHAT IS THE ERROR=$error\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ((-1<index $error,'filehandle isn') ||
(-1<index $error,'read error') ||
(-1<index $error,'Connection closed') ||
!defined fileno $self) {
print $Net::FullAuto::FA_Core::MRLOG "WE ARE GETTING NEW HANDLE\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $handleid="$self";
$self->autoflush(1);
$self->close;
my $kill_arg=($^O eq 'cygwin')?'f':9;
KFH: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (
keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($handleid eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
print "THISKILL2=${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[2]\n";
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[2],$kill_arg) if
&Net::FullAuto::FA_Core::testpid(${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[2]);
($stdout,$stderr)=&Net::FullAuto::FA_Core::kill(${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[1],$kill_arg) if
&Net::FullAuto::FA_Core::testpid(${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[1]);
print "THISKILL1=${$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type}}[1]\n";
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}{$type};
last KFH;
}
}
}
}
($new_handle,$stderr)=&Net::FullAuto::FA_Core::connect_cmdX($hostlabel,$timeout);
print $Net::FullAuto::FA_Core::MRLOG "NEW HANDLE=$new_handle and STDERR=$stderr\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($stderr) {
if (wantarray) { return '',$stderr }
else { &Net::FullAuto::FA_Core::handle_error($stderr,'-3') }
} $self->close;
RL: foreach my $hlabel (keys %Net::FullAuto::FA_Core::Processes) {
foreach my $sid (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}}) {
foreach my $type (keys %{$Net::FullAuto::FA_Core::Processes{$hlabel}
{$sid}}) {
if ($self eq ${$Net::FullAuto::FA_Core::Processes
{$hlabel}{$sid}{$type}}[0]) {
delete
$Net::FullAuto::FA_Core::Processes{$hlabel}{$sid}{$type};
last RL;
}
}
}
}
#if (-1<index $new_handle->{_cmd_handle},'HASH') {
# return $new_handle->{_cmd_handle}->{_cmd_handle},'';
#} else { return $new_handle->{_cmd_handle},'' }
return $new_handle->{_cmd_handle},'';
} elsif ($^O ne 'cygwin' && $su_id) {
$self->print;
my $id='';
($id,$stderr)=&Net::FullAuto::FA_Core::unix_id($self,$su_id,
$hostlabel,$error);
print $Net::FullAuto::FA_Core::MRLOG "GOT NEW UNIX ID=$id and STDERR=$stderr and SU_ID=$su_id\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print "GOT NEW UNIX ID=$id and STDERR=$stderr and SU_ID=$su_id\n";
return '',$error if $stderr;
if ($id eq $su_id) {
if (wantarray) { return '',$error }
else { &Net::FullAuto::FA_Core::handle_error($error,'-3') }
} else {
my $cfh_ignore='';my $cfh_error='';
($cfh_ignore,$cfh_error)=
&Net::FullAuto::FA_Core::clean_filehandle(
$self);
&Net::FullAuto::FA_Core::handle_error($cfh_error,'-1')
if $cfh_error;
my ($ignore,$su_err)=
&Net::FullAuto::FA_Core::su($self,$hostlabel,$login_id,
$su_id,$hostname,$ip,$use,$uname,$_connect,$cmd_type,
[],$error);
print "SU_ERR=$su_err\n" if $su_err;
&Net::FullAuto::FA_Core::handle_error($su_err) if $su_err;
return $self,'';
}
} else { return $self,$error }
}
sub cwd
{
my @topcaller=caller;
print "\nINFO: Rem_Command::cwd() (((((((CALLER))))))):\n ",(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "\nRem_Command::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
return &File_Transfer::cwd(@_);
}
package Bad_Handle;
sub new {
my @topcaller=caller;
print "\nINFO: Bad_Handle::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::new() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $class = ref($_[0]) || $_[0];
my $hostlabel=$_[1];
my $stderr=$_[2];
my $self = { };
my $_connect='';
my ($ip,$hostname,$use,$ms_share,$ms_domain,
$cmd_cnct,$ftr_cnct,$login_id,$su_id,$chmod,
$owner,$group,$fttimeout,$transfer_dir,$rcm_chain,
$rcm_map,$uname,$ping)
=&Net::FullAuto::FA_Core::lookup_hostinfo_from_label($hostlabel,$_connect);
my $host=($use eq 'ip') ? $ip : $hostname;
$self->{_hostlabel}=[ $hostlabel,'' ];
$self->{_hostname}=$hostname;
$self->{_ip}=$ip;
$self->{_uname}=$uname;
$self->{_luname}=$^O;
$self->{_cmd_handle}='';
$self->{_cmd_type}='';
$self->{_stderr}=$stderr;
$self->{_ping}=$ping;
bless($self,$class);
if (wantarray) {
return $self,'';
} else {
return $self;
}
}
sub cmd
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::cmd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub cwd
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::cwd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub select_dir
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::select_dir() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::select_dir() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub get_vlabel
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::get_vlabel() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::get_vlabel() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub ftp
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::ftp() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::ftp() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub get
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::get() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::get() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub put
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::put() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::put() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub lcd
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::lcd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::lcd() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
sub ls
{
my $self=$_[0];
my @topcaller=caller;
print "\nINFO: Bad_Handle::ls() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if !$Net::FullAuto::FA_Core::cron &&
$Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG
"\nBad_Handle::ls() (((((((CALLER))))))):\n ",
(join ' ',@topcaller),"\n\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if (wantarray) {
return '',$self->{_stderr};
} else {
&Net::FullAuto::FA_Core::handle_error($self->{_stderr});
}
}
package Net::FullAuto::MemoryHandle;
use strict;
sub TIEHANDLE {
my $class = shift;
bless [], $class;
}
sub PRINT {
my $self = shift;
push @$self, join '', @_;
}
sub PRINTF {
my $self = shift;
my $fmt = shift;
push @$self, sprintf $fmt, @_;
}
sub READLINE {
my $self = shift;
shift @$self;
}
package Net::FullAuto::FA_DB;
use strict;
use BerkeleyDB;
sub new
{
my $class=shift;
my $self={};
$self->{_dbfile}=shift;
$self->{_dbfile}=~s/\.db$//;
$self->{_host_queried}={};
$self->{_line_queried}={};
bless($self,$class);
}
sub add
{
print "ADDCALLER=",caller,"\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "ADDCALLER=".(caller)."\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self=$_[0];
my $tie_err="can't open tie to $self->{_dbfile}.db";
my $hostlabel=$_[1];
my $line=$_[2];
if (!$line) {
if (wantarray) {
return '','ERROR - no entry specified';
} else {
&Net::FullAuto::FA_Core::handle_error(
"FullAutoDB: ERROR - no entry specified\n");
}
}
my $rx1=qr/\d+\s+\w\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+\w\w\w\s+\d+\s+\d\d\d\d\s+.*/;
$line=~s/^.*\s+($rx1|$rx2)$/$1/;
$line=~/^(\d+)\s+(\w\w\w\s+\d+\s+\S+).*$/;
my $size=$1;my $timestamp=$2;
my $mt='';my $hr=0;my $dy=0;my $mn=0;my $fileyr=0;
eval {
($mn,$dy,$mt)=split /\s+/, $timestamp;
if (-1<index $mt,':') {
($hr,$mt)=split ':', $mt;
$fileyr=(localtime)[5];
} else {
$fileyr=$mt;$mt=0;
}
$timestamp=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$Net::FullAuto::FA_Core::month{$mn}-1,$fileyr);
};
if ($@) {
&Net::FullAuto::FA_Core::handle_error(
"$@ - LSLINE=$line<- AND TIMESTAMP=$timestamp<- AND MN=$mn<-");
}
my $ipc_key="$timestamp$size";
#my $ipc_key=substr($timestamp,-4);
&Net::FullAuto::FA_Core::release_semaphore($ipc_key);
$line="${hostlabel}|%|$line";
${$self->{_host_queried}}{"$hostlabel"}='-';
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n");
my $bdb = BerkeleyDB::Btree->new(
-Filename => "$self->{_dbfile}.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n");
print "ADDING LINE=$line<==\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "ADDING LINE=$line<==\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $status=$bdb->db_put($line,time);
undef $bdb;
$dbenv->close();
undef $dbenv;
${$self->{_line_queried}}{$line}='-';
return 1,'';
}
sub query
{
my @topcaller=caller;
print "FA_DB::query() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "FA_DB::query() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $self=$_[0];
my $tie_err="can't open tie to $self->{_dbfile}.db";
my $hostlabel=$_[1];
my $line=$_[2];
if (!$line) {
if (wantarray) {
return '','ERROR - no query specified';
} else {
&Net::FullAuto::FA_Core::handle_error(
"FullAutoDB: ERROR - no query specified\n");
}
}
#my $logreset=1;
#if ($Net::FullAuto::FA_Core::log) { $logreset=0 }
#else { $Net::FullAuto::FA_Core::log=1 }
print "LINE TO STRIP TIMEINFO=$line\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "LINE TO STRIP TIMEINFO=$line\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $rx1=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d:\d\d\s+.*/;
my $rx2=qr/\d+\s+[JFMASOND]\w\w\s+\d+\s+\d\d\d\d\s+.*/;
$line=~s/^.*\s+($rx1|$rx2)$/$1/;
$line=~/^(\d+)\s+([JFMASOND]\w\w\s+\d+\s+\S+)\s+(.*)$/;
my $size=$1;my $timestamp=$2;my $filename=$3;
my $mt='';my $hr=0;my $dy=0;my $mn=0;my $fileyr=0;
($mn,$dy,$mt)=split /\s+/, $timestamp;
if (-1<index $mt,':') {
($hr,$mt)=split ':', $mt;
$fileyr=(localtime)[5];
} else {
$fileyr=$mt;$mt=0;
}
print $Net::FullAuto::FA_Core::MRLOG "TIMEINFO=> MT=$mt HR=$hr DYX=$dy MN=$mn FY=$fileyr\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
#$Net::FullAuto::FA_Core::log=0 if $logreset;
$timestamp=&Net::FullAuto::FA_Core::timelocal(
0,$mt,$hr,$dy,$Net::FullAuto::FA_Core::month{$mn}-1,$fileyr);
my $ipc_key="$timestamp$size";
$line="${hostlabel}|%|$line";
${$self->{_host_queried}}{$hostlabel}='-';
print "STARTING TIE\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "STARTING TIE\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n");
my $bdb = BerkeleyDB::Btree->new(
-Filename => "$self->{_dbfile}.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n");
print "DONE WITH TIE\n" if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "DONE WITH TIE\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $result=0;
my $dbcopy='';my $status='';
# print the contents of the file
my ($k, $v) = ("", "") ;
my $cursor = $bdb->db_cursor() ;
my %dbcopy=();
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
$dbcopy{$k}=$v;
}
undef $cursor ;
if (exists $dbcopy{$line}) {
${$self->{_line_queried}}{$line}='-';
$result='File has Already been Transferred';
} elsif (&Net::FullAuto::FA_Core::test_semaphore($ipc_key)) {
${$self->{_line_queried}}{$line}='-';
$result='Another Process is Transferring File';
} elsif (!$hr && testtime(\%dbcopy,$filename,$size,
$mn,$dy,$rx1,$rx2,$hostlabel)) {
${$self->{_line_queried}}{$line}='-';
$status=$bdb->db_put($line,time);
$result='File has Already been Transferred';
} elsif (!$Net::FullAuto::FA_Core::cron) {
undef $bdb;
$dbenv->close();
undef $dbenv;
if (time-$timestamp<600 && $timestamp<time) {
${$self->{_line_queried}}{$line}='-';
return 'File Less then 10 Minutes Old','';
}
my $acc='';my $ln='';
($acc,$ln)=split /\|\%\|/, $line;
$ln=~tr/ //s;
my $banner="\n The $acc Account File :\n\n $ln\n\n"
." Is Ready to Transfer\n\n Choose One :";
my @output=("Do NOT Transfer NOW","Do NOT Transfer EVER",
"TRANSFER Now");
my $output=&Menus::pick(\@output,$banner,7);
if ($output eq 'Do NOT Transfer NOW') {
return "User Declines to Transfer File Now",'';
} elsif ($output eq ']quit[') {
&Net::FullAuto::FA_Core::cleanup()
} elsif ($output eq 'Do NOT Transfer EVER') {
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}
.'Custom');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom',
-Flags =>
DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n");
my $bdb = BerkeleyDB::Btree->new(
-Filename => "$self->{_dbfile}.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n");
my $status=$bdb->db_put($line,time);
undef $bdb;
$dbenv->close();
undef $dbenv;
${$self->{_line_queried}}{$line}='-';
return 'User Declines to EVER Transfer File','';
} else {
&Net::FullAuto::FA_Core::acquire_semaphore($ipc_key,,1);
${$self->{_line_queried}}{$line}='-';
if ($Net::FullAuto::FA_Core::log) {
print $Net::FullAuto::FA_Core::MRLOG "FA_DB::query() QUERYLINE=",
"$line\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print $Net::FullAuto::FA_Core::MRLOG "FA_DB::query() ALL_LINES=",
(join "\n",sort keys %dbcopy),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
return 0,'';
}
} else {
if (time-$timestamp<600) {
${$self->{_line_queried}}{$line}='-';
$result='File Less then 10 Minutes Old';
} else {
${$self->{_line_queried}}{$line}='-';
&Net::FullAuto::FA_Core::acquire_semaphore($ipc_key,,1);
if ($Net::FullAuto::FA_Core::log) {
print $Net::FullAuto::FA_Core::MRLOG "FA_DB::query() QUERYLINE=",
"$line\n" if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
print $Net::FullAuto::FA_Core::MRLOG "FA_DB::query() ALL_LINES=",
(join "\n",sort keys %dbcopy),"\n"
if $Net::FullAuto::FA_Core::log &&
-1<index $Net::FullAuto::FA_Core::MRLOG,'*';
}
}
}
undef $bdb;
$dbenv->close();
undef $dbenv;
return $result,'';
}
sub testtime
{
my @topcaller=caller;
print "FA_DB::testtime() CALLER=",(join ' ',@topcaller),"\n"
if $Net::FullAuto::FA_Core::debug;
print $Net::FullAuto::FA_Core::MRLOG "FA_DB::testtime() CALLER=",
(join ' ',@topcaller),"\n" if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
my $dbcopy=$_[0];
my $filename=$_[1];
my $size=$_[2];
my $mn=$_[3];my $dy=$_[4];
my $rx1=$_[5];my $rx2=$_[6];
my $hostlabel=$_[7];
foreach my $dbline (keys %{$dbcopy}) {
my $dbhostlabel='';
($dbhostlabel,$dbline)=split /\|\%\|/,$dbline;
next if $dbhostlabel ne $hostlabel;
$dbline=~s/^.*\s+($rx1|$rx2)$/$1/;
$dbline=~/^(\d+)\s+([JFMASOND]\w\w\s+\d+\s+\S+)\s+(.*)$/;
my $dbsize=$1;my $dbtimestamp=$2;my $dbfilename=$3;
my $dbmt='';my $dbdy=0;my $dbmn=0;
($dbmn,$dbdy,$dbmt)=split /\s+/, $dbtimestamp;
next if -1==index $dbmt,':';
print $Net::FullAuto::FA_Core::MRLOG "FA_DB::testtime() FILENAME=$filename and DBFN=$dbfilename",
" SIZE=$size and DBS=$dbsize and MN=$mn and DBM=$dbmn and DY=$dy and DBDY=$dbdy\n"
if $Net::FullAuto::FA_Core::log && -1<index $Net::FullAuto::FA_Core::MRLOG,'*';
if ($filename eq $dbfilename && $size eq $dbsize
&& $mn eq $dbmn && $dy eq $dbdy) {
return 1;
}
} return 0;
}
sub mod
{
my $self=shift;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n");
my $bdb = BerkeleyDB::Btree->new(
-Filename => "$self->{_dbfile}.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n");
my $banner="\n Please Pick a SkipDB Entry to Delete :";
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
my @output=();
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
push @output, $k;
}
undef $cursor;
my $output=&Menus::pick(\@output,$banner,7);
my $status=$bdb->db_del($output);
undef $bdb;
$dbenv->close();
undef $dbenv;
}
sub close
{
my @caller=caller;
print "CLOSE_Caller=",(join ' ',@caller),"\n" if !$Net::FullAuto::FA_Core::cron && $Net::FullAuto::FA_Core::debug;
my $self=shift;
unless (-d $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom') {
File::Path::make_path($Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom');
}
my $dbenv = BerkeleyDB::Env->new(
-Home => $Hosts{"__Master_${$}__"}{'FA_Secure'}.'Custom',
-Flags => DB_CREATE|DB_INIT_CDB|DB_INIT_MPOOL
) or &handle_error(
"cannot open environment for DB: $BerkeleyDB::Error\n");
my $bdb = BerkeleyDB::Btree->new(
-Filename => "$self->{_dbfile}.db",
-Flags => DB_CREATE,
-Compare => sub { $_[0] <=> $_[1] },
-Env => $dbenv
) or &handle_error(
"cannot open Btree for DB: $BerkeleyDB::Error\n");
my ($k,$v) = ("","") ;
my $cursor = $bdb->db_cursor() ;
while ($cursor->c_get($k, $v, DB_NEXT) == 0) {
my $hostlabel=substr($k,0,(index $k,'|%|'));
if (exists ${$self->{_host_queried}}{$hostlabel}
&& !exists ${$self->{_line_queried}}{$k}) {
my $status=$bdb->db_del($k);
}
}
undef $cursor ;
undef $bdb ;
$dbenv->close();
undef $dbenv;
}
package Net::FullAuto::Getline;
# file: IO/Getline.pm
# Figure 13.2: The Getline module
# line-oriented reading from sockets/handles with access to
# internal buffer.
use strict;
use Carp 'croak';
use IO::Handle;